Trailing-Edge
-
PDP-10 Archives
-
BB-D868C-BM
-
language-sources/lptspl.mac
There are 45 other files named lptspl.mac in the archive. Click here to see a list.
TITLE LPTSPL - TOPS10/TOPS20 LINE PRINTER DRIVER
;
;
; COPYRIGHT (c) 1975,1976,1977,1978,1979
; DIGITAL EQUIPMENT CORPORATION
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
; AND WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS
; SOFTWARE OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
; OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON. NO TITLE TO
; AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE
; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
; BY DIGITAL EQUIPMENT CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
; OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY
; DIGITAL.
;
SEARCH GLXMAC ;SEARCH GALAXY PARAMETERS
PROLOGUE(LPTSPL)
SEARCH QSRMAC ;SEARCH QUASAR PARAMETERS
SEARCH ORNMAC ;SEARCH ORION/OPR PARAMETERS
SEARCH D60UNV ;SEARCH FOR DN60 SYMBOLS
.DIRECT FLBLST
IF1,<
TOPS20 <PRINTX ASSEMBLING GALAXY-20 LPTSPL>
TOPS10 <PRINTX ASSEMBLING GALAXY-10 LPTSPL>
> ;END IF1
IF2,<PRINTX BEGIN ASSEMBLER PASS # 2.>
SALL ;SUPPRESS MACRO EXPANSIONS
;VERSION INFORMATION
LPTVER==104 ;MAJOR VERSION NUMBER
LPTMIN==0 ;MINOR VERSION NUMBER
LPTEDT==2650 ;EDIT LEVEL
LPTWHO==0 ;WHO LAST PATCHED
%LPT==<BYTE (3)LPTWHO(9)LPTVER(6)LPTMIN(18)LPTEDT>
;STORE VERSION NUMBER IN JOBVER
LOC 137
.JBVER::EXP %LPT
RELOC 0
SUBTTL RJE SUPPORT DEFINITIONS
;IF WE HAVE RJE,,GET SIMULATION PACKAGE (TOPS20)
TOPS20 <
IFN FTRJE,<.REQUIRE NURD.REL> ;LOAD THE DN200 I/O PACKAGE
>
;IF WE HAVE DN60,,GET DN60 I/O PACKAGE
IFN FTDN60,<.REQUIRE D60JSY.REL ;LOAD THE DN60 I/O PACKAGE
D60ERR ;GENERATE ERROR SYMBOLS
PHASE 0
OPRPTR:! BLOCK 1 ;OPR MESSAGE BYTE POINTER
OPRBCT:! BLOCK 1 ;OPR MESSAGE BYTE COUNT
OPRLEN:! ;OPR MESSAGE HEADER LENGTH
OPRTXT:! ;OPR MESSAGE TEXT
DEPHASE
> ;END FTDN60 CONDITIONAL
SUBTTL Revision History
COMMENT \
2550 Delete all references to user name and job number.
Replace them with ^R Library $Text Function.
2551 Add code to support new QUASAR device status message.
2552 Add RJE support
2553 Fix a Restart page count bug by not including the job
headers and trailers in the final page count.
2554 Replace ERRSTP ITEXT with LPERR ITEXT. Make sure when LPT comes
online or goes offline, the status is updated. Add a check to
ACTEND so that if the request had an invalid account string,
no USAGE entry is made.
2555 Fix a bug in which INPOPN was doing a LOAD S1,EQ.PRV to get
the users privilge bits. This translated to MOVE S1,400
and 400 was SPLDIR (which was never 0). Given this, the
JUMPN S1,INPO.1 always jumped to INPO.1 and avoided the
access check. The LOAD was changed to LOAD S1,.EQSEQ(J),EQ.PRV.
2556 Changed the IB to conform to the new IB/PIB structure.
2557 Fix a bug in OUTOUT which caused to stack to be out of phase.
Basic re-write of OUTOUT, elimination of OUTINT, and
modification of $SOUT.
2560 Change the scheduler loop to use P1 instead of T2.
Change the scheduler loop so that at MAIN.1 it
checks to see if the stream status needs to be updated,
and if so, it sends a status update and checkpoint
message to QUASAR.
2561 Delete the flag bit HDRTRL and the supporting code.
2562 Add Calls to S%SIXB & S%TBLK for WTOR response parsing.
Move the call to FILDIS from ENDJOB to QRELEASE.
2563 Fix line count for narrow forms.
Fix DEVOUT to save S1 across OUTOUT call
Add code to cut off the header/trailer line at 'J$FWID' Length
2564 Add DN60 Support.
2565 Add 'Ignore Structure Accounting' MSTR JSYS.
2566 Change the $WTOR's for killing OPR requests from $WTOR to $KWTOR.
2567 Add spooling to mag tape support
2570 Fix a page count problem (on restarts).
Spell cancelled right (canceled)
2571 Spell Canceling correctly
add 40 (decimal) words to the context PDL
2572 Fix a bug in which it was possible for LPTSPL to set the output
blocked scheduling bit and then deschedule for a page limit
exceeded error. When this happened, LPTSPL would wait for
the output done interrupt, which, of course, would never come.
2573 Clear J$RNPP IN DOJOB Just before checkpointing the next file
Clear J$RNPP and checkpoint the number of copies in FILE.1
2574 If a job is cancelled while in OPR response wait from LODVFU or
LODRAM then zero J$FORM to force the next job to go through
new forms processing.
2575 Add DN60 operator response support (What a Crock !!)
2576 Delete FTRMTE feature test.
2577 At OUTERR move the PUSHJ P,.SAVET & MOVE T4,STREAM to OUTE.1
under TOPS-10 conditional.
Change the scheduler so that for both TOPS-10 & TOPS-20 we
check to see if we processed a message and if so, dont sleep.
Change OPRCHK so that as long as the output succeeds, we
continue printing operator messages.
For TOPS-10 make OUTDMP call OUTOUT BUFNUM+1 times.
Add Spooling to Tape support for TOPS-10.
2600 Make LPTSPL sleep forever by removing the 60 second timer.
2601 TOPS10 - Detect EOF on spool to magtape. Ask OPR to mount next reel
2602 Fix a bug in SHUTIN code. Get a new stack pointer if shutting
down from 'IN STREAM' context.
2603 Fix a bug - reverse the compare in S$VFU which checks for
optical VFU.
2604 Fix a bug - In OUTGET, if the default RAM and VFU are already set,
then, dont set them.
2605 Fix a bug - if printing either the banner or header pages, dont
flush the buffers in KILL or OACCAN.
2606 Add code to send a form feed if the printer VFU is ok and
we are about to load the VFU.
2607 Delete the TOPS-20 mag tape code that assigns/deassigns the tape drive.
Also make sure that the mat tape is not already assigned to anyone.
2610 Delete the RAM variable from the forms default macro and add
J$FRAM.
2611 Change IPCF send/recieve quotas from max to 20.
2612 Change DN60 D60OPN parameters for new port/line handle.
2613 Fix a bug - prevent LPTSPL from deleting DN60'S link'd list.
2614 Delete the Send/Recieve Quotas from the PIB.
2615 Make OUTREL do a CLOSE instead of a RESDV. if we are spooling to tape
2616 Pick up non-existant printer status bits on the -20.
2617 Fix a bug in TAPGET; The correct value returned by the DVCHR for
unassigned devices is -1,,unit # - Not -1.
2620 In SHUTDN, After the call to FNDOBJ check to see that the object
was actually found, and if not, just return.
In OPDINI, add a SETZM FMOPN and a $RETT at the end of the routine.
In OPEN.6 add a SETOM J$LINK(J) to indicate that there is no DN60
operator message list.
In CLOSE.6, change the MOVE S1,J$LINK(J) to a SKIPL S1,J$LINK(J) so
that we dont delete a list which may not exist.
2621 TOPS-10: Delete the call to F%FCHN and use the stream number as the
channel number.
2622 Fix a job restart problem which allows -pages to be printed.
2623 Fix a -10 problem caused by converting to extended channels in the
library. Must re-write the load VFU and RAM sections for front
end lint printers
2624 Fix a -10 problem - Clear the PSF%DO and PSF%OB bits in the
OUTGET routine since we may wait forever after resetting the channel.
Change all occurances of DC3 output to CRLF except for the ruler.
2625 Add a CRLF to the end of the header page file info line.
2626 Fix a bug in the /REPORT: code for COBOL report files.
2627 Fix a bug in deleting files. Make F%DEL use an in your behalf FOB.
2630 Delete the support for the old forms parameters.
2631 Convert DN60 support to new SETUP message format.
2632 Rework the Backspace /pages support to fix U.S. Railways QAR.
2633 Finally get the backspace code right.
2634 Add 8 bit input support. Also, make output byte sizes variable by
adding J$LBTZ to keep track of output byte size.
2635 Add /FILE:ELEVEN support to print MACY11 files as standard ascii
Requires that a new FP bit or field be defined for 8-BIT
2636 TOPS20 QAR (20-00608) Add code to OUTREL so that when closing
a device other then the line printer, we write out
trailing tape marks.
2637 Fix a bug in which the ABORT bit was being lit in the NXTJOB code,
before the forms were set up. This caused the request to be trashed
without the headers or trailers being printed
2640 Fix a bug - Make the TAPGET OPENF open the device in 7 bit Mode.
2641 Fix Another bug - make OUTGET open device for 8 bit bytes.
2642 Make PICTURE put out line feeds, not DC3's.
2643 Fix a bug in OUTERR code so that is the OUTFLS call fails, then
send a Response-to-Setup message to QUASAR before shutting down.
2644 Add support for /RAM: in LPFORM.INI for -10 & -20.
2645 Fix an accounting problem in which usage accounting was being done
twice.
2646 Fix QAR # 20-00805 such that multiple ALIGN commands do not
add to the sleep time of previous ALIGN commands
2647 Add a SETZM T1 to the .MONOP MTOPR call in OUTDMP.
Add a .MONOP MTOPR call to TAPGET to wait for I/O to finish or
if a TTY, set the TTY page width to infinite.
2650 Fix BACKSPACE FILES problem. Just make it backspace to the beginning
of the current file.
\ ;End of Revision History
SUBTTL AC and I/O Channel Definitions
;ACCUMULATOR DEFINITIONS
M==12 ;IPCF MESSAGE ADDRESS
S==13 ;STATUS FLAGS
E==14 ;POINTS TO CURRENT FILE
J==15 ;JOB CONTEXT POINTER
C==16 ;HOLDS A CHARACTER - ALMOST NEVER PRESERVED
SYSPRM ERRVFU,DF.LVE,MO%LVF
SUBTTL Parameters
;PARAMETERS WHICH MAY BE CHANGED AT ASSEMBLY TIME
ND PDSIZE,100 ;SIZE OF PUSHDOWN LIST
ND LPTERR,2 ;NUMBER OF LPT I/O ERRS BEFORE QUITTING
ND LOGPAG,12 ;PAGE LIMIT FOR LOG IF OVER QUOTA
;CONSTANT PARAMETERS
XP MSBSIZ,30 ;SIZE OF A MESSAGE BLOCK
XP AFDSIZ,10 ;ALIGN FILE FD SIZE.
;CHECKPOINT BLOCK OFFSETS
XP CKFIL,0 ;NUMBER OF FILES PRINTED
XP CKCOP,1 ;NUMBER OF COPIES OF LAST FILE
XP CKPAG,2 ;NUMBER OF PAGES OF LAST COPY
XP CKTPP,3 ;TOTAL PAGES PRINTED
XP CKFLG,4 ;FLAGS
XP CKFREQ,1B0 ;JOB WAS REQUEUED BY OPR
XP CKFCHK,1B1 ;JOB WAS CHECKPOINTED
SYSPRM BUFNUM,4,1 ;NUMBER OF BUFFERS
SYSPRM BUFSPC,1000,1000 ;SPACE ALLOCATED FOR BUFFERS
SYSPRM BUFSIZ,<1000/BUFNUM>,<1000/BUFNUM>
;SIZE OF EACH BUFFER
SYSPRM BUFCHR,<BUFSIZ-3>*5,<BUFSIZ*4>
;NUMBER OF CHARS PER BUFFER
BUFSPC==BUFNUM*BUFSIZ
SYSPRM NPRINT,17,1 ;NUMBER OF DEVICES THIS SPOOLER HANDLES
SYSPRM ACCTSW,0,-1 ;ACCOUNTING -1=YES,0=NO
SYSPRM RAMNOR,SIXBIT/LP96/,SIXBIT/LP96/
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 Special Forms Handling Parameters
;FORMS SWITCHES:
; BANNER:NN NUMBER OF JOB HEADERS
; TRAILER:NN NUMBER OF JOB TRAILERS
; HEADER:NN NUMBER OF FILE HEADERS (PICTURE PAGES)
; LINES:NN NUMBER OF LINES PER PAGE
; WIDTH:NN NUMBER OF CHARACTERS PER LINE
; ALIGN:SS NAME OF ALIGN FILE
; ALCNT:NN NUMBER OF TIMES TO PRINT ALIGN FILE
; ALSLP:NN NUMBER OF SECS TO SLEEP BETWEEN COPIES OF ALIGN
; RIBBON:SS RIBBON TYPE
; TAPE:SS VFU CONTROL TAPE
; VFU:SS (SAME AS /TAPE)
; RAM:SS TRANSLATION RAM TO USE
; DRUM:SS DRUM TYPE
; CHAIN:SS CHAIN TYPE (DRUM/CHAIN ARE THE SAME)
; NOTE:AA TYPE NOTE TO THE OPERATOR
;IN THE ABOVE AND BELOW EXPLANATIONS:
; NN IS A DECIMAL NUMBER
; SS IS A 1-6 CHARACTER STRING
; AA IS A STRING OF 1 TO 50 CHARACTERS
; OO IS AN OCTAL NUMBER
;LOCATION SPECIFIERS
; ALL ALL LINEPRINTERS
; CENTRAL ALL LINEPRINTERS AT THE CENTRAL SITE
; REMOTE ALL REMOTE LINEPRINTERS
; LPTOOO LINEPRINTER OOO ONLY
;NOTE: LPTSPL WILL USE THE FIRST ENTRY WHICH MEETS THE LOCATION
; SPECIFICATION FOR ITS LINEPRINTER.
DEFINE F,<
FF BANNER,2
FF TRAILER,2
FF HEADER,2
FF LINES,^D60
FF WIDTH,^D132
FF ALIGN,0
FF ALCNT,5
FF ALSLP,7
FF RIBBON,FRMNOR
FF TAPE,FRMNOR
FF VFU,FRMNOR
FF DRUM,FRMNOR
FF CHAIN,FRMNOR
FF NOTE,0
FF RAM,-1
>
;GENERATE TABLE OF SWITCH NAMES
DEFINE FF(A,B),<
XLIST
<<SIXBIT /A/>&777777B17>+S$'A
LIST
SALL
>
FFNAMS: F
;GENERATE TABLE OF DEFAULT PARAMTERS
DEFINE FF(X,Y),<
XLIST
D$'X: EXP Y
LIST
SALL
>
FFDEFS: F
F$NSW==.-FFDEFS
PURGE D$VFU,D$CHAI
F$CL1==^D60 ;WIDTH CLASS ONE IS 1 TO F$CL1
F$CL2==^D100 ;WIDTH CLASS TWO IS F$CL1 TO F$CL2
SUBTTL Flag Definitions
ARROW==1B0 ;ARROW MODE IN EFFECT
SUPFIL==1B1 ;NO USER FORM CONTROL
DSKOPN==1B2 ;DISK DATA READ GOING ON
RQB==1B3 ;JOB HAS BEEN REQUED
SUPJOB==1B4 ;SUPPRESS /JOB
ABORT==1B5 ;THE SHIP IS SINKING
FCONV==1B6 ;THE NEXT CHAR IS FORTRAN FORMAT DATA
NEWLIN==1B7 ;FLAG FOR THE BEGINING OF LINE
SKPFIL==1B8 ;SKIP FUTURE COPIES OF THIS FILE COMPLETELY
GOODBY==1B9 ;IN JOB TERMINATION SEQUENCE
FBPTOV==1B10 ;SPACING PAGE TABLE OVERFLOW BIT.
FORWRD==1B11 ;FORWARD SPACING REQUEST IN PROGRESS.
INTRPT==1B12 ;STREAM IS CONNECTED TO THE INTERRUPT SYSTEM
BANHDR==1B14 ;PRINTING BANNER/HEADER PAGES
VFULOD==1B15 ;VFU LOAD IS IN PROGRESS
SUBTTL Job Parameter Area
LP J$$BEG,0 ;BEGINNING OF PARAMETER AREA
;REQUEST PARAMETERS
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$RLFS,1,Z ;ADR OF LOG FILE SPEC
LP J$RNFP,1,Z ;NUMBER OF FILES PRINTED
LP J$RNCP,1,Z ;NUMBER OF COPIES OF CURRENT FILE
LP J$RNPP,1,Z ;NUMBER OF PAGES IN CURRENT COPY PRINTED
LP J$RACS,20 ;CONTEXT ACS
LP J$RPDL,^D100 ;CONTEXT PUSHDOWN LIST
;LPT PARAMETERS
LP J$LBUF,1 ;ADDRESS OF LPT BUFFER
LP J$LBFR,PAGSIZ ;LINE PRINTER BUFFER
LP J$LBRH,1 ;BUFFER RING HEADER
LP J$LBPT,1 ;BYTE POINTER
LP J$LBCT,1 ;BYTE COUNT
LP J$LDEV,1 ;ACTUAL OUTPUT DEVICE NAME
LP J$LERR,1 ;LPT ERROR DOWNCOUNTER
LP J$LRAM,1 ;DEFAULT RAM FILE NAME (LP64 or LP96)
LP J$LLCL,1 ;-1 IF UPPER/LOWER CASE PRINTER
LP J$LDVF,1 ;-1 IF DAVFU ON PRINTER
LP J$LPCR,1 ;-1 IF DEVICE HAS A PAGE CNTR
LP J$LREM,1 ; 0 = LOCAL LPT
;-1 = DEC TYPE REMOTE LPT
;+1 = DN60 TYPE REMOTE LPT
LP J$DCND,CN$SIZ ;DN60 LINE CONDITIONING BLOCK
LP J$DFLG,1 ;DN60 FLAG WORD
LP J$D6OP,1 ;DN60 OPERATOR CONSOLE ID
LP J$LINK,1 ;DN60 OPERATORS MSG LIST ID
LP J$OMSG,1 ;DN60 OPERATOR MESSAGE AVAILABLE FLAG
LP J$OFLN,1 ;DN60 PRINTER IS OFFLINE FLAG
LP J$LCLS,1 ;LPT CONTROLLER CLASS
LP J$LIOA,1 ;-1 IF WE ARE IN A SOUT OR OUT
LP J$LLPT,1 ;-1 IF DEVICE REALLY IS A LPT
LP J$LIOS,1 ;LPT IO ERROR STATUS
LP J$MTAP,1 ;SIXBIT MAG TAPE DEVICE NAME
LP J$LCHN,1 ;LPT I/O CHANNEL
LP J$LBTZ,1 ;LPT OUTPUT BYTE SIZE
TOPS20 <
LP J$LSTG,2 ;DEVICE NAME STRING
LP J$LIBC,1 ;INITIAL BYTE COUNT
LP J$LIBP,1 ;INITIAL BYTE POINTER
> ;END TOPS20 CONDITIONAL
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;CURRENT FORMS PARAMETERS
DEFINE FF(X,Y),<
LP J$F'X,1
>
LP J$FCUR,0 ;START OF FORMS PARAMS
F ;CURRENT FORMS PARAMS
LP J$FORM,1 ;CURRENT FORMS TYPE
LP J$FPFM,1 ;PREVIOUS FORMS TYPE
LP J$PDRU,1 ;PREVIOUS LOADED DRUM
LP J$PRIB,1 ;PREVIOUS LOADED RIBBON
LP J$PTAP,1 ;PREVIOUS LOADED CARRAIGE CONTROL TAPE
LP J$FMSP,1,Z ;FORMS WTO/WTOR PAGE ADDRESS
LP J$FWCL,1 ;CURRENT WIDTH CLASS
LP J$FLVT,1 ;CURRENTLY 'LOADED' VFU TYPE
LP J$FLRM,1 ;CURRENTLY 'LOADED' TRANSLATION RAM
LP J$FVIF,1 ;IFN OF VFU FILE ON -10
LP J$FBYT,1,Z ;VFU INPUT BYTE COUNT.
LP J$FPTR,1 ;VFU INPUT BYTE POINTER.
LP J$LVFF,1 ;FIRST TIME THROUGH FLAG FOR LPT VFU'S
LP J$FNBK,16 ;OPERATOR NOTE BLOCK
IF2,< PURGE J$FVFU,J$FCHA ;DON'T USE THESE >
;ALIGN FILE PARAMETERS
LP J$APRG,1 ;-1 IF ALIGN IS IN PROGRESS
LP J$AIFN,1 ;ALIGN FILE IFN
LP J$ABYT,1 ;ALIGN BUFFER BYTE COUNT.
LP J$APTR,1 ;ALIGN BUFFER BYTE POINTER.
LP J$ASLP,1,Z ;SECONDS TO SLEEP
LP J$ACNT,1,Z ;LOOP COUNT
LP J$AFD,AFDSIZ ;THE FD FOR THE ALIGN FILE
;MISCELLANY
LP J$XTOP,1 ;WE ARE AT TOP OF FORM
LP J$XFOB,FOB.SZ ;A FILE OPEN BLOCK
LP J$XPOS,1 ;CURRENT VERTICAL POSITION
LP J$XHBF,<45> ;BUFFER TO BUILD HEADER LINE
LP J$XCOD,<^D55> ;COMPILE A ROUTINE TO CHECK
; FOR MATCH ON /REPORT
LP J$XFRC,1 ;FORTRAN CHARACTER REPEAT COUNT
LP J$XTBF,50 ;$TEXT BUFFER FOR OUTPUT DEVICE
LP J$XTBP,1 ;BYTE POINTER FOR J$XTBF.
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$ADRD,1,Z ;DISK BLOCKS READ.
LP J$APRI,1,Z ;JOBS PRIORITY
LP J$ARTM,1,Z ;JOBS RUN TIME (CPU)
LP J$ASEQ,1,Z ;JOBS SEQUENCE NUMBER
LP J$AFXC,1,Z ;TOTAL FILES PRINTED (FILES*COPIES)
;FORWARD SPACE / BACK SPACE PARAMETERS
LP J$FBPT,1 ;CURRENT PAGE TABLE POSITION
LP J$FPAG,PAGSIZ ;BACKSPACE PAGE TABLE
LP J$FCBC,1,Z ;CURRENT INPUT BUFFER BYTE COUNT
LP J$FTBC,1,Z ;TOTAL INPUT BYTE COUNT
LP J$FPIG,1,Z ;NUMBER OF PAGES TO IGNORE
;DISK FILE PARAMETERS
LP J$DIFN,1 ;THE IFN
LP J$DFDA,1 ;THE FD ADDRESS
LP J$DBPT,1 ;BUFFER BYTE POINTER
LP J$DBCT,1,Z ;BUFFER BYTE COUNT
;LOG FILE PARAMETERS
LP J$GBUF,^D10 ;ADDRESS OF LOG FILE BUFFERS
LP J$GBFR,PAGSIZ ;FIRST LOG FILE BUFFER
LP J$GNLN,1,Z ;NUMBER OF LINES WRITTEN IN LOG
LP J$GIBC,1,Z ;INTERNAL LOG BYTE COUNT
LP J$GIBP,1,Z ;INTERNAL LOG BYTE POINTER
LP J$GINP,1,Z ;NUMBER OF INTERNAL LOG PAGES
;PICTURE BLOCKS
LP J$PUSR,10 ;USER NAME
LP J$PNOT,4 ;/NOTE
LP J$PFL1,10 ;FIRST LINE OF FILE NAME
LP J$PFL2,12 ;SECOND LINE OF FILE NAME
LP J$PFLS,1 ;BLOCKSIZE FOR FILENAME
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
PDL: BLOCK PDSIZE ;PUSHDOWN LIST
MESSAG: BLOCK 1 ;ADDRESS OF MESSAGE JUST RECEIVED
BLKADR: BLOCK 1 ;IPCF MSG BLK ADDR SAVE AREA
ACTFLG: BLOCK 1 ;-1 IF DOING ACCOUNTING
TEXTBP: BLOCK 1 ;BYTE POINTER FOR DEPBP
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
FMOPN: BLOCK 1 ;SET TO -1 WHEN LPFORM IN OPEN
FMIFN: BLOCK 1 ;THE IFN FOR LPFORM.INI
FMBYT: BLOCK 1 ;LPFORM.INI INPUT BYTE COUNT
FMPTR: BLOCK 1 ;LPFORM.INI INPUT BYTE POINTER.
LPCNF: BLOCK 10 ;SYSNAME
JOBITS: BLOCK 1 ;SAVE JOB STATUS BITS FLAG.
STRSEQ: EXP 4000 ;STREAM SEQ #'S (START AT 4000)
SCHEDL: -NPRINT,,0 ;STREAM SCHEDULING DATA
SLEEPT: BLOCK 1 ;SLEEP TIME FOR SCHEDULING.
CNTSTA: BLOCK 1 ;NUMBER OF THE CENTRAL STATION
RUTINE: BLOCK 1 ;MESSAGE PROCESSING ROUTINE ADDRESS.
TOPS20 <
SPLDIR: BLOCK 1 ;DIRECTORY NUMBER OF PS:<SPOOL>
> ;END TOPS20 CONDITIONAL
SUBTTL Resident JOB Database
STREAM: BLOCK 1 ;CURRENT STREAM NUMBER
JOBPAG: BLOCK NPRINT ;ADDRESS OF A FOUR PAGE BLOCK
; ONE FOR REQUEST, ONE FOR JOB PARAMS
; ONE FOR LPT BUFFER, ONE FOR LOG BUFFER
JOBOBA: BLOCK NPRINT ;TABLE OF OBJECT BLOCK ADDRESSES
JOBSTW: BLOCK NPRINT ;JOB STATUS WORD
JOBACT: BLOCK NPRINT ;-1 IF STREAM IS ACTIVE, 0 OTHERWISE
JOBOBJ: BLOCK 3*NPRINT ;LIST OF SETUP OBJECTS
JOBWKT: BLOCK NPRINT ;JOB WAKE TIME (FOR ALIGN)
JOBCHK: BLOCK NPRINT ;STREAM CHECKPOINT FLAG. (-1=YES,,0=NO)
JOBWAC: BLOCK NPRINT ;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
PSF%AL==1B5 ;ALIGNMENT TIMER WAIT STATE.
PSF%OO==1B6 ;WAITING FOR 2780/3780 OPERATOR OUTPUT
DEFINE $DSCHD(FLAGS),<
PUSHJ P,DSCHD
XLIST
JUMP [EXP FLAGS]
LIST
SALL
> ;END DEFINE $DSCHD
SUBTTL IB and HELLO message blocks
TOPS10 <INTVEC==VECTOR>
TOPS20 <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
$SET(PB.FLG,IP.PSI,1) ;PSI ON
$SET(PB.INT,IP.CHN,0) ;INTERRUPT CHANNEL
$EOB ;
HELLO: $BUILD HEL.SZ ;
$SET(.MSTYP,MS.TYP,.QOHEL) ;MESSAGE TYPE
$SET(.MSTYP,MS.CNT,HEL.SZ) ;MESSAGE LENGTH
$SET(HEL.NM,,<'LPTSPL'>) ;PROGRAM NAME
$SET(HEL.FL,HEFVER,%%.QSR) ;QUASAR VERSION
$SET(HEL.NO,HENNOT,1) ;NUMBER OF OBJ TYPES
$SET(HEL.NO,HENMAX,NPRINT) ;MAX NUMBER OF JOBS
$SET(HEL.OB,,.OTLPT) ;LPT OBJECT TYPE
$EOB ;
OACERR: BLOCK 1 ;'OUTGET' ROUTINE RETURN CODE
SETMSG: [ASCIZ/Started/]
[ASCIZ/Not available right now/]
[ASCIZ/Does not exist/]
LIMSG: ASCIZ/
Type 'Respond <Number> ABORT' to Abort the Job
Type 'Respond <Number> IGNORE' to Ignore the Error/
SUBTTL $TEXT Utilities
DEPBP: IDPB S1,TEXTBP ;DEPOSIT THE BYTE
$RETT ;AND RETURN
;OPERATING SYSTEM DEPENDENT ITEXTS
;LOG FILE STAMPS
LPMSG: ITEXT(<^C/[-1]/ LPMSG >)
LPDAT: ITEXT(<^C/[-1]/ LPDAT >)
LPOPR: ITEXT(<^C/[-1]/ LPOPR >)
LPEND: ITEXT(<^C/[-1]/ LPEND >)
LPERR: ITEXT(<^C/[-1]/ LPERR ? >)
DATMON: ITEXT(< Date ^H/[-1]/ Monitor: ^T/LPCNF/ ^T7C*/0(T4)/>)
SUBTTL LPTSPL - Multiple Line Printer Spooler.
LPTSPL: RESET ;AS USUAL.
MOVE P,[IOWD PDSIZE,PDL] ;SET UP THE STACK.
MOVEI S1,IB.SZ ;GET THE IB SIZE.
MOVEI S2,IB ;ADDRESS OF THE IB.
PUSHJ P,I%INIT ;SET UP THE WORLD.
PUSHJ P,INTINI ;SET UP THE INTERRUPT SYSTEM.
SETOM ACTFLG ;TURN ON ACCOUNTING.
IFE ACCTSW,<
SETZM ACTFLG ;UNLESS HE DOESNT WANT IT.
>
PUSHJ P,OPDINI ;GET OPERATING SYSTEM INFO.
PUSHJ P,OPNFRM ;OPEN LPFORM.INI
PUSHJ P,I%ION ;TURN ON INTERRUPTS.
MOVEI T1,HELLO ;GET ADDRESS OF HELLO MESSAGE.
PUSHJ P,SNDQSR ;SAY HI TO QUASAR.
MOVSI P1,-NPRINT ;SET UP STREAM COUNTER.
;FALL THROUGH TO MAIN LOOP.
SUBTTL Idle Loop
MAIN: PUSHJ P,OPRCHK ;CHECK FOR DN60 OPERATOR MESSAGES
SKIPN JOBACT(P1) ;IS THE STREAM ACTIVE ???
JRST MAIN.2 ;NO,,GET THE NEXT STREAM.
HRRZM P1,STREAM ;RUNNABLE STREAM!!!
MOVE J,JOBPAG(P1) ;YES, GET JOB PAGE
PUSHJ P,CHKTIM ;SEE IF ITS TIME TO GET THE STREAM UP..
SKIPN JOBCHK(P1) ;DO WE WANT TO UPDATE THE JOB STATUS ??
JRST .+3 ;NO,,THEN SKIP THIS
PUSHJ P,UPDTST ;SEND A DEVICE STATUS MESSAGE
PUSHJ P,CHKPNT ;SEND A CHECKPOINT MESSAGE
SKIPE JOBSTW(P1) ;IS THE STREAM BLOCKED ???
JRST MAIN.2 ;YES,,GET THE NEXT STREAM.
MOVEM P1,SCHEDL ;SAVE THE SCHEDULING STREAM.
MOVSI 17,J$RACS(J) ;ELSE SETUP TO
BLT 17,17 ;GET SOME ACS
POPJ P, ;AND RETURN
MAIN.1: MOVE P1,SCHEDL ;GET THE LAST SCHEDULED STREAM.
SKIPN JOBCHK(P1) ;DO WE WANT TO UPDATE THE JOB STATUS ??
JRST .+3 ;NO,,THEN SKIP THIS
PUSHJ P,UPDTST ;YES,,SEND A DEVICE STATUS MESSAGE
PUSHJ P,CHKPNT ;YES,,SEND A CHECKPOINT MESSAGE
PUSHJ P,CHKTIM ;SET THE WAKEUP TIMER
MAIN.2: AOBJN P1,MAIN ;LOOP BACK FOR SOME MORE.
PUSHJ P,CHKQUE ;CHECK FOR INCOMMING MESSAGES.
SKIPE MESSAGE ;DID WE PROCESS A MESSAGE ???
JRST MAIN.3 ;YES,,CONTINUE PROCESSING
MOVE S1,SLEEPT ;NO,,PICK UP SLEEP TIME.
TOPS20 <
SKIPE JOBACT ;CHECK IF STREAM ACTIVE..
SKIPE JOBSTW ;ANY BLOCKING CONDITIONS
>;END TOPS20 CONDITIONAL
PUSHJ P,I%SLP ;ELSE,,GO WAIT
MAIN.3: MOVE P,[IOWD PDSIZE,PDL] ;RESET THE STACK POINTER.
SETZM SLEEPT ;SLEEP FOREVER
MOVSI P1,-NPRINT ;GET LOOP AC.
JRST MAIN ;KEEP ON PROCESSING.
SUBTTL CHKTIM - ROUTINE TO WAKE UP A STREAM AT A FUTURE TIME.
CHKTIM: MOVE S1,JOBSTW(P1) ;GET THE STREAMS SCHEDULING BITS
TXNN S1,PSF%AL ;IS IT WAITING ???
$RETT ;NO,,JUST RETURN
PUSHJ P,I%NOW ;YES,,GET CURRENT TIME.
SUB S1,JOBWKT(P1) ;CALCULATE THE NUMBER
IDIVI S1,3 ; OF SECONDS TO WAKE-UP.
JUMPGE S1,CHKT.1 ;IF TIME IS UP,,WAKE UP STREAM.
MOVMS S1 ;GET ABSOLUTE VALUE OF SECONDS.
CAILE S1,^D60 ;IF WAKE UP TIME IS GREATER THEN
MOVEI S1,^D60 ; 60 SECS,, THEN MAKE IT 60 SECS.
CAMGE S1,SLEEPT ;IF WAKE UP TIME IS LESS THEN
MOVEM S1,SLEEPT ;CURRENT WAKE UP TIME,,THEN RESET IT.
$RETF ;DO NOT WAKE UP THE JOB.
CHKT.1: MOVX S1,PSF%AL ;PICK UP ALIGN BLOCK BIT.
SKIPLE J$LREM(J) ;IS THIS A DN60 LPT ???
TXO S1,PSF%DO ;YES,,INCLUDE DEVICE OFFLINE
ANDCAM S1,JOBSTW(P1) ;TURN OFF STREAM WAIT STATE BIT.
$RETT ;WAKE UP THE STREAM.
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
MOVE S2,STREAM ;GET THE STREAM NUMBER
IORM S1,JOBSTW(S2) ;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
MOVE S1,STREAM ;GET STREAM NUMBER
SETOM JOBACT(S1) ;MAKE THE STREAM ACTIVE
SETOM JOBCHK(S1) ;CHECKPOINT FIRST CHANCE WE GET !!!
MOVX S2,PSF%OB+PSF%ST+PSF%OR+PSF%AL ;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) ;PREPARE TO ZERO SELECTED WORDS JOB AREA
MOVSI S2,-<J$$LEN+^D35>/^D36 ;AOBJN POINTER TO BIT TABLE
NXTJ.2: MOVEI T1,^D36 ;BIT COUNTER FOR THIS WORD
MOVE T2,ZTABLE(S2) ;GET A WORD FROM BIT TABLE
NXTJ.3: JUMPE T2,NXTJ.4 ;DONE IF REST OF WORD IS ZERO
JFFO T2,.+1 ;FIND THE FIRST 1 BIT
ADD S1,T3 ;MOVE UP TO THE CORRESPONDING WORD
SETZM 0(S1) ;AND ZERO IT
SUB T1,T3 ;REDUCE BITS LEFT IN THIS WORD
LSH T2,0(T3) ;SHIFT OFFENDING BIT TO BIT 0
TLZ T2,(1B0) ;AND GET RID OF IT
JRST NXTJ.3 ;AND LOOP
NXTJ.4: ADD S1,T1 ;ACCOUNT FOR THE REST OF THE WORD
AOBJN S2,NXTJ.2 ;AND LOOP
$TEXT(LOGCHR,<^M^J^I/LPDAT/LPTSPL version ^V/[%LPT]/ ^T/LPCNF/>)
MOVE S1,STREAM ;GET THE STREAM NUMBER
$TEXT(LOGCHR,<^I/LPDAT/Job ^W/.EQJOB(J)/ sequence #^D/.EQSEQ(J),EQ.SEQ/ on ^B/@JOBOBA(S1)/ at ^H/[-1]/>)
SKIPN T2,.EQCHK+CKFLG(J) ;GET THE CHECKPOINT FLAGS
JRST NXTJ.5 ;AND JUMP IF NEW JOB
MOVEI T1,[ASCIZ /system failure/]
TXNE T2,CKFREQ ;WAS IT A REQUEUE
MOVEI T1,[ASCIZ /requeue by operator/]
$TEXT(LOGCHR,<^I/LPMSG/Job being restarted after ^T/0(T1)/>)
NXTJ.5: LOAD S1,.EQSEQ(J),EQ.IAS ;IS THIS AN INVALID REQUEST ???
SKIPE S1 ;IS THIS AN INVALID REQUEST ???
$TEXT (LOGCHR,<^I/LPERR/Invalid Account String Specified (^T/.EQACT(J)/)>)
GETLIM T1,.EQLIM(J),OLIM ;GET PAGE LIMIT
MOVEM T1,J$RLIM(J) ;SAVE IT
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
PUSHJ P,ACTBEG ;GO SETUP THE ACCOUNTING PARMS
PUSHJ P,I%NOW ;GET TIME OF DAY
MOVEM S1,J$RTIM(J) ;SAVE IT AWAY
MOVE S1,STREAM ;GET STREAM NUMBER.
$WTOJ (Begin,<^R/.EQJBB(J)/>,@JOBOBA(S1))
PUSHJ P,TBFINI ;INITIALIZE THE BUFFER
PUSHJ P,CHKLPT ;GO MAKE SURE THE DEVICE IS ONLINE
$RETT ;AND RETURN
SUBTTL Do the Job
DOJOB: PUSHJ P,FORMS ;GET FORMS MOUNTED
JUMPF ENDREQ ;CANT DO IT,,END THE REQUEST
LOAD S1,.EQSEQ(J),EQ.IAS ;GET INVALID ACCOUNT STRING BIT
STORE S1,S,ABORT ;SAVE IT AS THE ABORT BIT
TXO S,BANHDR ;LITE 'PRINTING BANNERS' FLAG
PUSHJ P,JOBHDR ;PRINT THE BANNER
TXZ S,BANHDR ;CLEAR 'PRINTING BANNERS' FLAG
LOAD E,.EQLEN(J),EQ.LOH ;GET LENGTH OF HEADER
ADD E,J ;POINT TO FIRST FILE
SETZM J$RNFP(J) ;ZAP THE # OF FILES PRINTED
SKIPN .EQCHK+CKFLG(J) ;IS THIS A RESTARTED JOB?
JRST DOJO.4 ;NO, SKIP ALL THIS STUFF
MOVE T1,.EQCHK+CKFIL(J) ;YES, GET NUMBER OF FILES DONE
MOVEM T1,J$RNFP(J) ;STORE FOR NEXT CHECKPOINT
DOJO.1: SOJL T1,DOJO.2 ;DECREMENT AND JUMP IF SKIPED ENUF
LOAD S1,.FPINF(E),FP.FCY ;GET THE COPIES IN THIS REQUEST
ADDM S1,J$AFXC(J) ;ADD TO THE TOTAL COUNT
PUSHJ P,NXTFIL ;BUMP E TO NEXT SPEC
JUMPF DOJO.7 ;FINISH OFF IF DONE
JRST DOJO.1 ;LOOP SOME MORE
DOJO.2: MOVE S1,.EQCHK+CKCOP(J) ;GET NUMBER OF COPIES PRINTED
MOVEM S1,J$RNCP(J) ;SAVE FOR NEXT CHECKPOINT
ADDM S1,J$AFXC(J) ;ADD TO THE TOTAL FILE COUNT
MOVE S1,.EQCHK+CKTPP(J) ;GET THE TOTAL PAGES PRINTED.
SUBI S1,5 ;MAKE SURE WE DONT SCREW THINGS UP
SKIPGE S1 ;ALSO MAKE SURE WE ARE NOT NEGATIVE
SETZM S1 ;YES,,MAKE IT 0
MOVEM S1,J$APRT(J) ;AND SAVE IT
MOVE S1,.EQCHK+CKPAG(J) ;GET CHKPNT'ED PAGE
SUBI S1,5 ;MAKE SURE WE DONT MISS ANYTHING !!
SKIPGE S1 ;ALSO MAKE SURE WE ARE NOT NEGATIVE
SETZM S1 ;YES,,MAKE IT 0
MOVEM S1,J$RNPP(J) ;AND SAVE IT.
DOJO.4: LOAD S1,.FPFST(E) ;GET /START PARAMETER
MOVEM S1,J$FPIG(J) ;SAVE FOR FIRST COPY
PUSHJ P,FILE ;NO, PRINT THE FILE
TXNE S,RQB ;HAVE WE BEEN REQUEUED?
JRST ENDJOB ;YES, END NOW!!
AOS J$RNFP(J) ;BUMP THE FILE COUNT BY 1.
SETZM J$RNPP(J) ;CLEAR THE PAGES PER FILE COUNT
PUSHJ P,CHKPNT ;TAKE A CHECKPOINT
PUSHJ P,NXTFIL ;BUMP TO NEXT FILE
JUMPT DOJO.4 ;AND LOOP
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
DOJO.7: SKIPN E,J$RLFS(J) ;GET ADR OF LOG-SPEC
JRST ENDJOB ;NO, FINISH JOB
MOVE S1,J$APRT(J) ;GET NUMBER OF PAGES PRINTED
ADDI S1,LOGPAG ;ADD IN GUARANTEED LOG LIMIT
CAMLE S1,J$RLIM(J) ;DOES HE HAVE AT LEAST THAT MANY?
MOVEM S1,J$RLIM(J) ;NO, GIVE HIM THAT MANY
TXZ S,ABORT ;CLEAR ABORT FLAG
PUSHJ P,FILE ;PRINT THE FILE
JRST ENDJOB ;AND FINISH UP
SUBTTL NXTFIL - FIND AND RETURN THE NEXT FILE IN THE NEXTJOB MSG
NXTFIL: SETZM J$RNCP(J) ;CLEAR COPIES PRINTED
SOSG J$RFLN(J) ;DECREMENT FILE COUNT
$RETF ;NO MORE, DONE
LOAD S1,.FPLEN(E),FP.LEN ;GET THE FP LENGTH
ADD E,S1 ;BUMP TO THE FD
LOAD S1,.FDLEN(E),FD.LEN ;GET THE FD LENGTH
ADD E,S1 ;BUMP TO THE NEXT FP
LOAD S1,.FPINF(E),FP.FLG ;GET LOG FILE FLAG
JUMPE S1,.RETT ;RETURN IF NOT THE LOG FILE
MOVEM E,J$RLFS(J) ;SAVE ADDRESS OF LOG FILE SPEC
JRST NXTFIL ;AND LOOP
SUBTTL 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.
MOVEI S1,FOB.SZ ;GET THE FOB LENGTH
MOVEI S2,J$XFOB(J) ;AND THE FOB ADDRESS
TXNE T2,FP.SPL+FP.DEL ;SPOOL FILE or /DELETE ???
PUSHJ P,F%DEL ;YES,,DELETE THE FILE.
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.
PUSHJ P,INPOPN ;OPEN THE INPUT FILE UP
JUMPF .POPJ ;LOSE, RETURN
$TEXT(LOGCHR,<^I/LPMSG/Starting File ^F/@J$DFDA(J)/>)
FILE.1: PUSHJ P,INPREW ;REWIND THE INPUT FILE
PUSHJ P,CHKPNT ;TAKE A CHECKPOINT
PUSHJ P,SETLST ;SETUP /REPORT CODE IF NECESSARY
TXZ S,FORWRD ;CLEAR FORWARD SPACE BIT
TXO S,BANHDR ;LITE 'PRINTING HEADERS' FLAG
PUSHJ P,HEAD ;PRINT THE HEADER
TXZ S,BANHDR ;CLEAR 'PRINTING HEADERS' FLAG
MOVEI S1,LPTERR ;GET NUMBER OF DEVICE ERRORS ALLOWED
MOVEM S1,J$LERR(J) ;AND SAVE IT
SOSLE J$FPIG(J) ;SUBTRACT 1 PAGE FROM STARTING PAGE #.
TXO S,FORWRD ;STILL POSITIVE,,TURN ON FORWARD BIT.
TXNE S,ABORT!SKPFIL!RQB ;DO WE REALLY WANT TO DO THIS ???
JRST FILE.2 ;NO,,CLEAN UP THE MESS.
PUSHJ P,FILOUT ;PRINT THE FILE
TXNE S,ABORT!SKPFIL!RQB ;ABORTED OR SKIPPED OR REQUEUED?
JRST FILE.2 ;YES, CONTINUE ON
LOAD T1,.FPFST(E) ;GET /START PARAMETER.
MOVEM T1,J$FPIG(J) ;SAVE STARTING POINT FOR THIS COPY.
AOS S1,J$RNCP(J) ;INCREMENT AND LOAD COPIES WORD
AOS J$AFXC(J) ;ADD 1 TO THE TOTAL FILE COUNT
LOAD S2,.FPINF(E),FP.FCY ;GET TOTAL NUMBER TO PRINT
CAMGE S1,S2 ;PRINTED ENOUGH?
JRST FILE.1 ;AND LOOP
FILE.2: MOVE S1,J$DIFN(J) ;GET THE IFN
PUSHJ P,F%REL ;RELEASE IT
$TEXT (LOGCHR,<^I/LPMSG/Finished File ^F/@J$DFDA(J)/>)
TXZ S,DSKOPN+SKPFIL+SUPFIL ;CLEAR LOTS OF BITS
POPJ P, ;AND RETURN
SUBTTL ENDJOB - END OF JOB PROCESSOR.
ENDJOB: TXO S,GOODBY ;FLAG EOJ SEQUENCE
TXZ S,FORWRD ;TURN OFF THE FORWARD SPACING BIT.
$TEXT (LOGCHR,<^I/LPEND/Summary:^D5/J$APRT(J)/ Pages of Output>)
TOPS10 <
$TEXT (LOGCHR,<^I/LPEND/ ^D5/J$ADRD(J)/ Disk Blocks Read>)
> ;END TOPS10 CONDITIONAL
TOPS20 <
MOVE S1,J$ADRD(J) ;GET THE NUMBER OF I/O REQUESTS
IMULI S1,SZ.BUF ;CALC NUMBER OF WORDS PROCESSED
IDIVI S1,PAGSIZ ;CALC NUMBER OF PAGES PROCESSED
SKIPE S2 ;ANY REMAINDER ???
ADDI S1,1 ;YES,,ADD 1 PAGE
MOVEM S1,J$ADRD(J) ;SAVE THE # 0F PAGES FOR ACCOUNTING
$TEXT (LOGCHR,<^I/LPEND/ ^D5/J$ADRD(J)/ Disk Pages Read>)
MOVX S1,.FHSLF ;LOAD FORK HANDLE
RUNTM ;GET RUNTIME
ADD S1,J$ARTM(J) ;GET CPU TIME USED
IDIVI S1,^D1000 ;CONVERT TO SECONDS
$TEXT (LOGCHR,<^I/LPEND/ ^D3R /S1/.^D3L0/S2/ Seconds CPU Time Used>)
> ;END TOPS20 CONDITIONAL
PUSHJ P,JOBTRL ;PRINT THE JOB TRAILERS.
PUSHJ P,OUTEOF ;FORCE ALL DATA OUT
ENDREQ: PUSHJ P,QRELEASE ;GO SEND THE RELEASE/REQUEUE MSG.
SETZM J$RACS+S(J) ;CLEAR ALL THE STATUS BITS.
MOVE S1,STREAM ;GET STREAM NUMBER
SETZM JOBACT(S1) ;NOT BUSY
JRST MAIN.3 ;RETURN TO THE SCHEDULER.
SUBTTL QRELEASE - ROUTINE TO SEND A REQUEUE/RELEASE MSG TO QUASAR.
QRELEA: MOVE S1,STREAM ;GET THE STREAM NUMBER.
$WTOJ (End,<^R/.EQJBB(J)/>,@JOBOBA(S1)) ;TELL THE OPERATOR.
SKIPE J$LREM(J) ;IF THIS IS A LOCAL LPT,,SKIP LOGGING
$LOG (Printed ^D/J$APRT(J)/ Pages,,@JOBOBA(S1)) ;LOG # OF PAGES
MOVEI S1,MSBSIZ ;GET BLOCK LENGTH
MOVEI S2,MSGBLK ;AND THE ADDRESS
PUSHJ P,.ZCHNK ;ZERO THE BLOCK
TXNE S,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 ;NO, 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
LOAD S1,J$RNPP(J) ;GET PAGES PRINTED
STORE S1,REQ.IN+CKPAG(T1) ;AND STORE IT
LOAD S1,J$APRT(J) ;GET TOTAL PAGES PRINTED.
STORE S1,REQ.IN+CKTPP(T1) ;STORE IT
MOVX S1,CKFREQ ;GET REQEUE BIT
STORE S1,REQ.IN+CKFLG(T1) ;STORE IT
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,,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 (DEFAULT TO ALWAYS SAVE)
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 OACALI,.OMALI ;OPERATOR ALIGN REQUEST.
XWD OACSUP,.OMSUP ;OPERATOR SUPPRESS REQUEST.
XWD OACBKS,.OMBKS ;OPERATOR BACKSPACE REQUEST.
XWD QSRNWA,.QONWA ;QUASAR NODE-WENT-AWAY MESSAGE
XWD OPRD60,.OMDSP ;DN60 OPERATOR RESPONSE MESSAGE
NMSGT==.-MSGTAB
SUBTTL - CHKOBJ - ROUTINE TO VALIDATE QUASAR/ORION/OPR MSG OBJ BLKS.
;CALL: S1/OFFSET INTO MSGTAB
; S2/MESSAGE TYPE
;
;RET: STREAM/STREAM NUMBER
; J/DATA BASE ADDRESS
; S/STATUS BITS
CHKOBJ: CAIE S2,.OMRSP ;IS THIS AN OPERATOR RESPONSE ???
CAIN S2,.QOSUP ;IS THIS A SETUP/SHUTDOWN MESSAGE ??
$RETT ;YES,,JUST RETURN NOW.
CAIN S2,.OMDSP ;IS THIS A DN60 OPERATOR RESPONSE ???
$RETT ;YES,,JUST RETURN NOW.
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,GOODBY+ABORT ;CHECK SOME BITS
$RETT ;IF WE LEAVING, IGNORE IT ANYWAY
$TEXT(LOGCHR,<^I/LPMSG/Job canceled by user ^U/ABO.ID(M)/>)
MOVE S1,STREAM ;GET THE STREAM NUMBER.
MOVX S2,PSF%OR ;GET OPR RESP WAIT BIT
TDNE S2,JOBSTW(S1) ;ARE WE WAITING FOR THE OPERATOR ???
$KWTOR (JOBWAC(S1)) ;YES,,KILL THE WTOR
ANDCAM S2,JOBSTW(S1) ;ZAP THE OPR WAIT BIT
$WTOJ (<Canceled by User ^U/ABO.ID(M)/>,<^R/.EQJBB(J)/>,@JOBOBA(S1))
TXO S,ABORT ;LITE THE ABORT BIT
PUSHJ P,INPFEF ;FORCE END OF FILE
TXNE S,BANHDR ;ARE WE PRINTING BANNER/HEADER PAGES ???
$RETT ;YES,,JUST RETURN
PUSHJ P,OUTFLS ;NO,,FLUSH THE OUTPUT BUFFERS
JUMPF SHUTND ;CANT,,SHUT IT DOWN !!!
$RETT ;RETURN
SUBTTL QSRNWA - ROUTINE TO SHUTDOWN A STREAN WHOSE NODE HAS DROPPED
QSRNWA: MOVE S1,STREAM ;GET OUR STREAM NUMBER
MOVX S2,PSF%OR ;GET OPR RESP WAIT BIT
TDNE S2,JOBSTW(S1) ;ARE WE WAITING FOR THE OPERATOR ???
$KWTOR (JOBWAC(S1)) ;YES,,KILL THE WTOR
MOVE S1,J$DIFN(J) ;GET THE JFN
TXNE S1,DSKOPN ;IS THE SPOOL FILE OPEN ???
PUSHJ P,F%REL ;YES,,CLOSE IT
MOVX S1,%RSUNA ;GET NOT AVAILABLE RIGHT NOW BITS
PUSHJ P,RSETUP ;TELL QUASAR HE CAN HAVE THE OBJ BACK
PUSHJ P,SHUTND ;SHUT THE STREAM DOWN
$RETT ;AND RETURN
SUBTTL 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
MOVE S1,J$RNPP(J) ;GET NUMBER OF PAGES
MOVEM S1,CHE.IN+CKPAG(T1) ;AND STORE IT
MOVE S1,J$APRT(J) ;NUMBER OF PAGES PRINTED
MOVEM S1,CHE.IN+CKTPP(T1) ;AND STORE IT
LOAD S1,.EQITN(J) ;GET JOBS ITN
MOVEM S1,MSGBLK+CHE.IT ;AND STORE IT
MOVX S1,CKFCHK ;CHKPOINT FLAG
MOVEM S1,CHE.IN+CKFLG(T1) ;STORE IT
MOVEI S1,CHE.ST(T1) ;GET ADDRESS OF STATUS AREA
HRLI S1,(POINT 7,0) ;MAKE IT A BYTE POINTER
MOVEM S1,TEXTBP ;SAVE BYTE POINTER
$TEXT(DEPBP,<Started at ^C/J$RTIM(J)/, printed ^D/J$APRT(J)/ of ^D/J$RLIM(J)/ pages^0>)
HRRZ S1,TEXTBP ;GET THE BYTE POINTER
SUBI S1,MSGBLK-1 ;SUBTRACT START POINT
STORE S1,.MSTYP(T1),MS.CNT ;SAVE THE LENGTH
MOVX S1,.QOCHE ;GET THE FUNCTION CODE
STORE S1,.MSTYP(T1),MS.TYP
PJRST SNDQSR ;AND SEND IT
SUBTTL UPDTST - ROUTINE TO SEND STATUS UPDATES TO QUASAR
UPDTST: PUSHJ P,.SAVE1 ;SAVE P1
MOVE S1,STREAM ;GET THE STREAM NUMBER
MOVE S2,JOBSTW(S1) ;GET THE JOBS STATUS WORD
SETZM JOBCHK(S1) ;CLEAR THE UPDATE FLAG
MOVX P1,%RESET ;DEFAULT TO RESET
SKIPE J$APRG(J) ;ARE WE ALIGNING FORMS ???
MOVX P1,%ALIGN ;YES,,SAY SO
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
TXNE S2,PSF%OO ;ARE WE WAITING FOR OPERATOR OUTPUT ???
MOVX P1,%OPRWT ;YES,,SAY SO
MOVEI T1,MSGBLK ;GET THE MESSAGE BLOCK ADDRESS
MOVEM P1,STU.CD(T1) ;SAVE THE STATUS
HRLZ P1,JOBOBA(S1) ;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 TH 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 ;IF SO,,SHUT IT DOWN !!!
SETZ T2, ;CLEAR A LOOP REG
SETU.1: SKIPN JOBPAG(T2) ;A FREE STREAM?
JRST SETU.2 ;YES!!
CAIGE T2,NPRINT-1 ;NO, LOOP THRU THEM ALL?
AOJA T2,SETU.1 ;NO, KEEP GOING
$STOP(TMS,Too many setups)
SETU.2: MOVEM T2,STREAM ;SAVE THE STREAM NUMBER
MOVEI S1,J$$END ;GET THE LPT DATA BASE LENGTH
ADDI S1,PAGSIZ-1 ;ROUND UP TO NEXT HIGHEST PAGE
IDIVI S1,PAGSIZ ;GET NUMBER OF PAGES IN S1
PUSHJ P,M%AQNP ;ALLOCATE THEM
PG2ADR S1 ;CONVERT TO AN ADDRESS
MOVEM S1,JOBPAG(T2) ;AND SAVE IT
MOVE J,S1 ;PUT IT IN J
SETZM JOBSTW(T2) ;CLEAR THE JOB STATUS WORD
MOVEM J,J$RACS+J(J) ;SAVE J AWAY
MOVEI S1,J$LBFR(J) ;LPT BUFFER ADDRESS
MOVEM S1,J$LBUF(J) ;STORE IT
MOVEI S1,J$GBFR(J) ;LOG FILE BUFFER PAGE (FIRST)
MOVEM S1,J$GBUF(J) ;SAVE IT AWAY
MOVE S2,T2 ;COPY OVER THE STREAM NUMBER
IMULI T2,OBJ.SZ ;GET OFFSET OF OBJECT BLOCK
ADDI T2,JOBOBJ ;ADD IN THE BASE
MOVEM T2,JOBOBA(S2) ;STORE OBJECT ADDRESS
MOVE S2,T2 ;GET DESTINATION OF BLT INTO S2
HRLI S2,SUP.TY(M) ;MAKE A BLT POINTER
BLT S2,OBJ.SZ-1(T2) ;BLT THE OBJECT BLOCK
SETZM J$LREM(J) ;DEFAULT TO LOCAL LPT
MOVE S1,SUP.NO(M) ;GET THIS GUYS NODE NAME
CAMN S1,CNTSTA ;IS IT A LOCAL LPT ???
JRST SETU.3 ;YES,,SKIP THIS
SKIPN SUP.CN(M) ;IS THIS A DN60 REMOTE ???
JRST [SETOM J$LREM(J) ;NO,,MUST BE DN200 - SET DN200 FLAG
JRST SETU.4 ] ;AND CONTINUE PROCESSING
HRLI S1,SUP.CN(M) ;DN60,,GET LINE CONDITIONING BLK ADDRESS
HRRI S1,J$DCND(J) ; AND WHERE TO PUT IT
BLT S1,J$DCND+CN$SIZ-1(J) ;COPY IT OVER
MOVEI S1,1 ;GET A 1 (DN60 FLAG)
MOVEM S1,J$LREM(J) ;MAKE THIS A DN60 REMOTE
MOVE S1,SUP.ST(M) ;GET THE DN60 FLAG WORD
MOVEM S1,J$DFLG(J) ;SAVE IT FOR LATER
JRST SETU.4 ;GO SETUP OUTPUT DEVICE
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
SETU.3: MOVE S1,SUP.ST(M) ;GET A POSSIBLE MAG TAPE DEVICE NAME
LOAD S2,SUP.FL(M),SPLTAP ;GET THE SPOOL-TO-TAPE BIT
SKIPE S2 ;ARE WE SPOOLING TO TAPE ???
MOVEM S1,J$MTAP(J) ;YES,,SAVE THE DEVICE NAME
SETU.4: SETOM J$LCHN(J) ;INDICATE NO OUTPUT CHANNEL YET.
PUSHJ P,OUTGET ;GET THE OUTPUT DEVICE
PUSH P,S1 ;SAVE THE RESPONSE CODE
PUSHJ P,RSETUP ;SEND THE RESPONSE TO SETUP MSG.
POP P,T2 ;GET THE RESPONSE CODE BACK
MOVE S1,STREAM ;GET STREAM NUMBER
AOS S2,STRSEQ ;ADD 1 TO THE STREAM SEQ #, PUT IN S2.
MOVEM S2,JOBWAC(S1) ;SAVE IT AS THE OPR WTOR ACK CODE.
$WTO (<^T/@SETMSG(T2)/>,,@JOBOBA(S1)) ;TELL THE OPR WHATS GOING ON.
CAIE T2,%RSUOK ;ALL IS OK?
JRST SHUTDN ;NO, SHUT IT DOWN
$RETT ;RETURN
SUBTTL SHUTDN - ROUTINE TO SHUT DOWN A LINE-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
SKIPL J$LCHN(J) ;DO WE HAVE AN OUTPUT CHANNEL ???
PUSHJ P,OUTREL ;YES,,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.
MOVE S1,STREAM ;GET OUR STREAM NUMBER
SETZM JOBPAG(S1) ;CLEAR THE PAGE WORD
SETZM JOBACT(S1) ;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
MOVE S1,STREAM ;GET STREAM NUMBER
MOVS S1,JOBOBA(S1) ;GET OBJADR,,0
HRRI S1,RSU.TY(T1) ;AND PLACE TO MOVE IT TO
BLT S1,RSU.TY+OBJ.SZ-1(T1) ;AND MOVE THE OBJECT BLOCK
STORE T2,RSU.CO(T1) ;STORE THE RESPONSE CODE
MOVX S1,OBDLLC ;GET LOWER-CASE BIT
SKIPL J$LLCL(J) ;IS PRINT LOWER CASE?
MOVX S1,OBDLUC ;NO, LOAD THE UPPER CASE FLAG
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.
MOVSI S1,-NPRINT ;CREATE AOBJN AC.
RESP.1: CAME S2,JOBWAC(S1) ;COMPARE ACK CODES..
JRST [AOBJN S1,RESP.1 ;NOT EQUAL,,CHECK NEXT STREAM.
$RETT ] ;NOT THERE,,FLUSH THE MSG.
MOVX S2,PSF%OR ;GET "OPERATOR-RESPONSE" WAIT BIT
ANDCAM S2,JOBSTW(S1) ;AND CLEAR IT
SETOM JOBCHK(S1) ;CHECKPOINT NEXT SCHEDULING PASS
MOVE J,JOBPAG(S1) ;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
MOVE P1,STREAM ;GET STREAM NUMBER.
$ACK (Aborting,<^R/.EQJBB(J)/>,@JOBOBA(P1),.MSCOD(M)) ;TELL THE OPR.
SETZM J$APRG(J) ;ALIGNMENT NOT SCHEDULED,,NOT ACTIVE !!
SETZM JOBWKT(P1) ;SET WAKE UP TIME TO NOW.
SETZM RSNFLG ;SHOW NO REASON GIVEN.
MOVX S1,PSF%OR ;GET OPR RESP WAIT BIT
TDNE S1,JOBSTW(P1) ;ARE WE WAITING FOR THE OPERATOR ???
$KWTOR (JOBWAC(P1)) ;YES,,KILL THE WTOR
ANDCAM S1,JOBSTW(P1) ;ZAP THE OPR WAIT BIT
OACC.0: PUSHJ P,GETBLK ;GET A MESSAGE BLOCK
JUMPF OACC.2 ;NO MORE,,FINISH UP
CAIN T1,.ORREA ;IS THIS THE REASON BLOCK ???
MOVEM T3,RSNFLG ;YES,,SAVE THE REASON ADDRESS
CAIE T1,.CANTY ;IS THIS THE CANCEL TYPE BLOCK ???
JRST OACC.0 ;NO,,SKIP IT AND GET NEXT BLOCK
;YES...
MOVE S1,0(T3) ;LOAD THE CANCEL TYPE.
CAIE S1,.CNPRG ;IS IT /PURGE ???
JRST OACC.0 ;NO,,PROCESS THE NEXT MSG BLK
MOVE S1,J$DIFN(J) ;GET THE FILE IFN.
TXZE S,DSKOPN ;DONT CLOSE IF ITS NOT OPEN.
PUSHJ P,F%REL ;ELSE,,CLOSE IT OUT.
MOVEM S,J$RACS+S(J) ;SAVE THE 'S' AC WITH NEW DSKOPN BITS
PUSHJ P,OUTFLS ;FLUSH THE OUTPUT BUFFERS
JUMPF SHUTND ;CANT,,SHUT IT DOWN
PUSHJ P,SENDFF ;OUTPUT A FORM FEED FOR NEXT JOB
SETZM JOBACT(P1) ;STREAM IS NO LONGER ACTIVE
PUSHJ P,QRELEASE ;RELEASE THE REQUEST
PUSHJ P,OUTEOF ;OUTPUT AN EOF
$RETT ;AND RETURN
OACC.2: $TEXT(LOGCHR,<^I/LPOPR/Job Aborted by the Operator>)
SKIPE RSNFLG ;WAS A REASON GIVEN ???
$TEXT (LOGCHR,<^I/LPOPR/ REASON: ^T/@RSNFLG/>) ;YES,,SAY SO
SKIPN RSNFLG ;WAS A REASON GIVEN ???
$TEXT (LOGCHR,<^I/LPOPR/ No reason given>) ;NO,,SAY SO
TXO S,ABORT ;TELL LPTSPL WE ARE LEAVING.
TXNE S,GOODBY ;ARE WE ON OUR WAY OUT ???
$RETT ;YES,,JUST RETURN
PUSHJ P,INPFEF ;FORCE SPOOL FILE EOF
TXNE S,BANHDR ;ARE WE PRINTING BANNER/HEADER PAGES ???
$RETT ;YES,,JUST RETURN
PUSHJ P,OUTFLS ;NO,,FLUSH THE OUTPUT BUFFERS
JUMPF SHUTND ;CANT,,SHUT IT DOWN
$RETT ;FUNCTION COMPLETE !!!
RSNFLG: 0,,0
SUBTTL OACSUP - Operator SUPPRESS request.
OACSUP: TXNE S,ABORT+RQB+GOODBY ;ARE WE ON OUR WAY OUT ???
PJRST TOOBAD ;YES,,SKIP THIS.
OACS.0: PUSHJ P,GETBLK ;GET A MESSAGE BLOCK
JUMPF .RETT ;NO MORE,,JUST RETURN
CAIN T1,.SUPFL ;IS IT SUPPRESS FILE ???
PJRST OACS.1 ;YES,,THEN GO PROCESS IT AND RETURN
CAIN T1,.SUPJB ;IS IT SUPPRESS JOB ???
JRST OACS.2 ;YES,,THEN GO PROCESS IT AND RETURN
CAIE T1,.SUPST ;IS IT STOP SUPPRESSION ???
JRST OACS.0 ;NO,,GO PROCESS NEXT MSG BLOCK
TXZ S,SUPJOB!SUPFIL ;TURN OFF SUPPRESS FILE AND JOB BIT
$TEXT (LOGCHR,<^I/LPOPR/Operator stopped carriage control supression>)
MOVE S1,STREAM ;GET STREAM NUMBER.
$ACK (Carriage control activated,<^R/.EQJBB(J)/>,@JOBOBA(S1),.MSCOD(M))
$RETT ;RETURN NOW
OACS.1: TXO S,SUPFIL ;TURN ON SUPPRESS FILE BIT.
TXZ S,SUPJOB ;TURN OFF SUPPRESS JOB BIT.
MOVEI S1,[ASCIZ/this file/] ;GET THIS FILE MSG.
JRST OACS.3 ;LETS MEET AT THE PASS
OACS.2: TXO S,SUPJOB ;TURN ON SUPPRESS JOB BIT.
TXZ S,SUPFIL ;TURN OFF SUPPRESS FILE BIT.
MOVEI S1,[ASCIZ/this job/] ;GET THIS JOB MSG.
OACS.3: $TEXT(LOGCHR,<^I/LPOPR/Operator suppressed carriage control for rest of ^T/0(S1)/>)
MOVE S1,STREAM ;GET STREAM NUMBER.
$ACK (Carriage control suppressed,<^R/.EQJBB(J)/>,@JOBOBA(S1),.MSCOD(M))
$RETT ;RETURN NOW
SUBTTL OACPAU - Operator PAUSE request.
OACPAU: MOVX S2,PSF%ST ;LOAD THE STOP BIT
MOVE S1,STREAM ;GET THE STREAM NUMBER
IORM S2,JOBSTW(S1) ;SET IT
$ACK (Stopped,,@JOBOBA(S1),.MSCOD(M)) ;TELL THE OPERATOR.
SETOM JOBCHK(S1) ;SAY WE WANT A CHECKPOINT TAKEN.
$RETT ;AND RETURN
SUBTTL OACCON - Operator CONTINUE request.
OACCON: MOVE S1,STREAM ;GET THE STREAM NUMBER
MOVX S2,PSF%ST ;LOAD THE BITS
ANDCAM S2,JOBSTW(S1) ;CLEAR IT
$ACK (Continued,,@JOBOBA(S1),.MSCOD(M)) ;TELL THE OPERATOR.
SETOM JOBCHK(S1) ;SAY WE WANT TO TAKE A CHECKPOINT.
$RETT ;AND RETURN
SUBTTL OACREQ - Operator REQUEUE request.
OACREQ: TXNE S,GOODBY ;IS IT TOO LATE FOR THIS ???
PJRST TOOBAD ;YES,,TOUGH LUCK !!!
PUSHJ P,INPFEF ;FORCE AN INPUT EOF
TXO S,RQB+ABORT ;LITE THE REQUEUE+ABORT BITS
$TEXT(LOGCHR,<^I/LPOPR/Job requeued by the the operator>)
MOVE S1,STREAM ;GET THE STREAM NUMBER
$ACK (Requeued,<^R/.EQJBB(J)/>,@JOBOBA(S1),.MSCOD(M)) ;TELL OPR
MOVX S2,PSF%OR ;GET OPR RESP WAIT BIT
TDNE S2,JOBSTW(S1) ;ARE WE WAITING FOR THE OPERATOR ???
$KWTOR (JOBWAC(S1)) ;YES,,KILL THE WTOR
ANDCAM S2,JOBSTW(S1) ;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 ???
$TEXT (LOGCHR,<^I/LPOPR/Requeue reason is: ^T/0(T3)/.>)
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, DO IT
SETZM J$RNPP(J) ;CLEAR CURRENT PAGE NUMBER
CAXN S1,.RQBCP ;BEGINNING OF COPY?
MOVEI S2,[ASCIZ /current copy/]
JUMPN S2,OACR.2 ;AND CONTINUE ON
SETZM J$RNCP(J) ;CLEAR CURRENT COPY NUMBER
CAXN S1,.RQBFL ;FROM BEGINING OF FILE?
MOVEI S2,[ASCIZ /current file/]
JUMPN S2,OACR.2 ;AND CONTINUE ON
SETZM J$RNFP(J) ;CLEAR FILE COUNT
MOVEI S2,[ASCIZ /job/] ;FROM BEGINNING OF JOB
OACR.2: $TEXT(LOGCHR,<^I/LPOPR/Job will restart at the beginning of the ^T/0(S2)/>)
JRST OACR.0 ;GO PROCESS THE NEXT MSG BLOCK.
OACR.3: $TEXT(LOGCHR,<^I/LPOPR/Job will restart at the current position>)
MOVNI S1,2 ;LOAD -2
ADDM S1,J$RNPP(J) ;INSURE NO LOSSAGE OF DATA
ADDM S1,J$APRT(J) ;HERE ALSO
SKIPGE J$RNPP(J) ;MAKE SURE WE DIDN'T SCREW THINGS UP
SETZM J$RNPP(J) ;YES,,ZERO THE PAGES PER COPY
SKIPGE J$APRT(J) ;CHECK HERE ALSO
SETZM J$APRT(J) ;NO GOOD,,SET IT TO ZERO
JRST OACR.0 ;GO PROCESS THE NEXT MSG BLOCK
SUBTTL OACALI - Routine to process Operator ALIGN request.
; J$APRG(J) :: [?,,-1] = ALIGN IN PROGRESS.
; [-1,,?] = ALIGN NEEDS TO BE SCHEDULED.
OACALI: TXNE S,ABORT+RQB+GOODBY ;ARE WE ON OUR WAY OUT ???
PJRST TOOBAD ;YES,,SKIP THIS.
SETZM FDADDR ;RESET ALIGN FD ADDRESS.
OALI.0: PUSHJ P,GETBLK ;GET A MESSAGE DATA BLOCK
JUMPF OALI.1 ;NO MORE,,CONTINUE PROCESSING
MOVE S1,0(T3) ;GET THE FIRST DATA WORD IN THE BLOCK
MOVEI T3,-1(T3) ;POINT TO THE BLOCK HEADER
CAIN T1,.ALPAU ;IS THIS THE /PAUSE BLOCK ???
MOVEM S1,J$ASLP(J) ;YES,,SAVE THE SLEEP TIME
CAIN T1,.ALRPT ;IS THE THE /REPEAT-COUNT BLOCK ???
MOVEM S1,J$ACNT(J) ;YES,,SAVE THE REPEAT-COUNT
CAIN T1,.CMIFI ;IS THIS THE FILE-SPEC BLOCK ???
MOVEM T3,FDADDR ;SAVE THE FD ADDRESS
CAIN T1,.ALSTP ;IS THIS THE /STOP BLOCK ???
PJRST OALI.6 ;YES,,GO PROCESS IT AND RETURN
JRST OALI.0 ;NONE OF THESE,,TRY NEXT BLOCK
OALI.1: SKIPN J$APRG(J) ;ARE WE ALREADY ALIGNING ???
JRST OALI.2 ;NO,,THEN WE'RE OK
MOVE S1,STREAM ;YES,,GET STREAM NUMBER.
$ACK (ALIGN already in progress,,@JOBOBA(S1),.MSCOD(M))
$RETT ;RETURN NOW.
OALI.2: MOVEI S1,FOB.SZ ;PICK UP FOB SIZE.
MOVEI S2,J$XFOB(J) ;PICK UP FOB ADDRESS.
PUSHJ P,.ZCHNK ;ZERO OUT THE FOB BLOCK.
MOVEI S1,7 ;PICK UP ASCII BYTE SIZE
STORE S1,J$XFOB+FOB.CW(J),FB.BSZ ;AND SAVE IT IN FOB.
SKIPN S1,FDADDR ;SKIP FD GEN IF USER SPECIFIED.
PUSHJ P,BLDLFD ;GO BUILD THE ALIGN FD.
STORE S1,J$XFOB+FOB.FD(J) ;AND SAVE ITS ADDRESS IN FOB.
MOVEI S1,FOB.SZ ;PICK UP THE FOB SIZE.
MOVEI S2,J$XFOB(J) ;PICK UP THE FOB ADDRESS.
PUSHJ P,F%IOPN ;OPEN THE ALIGN FILE.
JUMPF OALI.3 ;IF AN ERROR, RETURN WITH WTO.
MOVEM S1,J$AIFN(J) ;SAVE THE FILE ID.
SKIPG S1,J$ACNT(J) ;PICK UP USER DEFINED REPEAT-COUNT.
SKIPLE S1,J$FALC(J) ;ELSE PICK UP LPFORM.INI REPEAT-CNT.
SKIPA ;SKIP DEFAULT.
MOVE S1,D$ALCN ;PICK UP THE DEFAULT REPEAT COUNT.
MOVEM S1,J$ACNT(J) ;SAVE THE REPEAT-COUNT.
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
SKIPG S1,J$ASLP(J) ;PICK UP USER SLEEP TIME.
SKIPLE S1,J$FALS(J) ;ELSE, PICK UP LPFORM.INI SLEEP-TIME.
SKIPA ;SKIP THE DEFAULT.
MOVE S1,D$ALSL ;PICK UP THE DEFUALT SLEEP-TIME.
IMULI S1,3 ;CONVERT TO UNIVERSAL TIME.
MOVEM S1,J$ASLP(J) ;AND SAVE IT.
SETOM J$APRG(J) ;SHOW WE ARE DOING AN ALIGN,
; AND THAT IT NEEDS TO BE SCHEDULED.
MOVE S1,STREAM ;GET STREAM NUMBER
$WTO (Alignment Scheduled,,@JOBOBA(S1)) ;TELL THE OPERATOR.
SETOM JOBCHK(S1) ;SAY WE WANT A CHECKPOINT.
$RETT ;RETURN.
OALI.3: MOVE S1,STREAM ;GET STREAM NUMBER
$WTO (<^E/[-1]/>,<Cannot read ALIGN file ^F/@J$XFOB+FOB.FD(J)/>,@JOBOBA(S1))
$RETT
OALI.6: SKIPE J$APRG(J) ;ARE WE ALREADY ALIGNING ???
JRST OALI.7 ;IF SO,,CONTINUE PROCESSING.
MOVE S1,STREAM ;GET STREAM NUMBER
$ACK (</STOP Illegal>,Alignment not in Progress,@JOBOBA(S1),.MSCOD(M))
$RETT
OALI.7: MOVE S1,J$AIFN(J) ;GET THE ALIGN IFN.
SETOB S2,J$ABYT(J) ;SET ALIGN FILE BYTE COUNT TO -1.
PUSHJ P,F%POS ;POSITION TO ALIGN EOF.
SETZM J$ACNT(J) ;SET REPEAT-COUNT TO 0.
MOVE S1,STREAM ;GET STREAM NUMBER
$ACK (Alignment Discountinued,,@JOBOBA(S1),.MSCOD(M))
$RETT ;AND RETURN
FDADDR: 0,,0
SUBTTL OACFWS - OPERATOR FORWARD SPACE COMMAND PROCESSOR.
OACFWS: TXNE S,ABORT+RQB+GOODBY ;ARE WE ON OUR WAY OUT ???
PJRST TOOBAD ;YES,,SKIP THIS.
MOVE S1,STREAM ;GET THE STREAM NUMBER.
SETOM JOBCHK(S1) ;SAY WE WANT TO TAKE A CHECKPOINT.
OACF.0: PUSHJ P,GETBLK ;GET A MESSAGE BLOCK
JUMPF .RETT ;NO MORE,,RETURN
CAIN T1,.SPPAG ;IS THIS FORWARD SPACE PAGES ???
PJRST FSPACE ;YES,,DO IT
CAIN T1,.SPCPY ;IS THIS FORWARD SPACE COPIES ???
PJRST FCOPYS ;YES,,DO IT
CAIN T1,.SPFIL ;IS THIS FORWARD SPACE 1 FILE ???
PJRST FFILES ;YES,,DO IT
JRST OACF.0 ;NONE OF THESE,,TRY NEXT BLOCK
FSPACE: TXNN S,DSKOPN ;IS THERE A SPOOL FILE OPEN ???
$RETT ;NO,,JUST IGNORE THIS
TXO S,FORWRD ;TURN ON FORWARD SPACE BIT.
MOVE S2,0(T3) ;PICK UP # OF PAGES TO FSPACE.
MOVEM S2,J$FPIG(J) ;SAVE THE VALUE.
MOVE S1,STREAM ;PICK UP THE STREAM NUMBER.
$ACK (<Forward spaced ^D/S2/ Pages>,,@JOBOBA(S1),.MSCOD(M))
$TEXT (LOGCHR,<^I/LPMSG/File ^F/@J$DFDA(J)/ Forward spaced ^D/J$FPIG(J)/ Pages>)
$RETT ;AND RETURN
FCOPYS: MOVE S2,0(T3) ;PICK UP THE # OF COPIES TO FSPACE.
ADDM S2,J$RNCP(J) ;ADD TO # OF COPIES ALREADY PRINTED.
$TEXT (LOGCHR,<^I/LPMSG/File ^F/J$DFDA(J)/ Forward spaced ^D/S2/ Copies>)
MOVE S1,STREAM ;PICK UP THE STREAM NUMBER.
$ACK (<Forward Spaced ^D/S2/ Copies>,,@JOBOBA(S1),.MSCOD(M))
PUSHJ P,INPFEF ;FORCE AN END-OF-FILE.
$RETT ;AND RETURN
FFILES: MOVE S1,STREAM ;PICK UP THE STREAM NUMBER
$ACK (Forward Spaced 1 File,,@JOBOBA(S1),.MSCOD(M))
$TEXT (LOGCHR,<^I/LPMSG/File ^F/J$DFDA(J)/ Skipped by Operator>)
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+GOODBY ;ARE WE ON OUR WAY OUT ???
PJRST TOOBAD ;YES,,SKIP THIS.
MOVE S1,STREAM ;GET THE STREAM NUMBER.
SETOM JOBCHK(S1) ;SAY WE WANT TO TAKE A CHECKPOINT.
OACB.0: PUSHJ P,GETBLK ;GET A MESSAGE DATA BLOCK
JUMPF .RETT ;NO MORE,,JUST RETURN
MOVE S1,T3 ;GET THE DATA ADDRESS IN S1.
CAIN T1,.SPPAG ;IS THIS BACKSPACE 'PAGES' ???
PJRST BSPACE ;YES,,GO PROCESS IT
CAIN T1,.SPCPY ;IS IT BACKSPACE COPIES ???
PJRST BCOPYS ;YES,,GO PROCESS IT
CAIN T1,.SPFIL ;IS IT BACKSPACE FILES ???
PJRST BFILES ;YES,,GO PROCESS IT
JRST OACB.0 ;NONE OF THESE,,TRY NEXT BLOCK
BSPACE: MOVE T1,0(S1) ;PICK UP THE NUMBER OF PAGES TO BSPACE.
MOVE S1,STREAM ;PICK UP STREAM NUMBER.
$ACK (<Backspaced ^D/T1/ Pages>,,@JOBOBA(S1),.MSCOD(M))
$TEXT (LOGCHR,<^I/LPMSG/File ^F/@J$DFDA(J)/ Backspaced ^D/T1/ Pages>)
TXNN S,DSKOPN ;IS THE SPOOL FILE OPEN ???
$RETT ;NO,,JUST RETURN.
SETOM J$DBCT(J) ;RESET THE INPUT BYTE COUNT
SETZM J$FPIG(J) ;ZERO THE FORWARD SPACE PAGE COUNTER
SETZM J$FCBC(J) ;CLEAR THE CURRENT INPUT BUFFER BYTE CNT
MOVE S1,J$FLIN(J) ;GET LINES PER PAGE
MOVEM S1,J$XPOS(J) ;RESET THE PAGE POSITION TO TOP OF PAGE
MOVX S1,.CHFFD ;GET A FORM FEED
MOVEM S1,J$RACS+C(J) ;CONVERT NXT CHAR TO FORM FEED
MOVE S1,J$RNPP(J) ;GET THE # OF PAGES PRINTED SO FAR.
SUB S1,T1 ;CALC DESTINATION PAGE NUMBER
SKIPGE S1 ;CAN'T BE NEGATIVE
SETZM S1 ;IF SO,,MAKE IT ZERO
MOVEM S1,J$RNPP(J) ;RESET PAGE POINTER FOR THIS FILE
JUMPLE S1,BSPA.2 ;MORE THEN WE PRINTED,,JUST REWIND FILE
CAXLE T1,PAGSIZ ;REQUESTING MORE THEN WE'RE TRACKING ??
JRST BSPA.2 ;YES,,REWIND THE FILE
MOVE S2,J$FBPT(J) ;GET THE PAGE TABLE ENTRY POINTER
SUBI S2,J$FPAG(J) ;CALC INDEX TO CURRENT PAGE
SUBI S2,1(T1) ;CALC INDEX TO NEW PAGE
JUMPGE S2,BSPA.1 ;IF POSITIVE,,THEN NO PROBLEM
TXNN S,FBPTOV ;ELSE CHECK FOR PAGE TABLE OVERFLOW
JRST BSPA.2 ;NO,,HMMMMM,,JUST REWIND THE FILE
ADDI S2,J$FPAG+PAGSIZ(J) ;GET TABLE ENTRY FROM THE TOP
SKIPA ;SKIP NON OVERFLOW PATH
BSPA.1: ADDI S2,J$FPAG(J) ;GET TABLE ENTRY FROM THE BOTTOM
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
MOVEI S1,1(S2) ;POINT TO NEXT PAGE TBL ENTRY
MOVEM S1,J$FBPT(J) ;AND MAKE THIS THE CUR TBL ENTRY ADDR
MOVE S2,0(S2) ;PICK UP THE LISTING PAGE ADDRESS
MOVEM S2,J$FTBC(J) ;AND MAKE THIS THE TOTAL BUFR BYTE COUNT
MOVE S1,J$DIFN(J) ;GET THE SPOOL FILE IFN
PUSHJ P,F%POS ;POSITION TO THAT PAGE IN THE FILE
$RETT ;AND RETURN
BSPA.2: PUSH P,S1 ;SAVE THE DESTINATION PAGE #
PUSHJ P,INPREW ;REWIND THE SPOOL FILE
POP P,S1 ;RESTORE DESTINATION PAGE NUMBER
JUMPLE S1,.RETT ;IF NO SLACK DATA,,SKIP FORWARD SPACE
MOVEM S1,J$FPIG(J) ;SAVE THE # OF PAGES TO FORWARD SPACE
TXO S,FORWRD ;LITE FORWARD SPACE BIT
$RETT ;RETURN
SUBTTL 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.
$TEXT (LOGCHR,<^I/LPMSG/File ^F/@J$DFDA(J)/ Backspaced ^D/T1/ Copies>)
MOVE S1,STREAM ;PICK UP STREAM NUMBER.
$ACK (<Backspaced ^D/T1/ Copies>,,@JOBOBA(S1),.MSCOD(M))
PUSHJ P,INPFEF ;FORCE END OF FILE.
$RETT ;RETURN.
BFILES: PUSHJ P,INPFEF ;FORCE AN END-OF-FILE
SOS J$RNCP(J) ;ADD 1 COPY TO THE FILE COPY COUNT
MOVE S1,STREAM ;GET OUR STREAM NUMBER
$ACK (<Backspaced Current File>,,@JOBOBA(S1),.MSCOD(M))
LOAD S1,.FPLEN(E),FP.LEN ;GET THE FP LENGTH
ADD S1,E ;POINT TO THE FD
$TEXT (LOGCHR,<^I/LPMSG/Backspaced to Beginning of ^F/0(S1)/>)
$RETT
PAGES: 0,,0
SUBTTL DN60 OPERATOR CONSOLE OUTPUT SUPPORT ROUTINES
;CALL: M/ The Operator Message Address
;
;RET: True Always
IFE FTDN60,<
OPRD60: $RETT ;SHOULD NOT HAPPEN
OPRCHK: $RETT ;JUST RETURN
>
IFN FTDN60,<
OPRD60: SETOM JOBITS ;DONT SAVE THE STATUS BITS
MOVX T1,.OTLPT ;GET LINE PRINTER OBJECT TYPE
SETZM T2 ;GET UNIT 0
MOVE T3,.MSCOD(M) ;GET NODE NAME
MOVEI S1,T1 ;POINT TO THIS OBJECT BLOCK
PUSHJ P,FNDOBJ ;FIND IT IN OUR DATA BASE
JUMPT OPRD.2 ;ITS THERE,,CONTINUE ON
$WTO(<No Operator Console for IBM Remote '^W/.MSCOD(M)/'>,,,<$WTFLG(WT.SJI)>)
$RETT ;NOT FOUND,,TELL LOCAL OPR AND EXIT
OPRD.2: PUSHJ P,.SAVE2 ;SAVE P1 AND P2 FOR A MINUTE
MOVE S1,J$LINK(J) ;GET THE OPR MSG LIST ID
PUSHJ P,L%LAST ;POSITION TO LAST ENTRY
LOAD S2,.MSTYP(M),MS.CNT ;GET THE MESSAGE LENGTH
SUBI S2,.OHDRS ;SUBTRACT ALL HEADER LENGTHS
ADDI S2,OPRLEN+2 ;ADD OUR HEADER+TIME STAMP LENGTH
MOVE S1,J$LINK(J) ;GET THE OPR MSG LIST ID
PUSHJ P,L%CENT ;CREATE AN ENTRY IN THE LIST
MOVE P1,S2 ;SAVE THE ENTRY ADDRESS
MOVEI P2,.OHDRS(M) ;POINT TO THE FIRST MESSAGE BLOCK
LOAD T1,.OARGC(M) ;GET THE BLOCK COUNT
MOVEI S1,OPRTXT(P1) ;GET THE TEXT ADDRESS
HRLI S1,(POINT 7,0) ;MAKE IT A BYTE POINTER
MOVEM S1,TEXTBP ;SAVE IT FOR $TEXT
OPRD.3: LOAD S1,ARG.HD(P2),AR.TYP ;GET THE BLOCK TYPE
CAXN S1,.ORDSP ;IS IT A DISPLAY BLOCK ???
$TEXT (DEPBP,<^C/ARG.DA(P2)/ ^T/ARG.DA+1(P2)/>) ;YES,,GEN THE DISPLAY
CAXN S1,.CMTXT ;IS IT A TEXT BLOCK ???
$TEXT (DEPBP,<^T/ARG.DA(P2)/>) ;YES,,GEN THE DISPLAY
LOAD S1,ARG.HD(P2),AR.LEN ;GET THIS BLOCK LENGTH
ADD P2,S1 ;POINT TO THE NEXT BLOCK
SOJG T1,OPRD.3 ;PROCESS ALL MESSAGE BLOCKS
HRROI S1,OPRTXT(P1) ;GEN BYTE PTR TO MSG TEXT
MOVEM S1,OPRPTR(P1) ;SAVE IT IN THE LIST
HRRZ S1,TEXTBP ;GET THE LAST TEXT ADDRESS
SUBI S1,OPRTXT-1(P1) ;CALC THE TEXT LENGTH
IMULI S1,5 ;CALC THE NUMBER OF BYTES
MOVNM S1,OPRBCT(P1) ;SAVE THE -BYTE COUNT
SETOM J$OMSG(J) ;FLAG THAT THE STATION HAS A MESSAGE
$RETT ;AND RETURN
SUBTTL OPRCHK - ROUTINE TO CHECK FOR DN60 OPR MSGS AND SEND THEM
;CALL: P1/ THE STREAM WE ARE CHECKING
;RET: True Always
OPRCHK: SKIPN J,JOBPAG(P1) ;IS THIS STREAM SETUP ???
$RETT ;NO,,JUST RETURN
MOVEI S1,3 ;GET 3 SECONDS
MOVEM S1,SLEEPT ; AND SAVE IT FOR THE SCHEDULER
SKIPN J$OMSG(J) ;AND IS THERE AN OPR MESSAGE WAITING ?
$RETT ;NO TO EITHER,,JUST RETURN
PUSHJ P,.SAVE1 ;SAVE P1 FOR A MINUTE
HRRZM P1,STREAM ;HERE ALSO
OPRC.0: MOVE S1,J$LINK(J) ;GET THE OPR MSG LIST ID
PUSHJ P,L%FIRST ;GET THE FIRST MESSAGE ON THE CHAIN
JUMPF OPRC.3 ;NONE THERE,,CLEAN UP AND RETURN
MOVE P1,S2 ;SAVE THE MSG ADDRESS
MOVE S1,J$D6OP(J) ;GET THE OPR'S CONSOLE ID
MOVE S2,OPRPTR(P1) ;GET THE POINTER TO THE TEXT
MOVE T1,OPRBCT(P1) ;GET THE TEXT BYTE COUNT
PUSHJ P,D60SOUT## ;OUTPUT THE OPERATOR MESSAGE
JUMPT OPRC.2 ;IF OK,,DELETE THIS MSG,,TRY NEXT
CAXE S1,D6DOL ;IS THE ERROR 'DEVICE OFFLINE'
CAXN S1,D6NBR ; OR IS IT A NON-BLOCKING RETURN
JRST OPRC.1 ;YES,,THEN HE WINS
CAXN S1,D6CGO ;IS ERROR 'CANT GET OUTPUT PERMISSION' ?
$RETT ;YES,,JUST RETURN
$WTO (<Fatal DN60 Error #^O/S1/>,,,<$WTFLG(WT.SJI)>) ;TELL LOCAL OPR
MOVX S1,%RSUDE ;GET 'DOES NOT EXIST' SETUP CODE
PUSHJ P,RSETUP ;TELL QUASAR WHATS GOING ON
PUSHJ P,SHUTND ;SHUT EVERYTHING DOWN !!!
$RETT ;AND RETURN
OPRC.1: MOVEM S2,OPRPTR(P1) ;SAVE THE NEW TEXT POINTER
MOVEM T1,OPRBCT(P1) ;SAVE THE NEW TEXT BYTE COUNT
CAXN S1,D6NBR ;WAS THE ERROR 'NON-BLOCKING RETURN' ???
JRST OPRC.0 ;YES,,GO TRY OUTPUT AGAIN
MOVX S1,PSF%OO ;GET 'OPERATOR OUTPUT WAIT' BITS
MOVE S2,STREAM ;GET THIS STREAM NUMBER
IORM S1,JOBSTW(S2) ;LITE 'OPERATOR OUTPUT WAIT'
$RETT ;RETURN, WAIT 3 SECONDS & RETRY
OPRC.2: MOVE S1,J$LINK(J) ;GET OPR MSG LIST ID
PUSHJ P,L%DENT ;DELETE THE CURRENT MESSAGE
JRST OPRC.0 ;AND GO PROCESS THE NEXT
OPRC.3: MOVX S1,PSF%OO ;GET 'OPERATOR OUTPUT WAIT' BITS
MOVE S2,STREAM ;GET OUR STREAM NUMBER
ANDCAM S1,JOBSTW(S2) ;CLEAR 'OPERATOR OUTPUT WAIT' BITS
SETZM J$OMSG(J) ;CLEAR MSGS WAITING FLAG
MOVE S1,J$D6OP(J) ;GET THE OPERATOR CONSOLE ID
PUSHJ P,D60EOF## ;TURN THE LINE AROUND
$RETT ;AND RETURN
>
SUBTTL BLDL - CREATE A 10/20 FD FOR THE ALIGN FILE.
BLDLFD:
TOPS10 <
MOVEI S1,FDMSIZ ;PICK UP 10 FD SIZE.
STORE S1,J$AFD+.FDLEN(J),FD.LEN ;SAVE IN FD.
MOVSI S1,'SYS' ;PICK UP STRUCTURE NAME.
MOVEM S1,J$AFD+.FDSTR(J) ;SAVE IN FD.
MOVE S1,J$FALI(J) ;PICK UP FILE NAME (FORMS TYPE).
MOVEM S1,J$AFD+.FDNAM(J) ;SAVE IN FD.
MOVSI S1,'ALP' ;PICK UP FILE EXT.
MOVEM S1,J$AFD+.FDEXT(J) ;SAVE IN FD.
MOVEI S1,J$AFD(J) ;PICK UP FD ADDRESS.
$RETT ;RETURN. . . . . . . . . .
> ;END TOPS10 CONDITIONAL
TOPS20 <
MOVEI S1,AFDSIZ ;GET THE FD LENGTH
STORE S1,J$AFD+.FDLEN(J),FD.LEN ;SAVE IT
$TEXT (<-1,,J$AFD+.FDSTG(J)>,<SYS:^W/J$FALI(J)/.ALP^0>)
MOVEI S1,J$AFD(J) ;PICK UP FD ADDRESS.
$RETT ;RETURN. . . . . . . . . .
> ;END TOPS20 CONDITIONAL
SUBTTL ALIGN Processor.
ALIGN: TXNE S,GOODBY!ABORT ;ARE WE LEAVING ???
JRST ALIG.5 ;RETURN.
MOVE S1,J$AIFN(J) ;GET THE IFN
PUSHJ P,F%REW ;REWIND THE FILE
SETZM J$XTOP(J) ;CLEAR TOP OF FORM FLAG
PUSHJ P,SENDFF ;SEND A FORM-FEED
ALIG.1: SOSGE J$ABYT(J) ;DECREMENT THE BYTE COUNT
JRST ALIG.3 ;IF BUFFER EMPTY,,GET NEXT BUFFER.
ILDB C,J$APTR(J) ;PICK UP THE ALIGN BYTE.
PUSHJ P,DEVOUT ;PUT IT OUT....
JRST ALIG.1 ;GO GET NEXT BYTE.
ALIG.2: PUSHJ P,OUTDMP ;FORCE OUT THE BUFFER
SOSLE J$ACNT(J) ;COUNT DOWN
JRST ALIG.4 ;IF AGAIN,,SET UP SLEEP TIME.
SETZM J$XTOP(J) ;CLEAR TOP OF FORM
PUSHJ P,SENDFF ;GO TO TOP OF FORM
ALIG.5: MOVE S1,J$AIFN(J) ;PICK UP ALIGN IFN.
PUSHJ P,F%REL ;CLOSE THE ALIGN FILE.
SETZM J$APRG(J) ;INDICATE NO ALIGN IN PROGRESS.
SETZM J$ASLP(J) ;CLEAR THIS SLEEP TIME
SETZM J$ACNT(J) ;AND THIS REPEAT COUNT
MOVE S1,STREAM ;GET THE STREAM NUMBER.
SETOM JOBCHK(S1) ;SAY WE WANT TO CHECKPOINT.
$RETT ;AND RETURN
ALIG.3: MOVE S1,J$AIFN(J) ;GET ALIGN IFN.
PUSHJ P,F%IBUF ;GET AN ALIGN BUFFER.
JUMPF ALIG.2 ;IF NO MORE,,SLEEP A WHILE.
MOVEM S1,J$ABYT(J) ;SAVE THE # OF BYTES.
MOVEM S2,J$APTR(J) ;SAVE THE BYTE POINTER.
JRST ALIG.1 ;KEEP ON PROCESSING.
ALIG.4: MOVE S2,STREAM ;PICK UP STREAM NUMBER.
PUSHJ P,I%NOW ;GET CURRENT TIME.
ADD S1,J$ASLP(J) ;ADD /PAUSE VALUE.
MOVEM S1,JOBWKT(S2) ;SAVE WAKE UP TIME FOR STREAM.
$DSCHD (PSF%AL) ;SHOW STREAM BLOCKED FOR ALIGNMENT.
JRST ALIGN ;WHEN RETURN,,CONTINUE.
SUBTTL 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
SETZ T4, ;CLEAR AN INDEX REGISTER
FNDO.1: MOVE S2,T4 ;GET THE INDEX
IMULI S2,3 ;MULTIPLY BY OBJECT BLCK SIZE
CAMN T1,JOBOBJ+OBJ.TY(S2) ;COMPARE
CAME T2,JOBOBJ+OBJ.UN(S2) ;COMPARE
JRST FNDO.2 ;NOPE
CAMN T3,JOBOBJ+OBJ.ND(S2) ;COMPARE
JRST FNDO.3 ;WIN, SETUP THE CONTEXT
FNDO.2: ADDI T4,1 ;INCREMENT
CAIL T4,NPRINT ;THE END OF THE LINE?
$RETF ;YES,,RETURN 'OBJECT NOT THERE'
JRST FNDO.1 ;OK, LOOP
FNDO.3: MOVEM T4,STREAM ;SAVE STREAM NUMBER
SKIPN J,JOBPAG(T4) ;GET ADDRESS OF DATA
$RETF ;UNLESS ITS NOT REALLY SETUP THEN RETURN
MOVE S,J$RACS+S(J) ;GET HIS 'S'
$RETT ;AND RETURN
SUBTTL 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 CHKLPT - ROUTINE TO MAKE SURE THE DEVICE IS ONLINE
CHKLPT:
TOPS20 <
SKIPE S1,JOBSTW ;ARE ANY STATUS BITS SET ???
TXNN S1,PSF%DO ;IF SO,,IS IT DEVICE OFFLINE ???
$RETT ;NO TO EITHER,,JUST RETURN
$WTO (<^T/BELL/>,,@JOBOBA) ;TELL OPR DEVICE IS OFFLINE
PUSHJ P,UPDTST ;SEND A STATUS UPDATE
SETOM JOBCHK ;INDICATE WE WANT ANOTHER WHEN WE CAN
> ;END TOPS20 CONDITIONAL
$RETT ;RETURN
SUBTTL TOOBAD - ROUTINE TO RESPOND TO THE OPERATOR IF HIS REQUEST IS TOO LATE.
TOOBAD: MOVE S1,STREAM ;GET THE STREAM NUMBER.
$ACK (Print Request Completed,<^R/.EQJBB(J)/>,@JOBOBA(S1),.MSCOD(M))
$RETT
SUBTTL LOGCHR -- Type a character in the log file
LOGCHR: CAIE S1,.CHLFD ;IS IT A LINE-FEED
CAIN S1,23 ;OR A DC 3?
AOS J$GNLN(J) ;YES, COUNT ANOTHER LINE
LOGC.1: SOSGE J$GIBC(J) ;IS THERE ROOM?
JRST LOGC.2 ;NO, GET ANOTHER PAGE
IDPB S1,J$GIBP(J) ;YES, DEPOSIT THE CHARACTER
$RETT ;AND RETURN
LOGC.2: PUSH P,S1 ;SAVE THE CHARACTER FOR A MINUTE
PUSHJ P,LOGBUF ;GET ANOTHER PAGE
POP P,S1 ;RESTORE THE CHARACTER
JRST LOGC.1 ;AND TRY AGAIN
SUBTTL LOGBUF -- Get a buffer page for LOG
LOGBUF: PUSHJ P,.SAVE1 ;SAVE P1
AOS P1,J$GINP(J) ;INCREMENT BUFFER PAGE COUNT
CAIN P1,1 ;IS THIS THE FIRST PAGE?
JRST [MOVE S1,J$GBUF(J) ;YES, USE THE PRE-ALLOCATED PAGE
JRST LOGB.1] ;AND CONTINUE ON
CAIL P1,^D10 ;NO, WITHIN RANGE?
$STOP(TML,TOO MANY LOG BUFFERS REQUIRED) ;NO,,COMMIT SUICIDE
PUSHJ P,M%GPAG ;GET A PAGE
ADDI P1,-1(J) ;POINT TO LOCATION IN J$GBUF
MOVEM S1,J$GBUF(P1) ;STORE THE ADDRESS
LOGB.1: HRLI S1,(POINT 7,0) ;MAKE A BYTE POINTER
MOVEM S1,J$GIBP(J) ;AND STORE IT
MOVEI S1,<5*1000>-1 ;GET A COUNT
MOVEM S1,J$GIBC(J) ;STORE IT
POPJ P, ;AND RETURN
SUBTTL SYSTEM ACCOUNTING ROUTINES
TOPS10 <
ACTBEG: $RETT ;JUST RETURN
ACTEND: $RETT ;HERE ALSO
> ;END TOPS10 CONDITIONAL
TOPS20 <
ACTBEG: MOVX S1,.FHSLF ;GET FORK HANDLE
RUNTM ;GET MY RUNTIME
MOVNM S1,J$ARTM(J) ;REMEMBER IT NEGATED
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
ADDM S1,J$ARTM(J) ;STORE IT
SKIPN ACTFLG ;ARE WE DOING ACCT?
$RETT ;NO,,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: MOVE S1,STREAM ;GET THIS STREAM NUMBER
$WTO (System Accounting Failure,<^R/.EQJBB(J)/>,@JOBOBA(S1))
$RETT ;RETURN
;ACCOUNT PARAMETER BLOCK DEFINED ON THE NEXT PAGE
SEARCH ACTSYM ;SEARCH THE ACCOUNTING UNV
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/LPTSPL/>,US%IMM) ;PROGRAM NAME
USPVR. (%LPT,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. (J$ADRD(J)) ;DISK READS
USSDW. (0,US%IMM) ;DISK WRITES
USJNM. (.EQJOB(J)) ;JOB NAME
USQNM. (<SIXBIT /LPT/>,US%IMM) ;QUEUE NAME
USSDV. (J$LDEV(J)) ;DEVICE NAME
USSSN. (J$ASEQ(J)) ;JOB SEQUENCE NUMBER
USSUN. (J$APRT(J)) ;TOTAL PAGES PRINTED
USSNF. (J$AFXC(J)) ;TOTAL FILES PROCESSED
USCRT. (.EQAFT(J)) ;CREATION DATE/TIME OF REQUEST
USSCD. (J$RTIM(J)) ;SCHEDULED DATE/TIME
USFRM. (J$FORM(J)) ;FORMS TYPE
USDSP. (<SIXBIT/NORMAL/>,US%IMM) ;DISPOSITION
USTXT. (<-1,,[ASCIZ / /]>) ;SYSTEM TEXT
USPRI. (J$APRI(J)) ;JOB PRIORITY
USNM2. (<POINT 7,.EQOWN(J) ;USER NAME>)
0 ;END OF LIST
> ;END TOPS20 CONDITIONAL
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: 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
MOVEI S1,7 ;LOAD PROBABLE (7 BIT) BYTE SIZE
LOAD T1,.FPINF(E),FP.FFF ;GET /FILE:
LOAD T2,.FPINF(E),FP.FPF ;GET /PRINT:
CAXN T1,.FPF8B ;WAS IT /FILE:8-BIT???
MOVEI S1,^D8 ;YES,,LOAD 8 BIT BYTE SIZE
CAXN T1,.FPF11 ;WAS IT /FILE:ELEVEN???
MOVEI S1,^D36 ;YES,,LOAD 36 BIT BYTE SIZE
CAIE T1,.FPFCO ;/FILE:COBOL?
CAIN T2,%FPLOC ;OR /PRINT:OCTAL?
MOVEI S1,^D36 ;YES, USE FULL WORDS
STORE S1,J$XFOB+FOB.CW(J),FB.BSZ ;AND SAVE THE BYTE SIZE
LOAD S1,.EQSEQ(J),EQ.PRV ;GET THE USERS PRIVILGE BITS
JUMPN S1,INPO.1 ;IF SET, AVOID ACCESS CHECK
LOAD S1,.FPINF(E),FP.SPL ;LIKEWISE IF SPOOLED
JUMPN S1,INPO.1 ; ...
TOPS10 <
MOVE S1,.EQOID(J) ;GET THE PPN
STORE S1,J$XFOB+FOB.US(J) ;AND SAVE IT
> ;END TOPS10 CONDITIONAL
TOPS20 <
HRROI S1,.EQOWN(J) ;GET THE OWNERS NAME
STORE S1,J$XFOB+FOB.US(J) ;SAVE IT
HRROI S1,.EQCON(J) ;GET CONNECTED DIRECTORY
STORE S1,J$XFOB+FOB.CD(J) ;AND SAVE IT
> ;END TOPS20 CONDITIONAL
INPO.1: MOVEI S1,FOB.SZ ;GET 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) ;ELSE, SAVE THE IFN
TXO S,DSKOPN ;INDICATE THE FILE IS OPEN.
$RETT ;AND RETURN
INPO.2: $TEXT(LOGCHR,<^I/LPERR/Can't access file ^F/@J$DFDA(J)/, ^E/[-1]/>)
ZERO .FPINF(E),FP.DEL ;CLEAR THE 'DELETE FILE' BIT
TXZ S,DSKOPN ;INDICATE THE FILE IS NOT OPEN.
$RETF ;AND RETURN
SUBTTL INPBUF -- Read a buffer from the input file
INPBUF: MOVE S1,J$DIFN(J) ;GET THE IFN
PUSHJ P,F%IBUF ;GET A BUFFERFUL
JUMPF INPERR ;LOSE
MOVEM S1,J$DBCT(J) ;SAVE THE BYTE COUNT
MOVEM S2,J$DBPT(J) ;AND THE BYTE POINTER
AOS J$ADRD(J) ;ADD 1 TO BUFFER READ COUNT.
EXCH S1,J$FCBC(J) ;GET OLD BUFR BYTE CNT AND SAVE NEW
ADDM S1,J$FTBC(J) ;BUMP TOTAL BYTES PROCESSED
$RETT ;THEN RETURN.
SUBTTL INPBYT -- Read a byte from the input file
INPBYT: SOSGE J$DBCT(J) ;MAKE SURE THERE IS DATA IN THE BUFFER.
JRST INPB.1 ;IF NOT,,GET ANOTHER BUFFER.
ILDB C,J$DBPT(J) ;PICK UP A BYTE FROM THE BUFFER.
$RETT ;AND RETURN.
INPB.1: PUSHJ P,INPBUF ;READ THE NEXT BUFFER.
JUMPF .RETF ;NO MORE,,RETURN.
JRST INPBYT ;ELSE GET THE NEXT BYTE.
SUBTTL INPERR -- Handle an input failure
INPERR: CAXN S1,EREOF$ ;WAS IT EOF?
$RETF ;WAS JUST RETURN
$TEXT(LOGCHR,<^I/LPERR/Error reading input file - ^E/[-1]/>)
TXO S,SKPFIL ;SKIP THE REST OF THE FILE
$RETF ;AND RETURN
SUBTTL 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
SETOB S2,J$DBCT(J) ;CLEAR BYTE COUNT AND 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
SETOM J$DBCT(J) ;AND SET THE BYTE COUNT
SETZM J$RNPP(J) ;AND SET PAGE 0
MOVEI S1,J$FPAG(J) ;GET THE PAGE COUNTER TABLE ADDRESS
MOVEM S1,J$FBPT(J) ;AND SAVE IT.
SETZM J$FCBC(J) ;CLEAR CURRENT INPUT BUFFER BYTE COUNT
SETZM J$FTBC(J) ;CLEAR TOTAL INPUT BYTE COUNT
TXZ S,FBPTOV ;CLEAR PAGE TABLE OVERFLOW BIT
MOVX S1,PAGSIZ ;GET THE TABLE LENGTH.
MOVEI S2,J$FPAG(J) ;GET THE START ADDRESS.
PJRST .ZCHNK ;RETURN, ZEROING THE PAGE TABLE
SUBTTL FORMS -- Setup Forms for a job
FORMS: GETLIM S1,.EQLIM(J),FORM ;GET THE FORMS TYPE
CAMN S1,J$FORM(J) ;OR ARE FORMS EXACTLY THE SAME?
$RETT ;YES,,VFU AND RAM MUST BE SAME TO !!!
MOVE S2,[POINT 7,J$WTOR(J)] ;GET POINTER TO WTOR BUFFER.
MOVEM S2,TEXTBP ;AND SAVE IT FOR DEPBP.
SKIPN S2,J$FORM(J) ;GET FORMS TYPE
MOVX S2,FRMNOR ;USE NORMAL IF NULL
XOR S1,S2 ;GET COMMON PART
AND S1,[EXP FRMSK1] ;AND IT WITH THE IMPORTANT PART
GETLIM S2,.EQLIM(J),FORM ;GET FORMS TYPE
EXCH S2,J$FORM(J) ;SAVE IT
MOVEM S2,J$FPFM(J) ;SAVE OLD ONES
SKIPE S1 ;NO NEED TO CHANGE FORMS.
$TEXT (DEPBP,<Please load forms type '^W/J$FORM(J)/'>)
FORM.1: MOVE S1,J$FDRU(J) ;GET THE CURRENT DRUM TYPE
MOVEM S1,J$PDRU(J) ;AND SAVE IT
MOVE S1,J$FRIB(J) ;GET THE CURRENT RIBBON TYPE
MOVEM S1,J$PRIB(J) ;AND SAVE IT
MOVE S1,J$FTAP(J) ;GET THE CURRENT CARRIAGE CONTROL TAPE
MOVEM S1,J$PTAP(J) ;AND SAVE IT
MOVE S1,J$LRAM(J) ;GET THE DEFAULT RAM FILE NAME
MOVEM S1,J$FRAM(J) ;AND MAKE IT THE CURRENT RAM TYPE
HRLZI S1,-F$NSW ;GET NEGATIVE SWITCH TABLE LEN
MOVEI T1,J$FCUR(J) ;POINT TO CURRENT FORMS PARAMS
FORM.2: MOVE S2,FFDEFS(S1) ;GET A DEFAULT
CAME S2,[-1] ;IS THIS SUPPOSED TO BE DEFAULTED ???
MOVEM S2,(T1) ;YES,,SAVE IT
ADDI T1,1 ;INCREMENT NEW PARAM STORE CTR
AOBJN S1,FORM.2 ;AND LOOP
MOVEI T1,3 ;START AT THREE
MOVEM T1,J$FWCL(J) ;STORE IT
MOVE T1,J$FWID(J) ;GET THE WIDTH
CAIG T1,F$CL2 ;LE CLASS 2 LIMIT?
SOS J$FWCL(J) ;YES, SOS ONCE
CAIG T1,F$CL1 ;LE CLASS 1 LIMIT
SOS J$FWCL(J) ;YES, SOS AGAIN
GETLIM T1,.EQLIM(J),FORM ;FORMS NAME
MOVEM T1,J$FALI(J) ;SAVE IT AS DEFAULT ALIGN FILE NAME
FORM.3: PUSHJ P,FRMINI ;READ THE LPFORM.INI FILE.
SKIPE J$MTAP(J) ;ARE WE SPOOLING TO TAPE ???
$RETT ;YES,,JUST RETURN NOW !!
MOVE S1,TEXTBP ;GET THE WTOR BYTE POINTER.
CAMN S1,[POINT 7,J$WTOR(J)] ;IS THERE A MESSAGE FOR THE OPERATOR ??
JRST FORM.5 ;NO,,TRY LOADING VFU AND RAM
$TEXT (DEPBP,<^T/ENDRSP/^0>) ;ADD THE RESPONSE TO THE END
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
FORM.4: MOVE S1,STREAM ;GET STREAM NUMBER
$WTOR (,<^T/J$WTOR(J)/>,@JOBOBA(S1),JOBWAC(S1)) ;SEND THE WTOR.
SETOM JOBCHK(S1) ;SAY WE WANT TO TAKE A CHECKPOINT.
$DSCHD (PSF%OR) ;WAIT FOR OPERATOR RESPONSE.
TXNE S,ABORT+RQB ;HAVE WE BEEN CANCELED OR REQUEUED ???
$RETF ;YES,,RETURN NOW
MOVEI S1,CONANS ;POINT TO THE CONTINUE ANSWER BLOCK
HRROI S2,J$RESP(J) ;POINT TO THE ANSWER
PUSHJ P,S%TBLK ;DO WE MATCH ???
TXNE S2,TL%NOM+TL%AMB ;DID WE FIND IT OK ???
JRST FORM.4 ;NO,,STUPID OPERATOR SO TRY AGAIN
FORM.5: PUSHJ P,LODRAM ;TRY TO LOAD THE RAM
TXNE S,ABORT+RQB ;HAVE WE BEEN CANCELED ???
$RETF ;YES,,RETURN NOW
PUSHJ P,LODVFU ;TRY TO LOAD THE VFU
TXNE S,ABORT+RQB ;HAVE WE BEEN CANCELED ???
$RETF ;YES,,RETURN NOW
$RETT ;NO,,HE WINS SO FAR !!!
ENDRSP: ASCIZ /Type 'Respond <number> CONTINUE' When Ready/
FRMINI: SKIPN FMOPN ;IS LPFORM OPEN?
POPJ P, ;NO, JUST RETURN
MOVE S1,FMIFN ;YES, GET THE IFN
PUSHJ P,F%REW ;REWIND IT
SETZM FMBYT ;SET FILE BYTE COUNT TO 0
FRMIN1: PUSHJ P,FH$SIX ;GET THE FORMS NAME
JUMPF .RETT ;EOF!!
GETLIM T2,.EQLIM(J),FORM ;GET FORMS
CAMN T1,T2 ;MATCH??
JRST FRMIN2 ;YES!!
FRMI1A: PUSHJ P,FH$EOL ;NO, FIND NEXT LINE
JUMPF .RETT ;EOF!!
JRST FRMIN1 ;AND LOOP
FRMIN2: CAIN C,"/" ;BEGINNING OF SWITCH?
JRST FRMIN5 ;YES, LOCATOR IS "ALL"
CAIN C,":" ;BEGINNING OF LOCATOR?
JRST FRMIN3 ;YES, GO GET IT
CAIN C,.CHLFD ;EOL?
JRST FRMIN1 ;YES, GO THE NEXT LINE
PUSHJ P,FH$CHR ;ELSE, GET A CHARACTER
JUMPF .RETT ;EOF
JRST FRMIN2 ;AND LOOP
FRMIN3: PUSHJ P,FH$SIX ;GET A LOCATOR
JUMPF .RETT ;EOF!!
JUMPE T1,FRMI3A ;MAYBE PAREN??
JRST FRMIN4 ;AE S2,TL%NOM+TL%
FRMI3A: CAIN C,"/" ;A SWITCH?
JRST FRMIN5 ;YES!
CAIE C,"(" ;A LIST?
JRST FRMIN9 ;NO, ERROR
FRMIN4: HLRZ T2,T1 ;GET THE FIRST THREE CHARS
CAIN T2,'ALL' ;IS IT "ALL"?
JRST FRMIN5 ;YES, STOP CHECKING
CAIN T2,'LOC' ;IS IT LOCAL?
SKIPGE J$LREM(J) ;YES, ARE WE?
SKIPA ;NO, NO
JRST FRMIN5 ;YES, YES!
CAIN T2,'REM' ;DOES IT SAY "REMOTE"?
SKIPL J$LREM(J) ;YES, ARE WE REMOTE
SKIPA ;NO!!!
JRST FRMIN5 ;YES!!
CAIE T2,'LPT' ;IS IT "LPT"
JRST FRMI4B ;NO, TRY ONE LAST THING
CAMN T1,J$LDEV(J) ;COMPARE TO OUR DEVNAM
JRST FRMIN5 ;MATCH!!
FRMI4B: CAIN C,.CHLFD ;BREAK ON EOL?
JRST FRMIN1 ;YES, GET NEXT LINE
CAIE C,"/" ;IS IT A SLASH?
CAIN C,")" ;NO, CLOSE PAREN?
JRST FRMI1A ;YES, GET THE NEXT LINE
PUSHJ P,FH$SIX ;ELSE, GET THE NEXT LOCATOR
JUMPF .RETT ;EOF, RETURN
JUMPE T1,FRMIN9 ;BAD FORMAT
JRST FRMIN4 ;AND LOOP AROUND
;GET HERE IF THIS LINE IS FOR US
FRMIN5: CAIN C,.CHLFD ;WAS THE LAST CHARACTER A LINEFEED?
POPJ P, ;YES, RETURN
CAIN C,"/" ;ARE WE AT THE BEGINNING OF A SWITCH?
JRST FRMI5A ;YES, DO IT!
PUSHJ P,FH$CHR ;NO, GET A CHARACTER
JUMPF .RETT ;EOF!!
JRST FRMIN5 ;AND LOOP AROUND
FRMI5A: PUSHJ P,FH$SIX ;GET THE SWITCH
JUMPF .RETT ;EOF!!
JUMPN T1,FRMIN6 ;JUMP IF WE'VE GOT SOMETHING
CAIN C,.CHLFD ;EOL?
POPJ P, ;YES, RETURN
JRST FRMIN5 ;ELSE, KEEP TRYING
FRMIN6: MOVE T4,T1 ;SAVE SWITCH NAME FOR LATTER
HLLZS T1 ;GET FIRST THREE CHARACTERS OF SWITCH
MOVSI T2,-F$NSW ;MAKE AOBJN POINTER
FRMIN7: HLLZ T3,FFNAMS(T2) ;GET A SWITCH NAME
CAMN T3,T1 ;MATCH??
JRST FRMIN8 ;YES, DISPATCH
AOBJN T2,FRMIN7 ;NO, LOOP
MOVE T4,T1 ;GET SWITCH NAME
MOVE S1,STREAM ;GET THE STREAM NUMBER.
$WTOJ (LPFORM.INI Error,<Unrecognized switch ^W/T1/ found.>,@JOBOBA(S1))
JRST FRMIN5 ;AND LOOP
FRMIN8: HRRZ T3,FFNAMS(T2) ;GET DISPATCH ADDRESS
PUSHJ P,(T3) ;GO!!
JRST FRMIN5 ;AND LOOP
FRMIN9: MOVE S1,STREAM ;GET THE STREAM NUMBER.
$WTOJ (Bad format in LPFORM.INI,,@JOBOBA(S1))
POPJ P, ;AND RETURN
SUBTTL Forms Switch Subroutines
S$BANN: PUSHJ P,FH$DEC ;GET DECIMAL ARGUMENT
MOVEM T1,J$FBAN(J) ;STORE IT
POPJ P, ;AND RETURN
S$TRAI: PUSHJ P,FH$DEC ;GET DECIMAL ARGUMENT
MOVEM T1,J$FTRA(J) ;STORE IT
POPJ P, ;AND RETURN
S$HEAD: PUSHJ P,FH$DEC ;GET A DECIMAL ARGUMENT
MOVEM T1,J$FHEA(J) ;STORE IT
POPJ P, ;AND RETURN
S$LINE: PUSHJ P,FH$DEC ;GET DECIMAL ARGMENT
MOVEM T1,J$FLIN(J) ;STORE IT
POPJ P, ;AND RETURN
S$WIDT: PUSHJ P,FH$DEC ;GET DECIMAL ARGUMENT
MOVEM T1,J$FWID(J) ;SAVE IT
MOVEI T2,3 ;ASSUME WIDTH CLASS 3
MOVEM T2,J$FWCL(J) ;SAVE WIDTH CLASS
CAIG T1,F$CL2 ;LE CLASS 2 LIMIT?
SOS J$FWCL(J) ;YES, DECREMENT
CAIG T1,F$CL1 ;LE CLASS 1 LIMIT
SOS J$FWCL(J) ;YES, DECREMENT AGAIN!
POPJ P, ;AND RETURN
S$RIBB: PUSHJ P,FH$SIX ;GET SIXBIT ARGUMENT
JUMPF .RETT ;EOF
MOVEM T1,J$FRIB(J) ;SAVE IT
CAME T1,J$PRIB(J) ;SKIP IF NOT CHANGED
$TEXT (DEPBP,<Load Ribbon type '^W/J$FRIB(J)/'>)
POPJ P, ;AND RETURN
S$DRUM:
S$CHAI: PUSHJ P,FH$SIX ;GET SIXBIT ARG
JUMPF .RETT ;EOF!!
MOVEM T1,J$FDRU(J) ;SAVE IT
CAME T1,J$PDRU(J) ;SKIP IF NOT CHANGED
$TEXT (DEPBP,<Load DRUM (CHAIN) type '^W/J$FDRU(J)/'>)
POPJ P, ;AND RETURN
S$NOTE: MOVE T1,[POINT 7,J$FNBK(J)]
SETZ T2, ;CLEAR THE COUNTER
S$NOT1: PUSHJ P,FH$CHR ;GET A CHARACTER
JUMPF S$NOT2 ;EOF, FINISH UP!!
CAIGE C,40 ;MAKE SURE ITS GREATER THAN SPACE
JRST S$NOT2 ;ITS NOT!, FINISH UP
CAIN C,"/" ;ALSO STOP ON SLASH
JRST S$NOT2 ;IT IS!!
IDPB C,T1 ;DEPOSIT IT
CAIGE T2,^D49 ;LOOP FOR 50 CHARACTERS
AOJA T2,S$NOT1 ;INCR AND LOOP
S$NOT2: $TEXT (DEPBP,<Note: ^T/J$FNBK(J)/>) ;ADD THE MSG TO WTOR.
$RETT ;RETURN.
S$ALCN: PUSHJ P,FH$DEC ;GET DECIMAL ARG
MOVEM T1,J$FALC(J) ;STORE IT
POPJ P, ;RETURN
S$ALSL: PUSHJ P,FH$DEC ;GET DECIMAL ARG
MOVEM T1,J$FALS(J) ;SAVE IT
POPJ P, ;AND RETURN
S$ALIG: CAIN C,"/" ;ARE WE AT THE BEGINNING OF A SWITCH ??
PJRST OALI.2 ;YES,,JUST USE FORMS NAME AS ALIGN FILE
PUSHJ P,FH$SIX ;GET THE ALIGN FILENAME ARGUMENT
SKIPE T1 ;SKIP IF NOTHING THERE
MOVEM T1,J$FALI(J) ;SAVE THE ALIGN FILENAME
PUSHJ P,OALI.2 ;SCHEDULE THE FORMS ALIGNMENT
POPJ P, ;AND RETURN
S$VFU:
S$TAPE: PUSHJ P,FH$SIX ;GET SIXBIT ARGUMENT
JUMPF .RETT ;EOF
MOVEM T1,J$FTAP(J) ;SAVE IT
CAME T1,J$PTAP(J) ;ARE OLD AND NEW THE SAME?
SKIPE J$LDVF(J) ;OR DOES DEVICE HAVE A DAVFU?
$RETT ;OLD=NEW OR SOFTWARE VFU,,RETURN
$TEXT (DEPBP,<Load CARRIAGE CONTROL TAPE '^W/J$FTAP(J)/'>)
$RETT
S$RAM: PUSHJ P,FH$SIX ;GET THE SIXBIT ARGUMENT
JUMPF .RETT ;EOF
MOVEM T1,J$FRAM(J) ;SAVE IT
$RETT ;AND RETURN
SUBTTL LODVFU -- Load the Vertical Forms Unit
LODVFU: SKIPN J$MTAP(J) ;ARE WE SPOOLING TO TAPE ???
SKIPN J$LDVF(J) ;OR DOES THIS PRINTER HAVE A VFU ???
$RETT ;TO TAPE OR NO VFU,,JUST RETURN.
MOVE S1,J$FTAP(J) ;GET NECESSARY VFU TYPE
CAMN S1,J$FLVT(J) ;IS IT IN THERE ALREADY?
$RETT ;YES, RETURN
MOVE S1,STREAM ;GET STREAM NUMBER
$WTO (Loading VFU with '^W/J$FTAP(J)/',,@JOBOBA(S1))
TOPS20 <
$TEXT(<-1,,J$XTBF(J)>,<SYS:^W/J$FTAP(J)/.VFU^0>)
LODV.2: MOVX S1,GJ%OLD+GJ%SHT ;SHORT, OLD FILE ONLY
HRROI S2,J$XTBF(J) ;POINT TO STRING
GTJFN ;GO GET THE JFN FOR THE FILE
ERJMP NOVFU ;ERROR,,LETS TRY SOMETHING ELSE
LODV.3: MOVE T3,S1 ;COPY THE JFN OVER
MOVE S1,J$LCHN(J) ;GET THE LPT JFN
MOVX S2,.MOLVF ;GET LOAD VFU FUNCTION
MOVEI T1,T2 ;ADDRESS OF ARG BLOCK
MOVEI T2,2 ;LENGTH OF ARG BLOCK
PUSHJ P,$MTOPR ;LOAD THE VFU
MOVE S1,T3 ;GET THE VFU JFN ONCE MORE
RLJFN ;RELEASE IT
JFCL ;IGNORE ANY ERRORS
JUMPF LODV.4 ;CANT LOAD VFU,,GO FIND OUT WHY.
MOVE T1,J$FTAP(J) ;GET THE VFU TYPE
MOVEM T1,J$FLVT(J) ;SAVE AS CURRENTLY LOADED
POPJ P, ;AND RETURN
LODV.4: MOVX S1,.FHSLF ;GET MY HANDLE
GETER ;GET THE LAST ERROR CODE
HRRZS S2,S2 ;GET JUST THE ERROR CODE
CAXE S2,MTOX17 ;IS THE ERROR 'DEVICE OFFLINE' ???
JRST NOVF.1 ;NO,,LETS TRY SOME OTHER
PUSHJ P,OUTWON ;SAY 'DEVICE OFFLINE'
JRST LODV.2 ;AND TRY AGAIN
> ;END TOPS20 CONDITIONAL
SUBTTL TOPS10 VFU LOADING ROUTINES
TOPS10 <
PUSHJ P,OUTFLS ;FLUSH THE OUTPUT BUFFERS
JUMPF SHUTIN ;CANT,,SHUT IT DOWN
TXO S,VFULOD ;FLAG THE FACT WE'RE LOADING THE VFU
;ON SYSTEM STARTUP, SEE IF THE VFU IS VALID AND IF SO THROW OUT A
;FORM FEED. IF NOT, ASK OPR TO ALIGN FORMS BEFORE LOADING VFU.
SKIPE J$LVFF(J) ;IS THIS THE FIRST TIME THROUGH ???
JRST LODV.0 ;NO,,SKIP THIS
SETOM J$LVFF(J) ;RESET THE FIRST TIME THROUGH FLAG
MOVE T1,[2,,T2] ;GET THE DEVOP. PARAMETERS
MOVX T2,.DFRDS ;GET 'READ DEVICE STATUS' FUNCTION CODE
MOVE T3,J$LDEV(J) ;GET THE SIXBIT DEVICE NAME
DEVOP. T1, ;GET THE DEVICE STATUS
$STOP (LDF,Line Printer Device Status DEVOP. Failed) ;SHOULD'NT HAPPEN
TXNE T1,DF.LVE ;DOES THE LPT HAVE A GOOD VFU ???
JRST LOD.0A ;NO,,DONT OUTPUT FORM FEED
MOVX C,.CHFFD ;GET FORM FEED CODE
PUSHJ P,DEVOUT ;PUT IT OUT
PUSHJ P,OUTDMP ;ALIGN THE FORMS ON THE PRINTER
JRST LODV.0 ;AND GO RELOAD THE VFU
LOD.0A: MOVE S1,STREAM ;GET OUR STREAM NUMBER
$WTOR(<Align Forms and Put Online>,<^T/ENDRSP/>,@JOBOBA(S1),JOBWAC(S1))
SETOM JOBCHK(S1) ;TAKE A CHECKPOINT WHEN WE CAN
$DSCHD (PSF%OR) ;WAIT FOR THE OPERATOR RESPONSE
TXNE S,ABORT+RQB ;ARE WE STILL IN BUSINESS ???
JRST [SETZM J$FORM(J) ;NO,,ZAP THE LOADED FORMS TYPE
TXZ S,VFULOD ;CLEAR THE VFU LOAD FLAG
$RETT ] ;AND RETURN
MOVEI S1,CONANS ;GET THE ANSWER BLOCK ADDRESS
HRROI S2,J$RESP(J) ;POINT TO THE OPERATORS RESPONSE
$CALL S%TBLK ;CHECK ONE AGAINST THE OTHER
TXNE S2,TL%NOM+TL%AMB ;DO THEY MATCH ???
JRST LOD.0A ;NO,,STUPID OPERATOR - TRY AGAIN !!
LODV.0: LOAD S1,J$LCLS(J) ;GET THE PRINTER CONTROLLER CLASS
CAXN S1,.DFS20 ;FRONT END LPT ???
JRST LODV.4 ;YES,,DO THINGS A LITTLE DIFFERENTLY
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
MOVE S1,J$FTAP(J) ;GET FILENAME
STORE S1,VFUFD+.FDNAM ;AND STORE IN THE FD
MOVEI S1,FOB.SZ ;GET THE FOB SIZE
MOVEI S2,FOB ;AND FOB ADDRESS
PUSHJ P,.ZCHNK ;AND ZERO IT
MOVEI S1,VFUFD ;GET FD ADDRESS
STORE S1,FOB+FOB.FD ;STORE
MOVEI S1,7 ;GET 7 BIT BYTE SIZE
STORE S1,FOB+FOB.CW,FB.BSZ ;AND STORE
MOVEI S1,FOB.SZ ;GET FOB SIZE
MOVEI S2,FOB ;AND FOB ADDRESS
PUSHJ P,F%IOPN ;SETUP TO READ IT
JUMPF NOVFU ;FILE NOT THERE,,HE LOSES !!!
MOVEM S1,J$FVIF(J) ;ELSE,,SAVE THE IFN
MOVE T1,[2,,T2] ;ARGS FOR DEVOP
MOVX T2,.DFENV ;ENABLE VFU LOAD
MOVE T3,J$LDEV(J) ;FOR I/O DEVICE
DEVOP. T1, ;DO IT
JRST NODAVF ;ASSUME NO DAVFU
LODV.1: SOSGE J$FBYT(J) ;CHECK AND SEE IF DATA IS IN BUFFER.
JRST LODV.3 ;IF NOT,,GET NEXT BUFFER.
ILDB C,J$FPTR(J) ;PICK UP A BYTE.
PUSHJ P,DEVOUT ;WRITE IT OUT.
JRST LODV.1 ;GO GET ANOTHER.
LODV.2: PUSHJ P,OUTDMP ;FORCE OUT THE BUFFERS
MOVE T1,[2,,T2] ;LOAD ARG POINTER
MOVX T2,.DFDVL ;DISABLE VFU LOAD
MOVE T3,J$LCHN(J) ;AND CHANNEL NUMBER
DEVOP. T1, ;DO IT!
JRST NODAVF ;LOSE
MOVE S1,J$FVIF(J) ;GET THE IFN
PUSHJ P,F%REL ;RELEASE IT
MOVE T1,J$FTAP(J) ;GET TAPE NAME
MOVEM T1,J$FLVT(J) ;SAVE AS TYPE LOADED
TXZ S,VFULOD ;CLEAR THE VFU LOAD FLAG
PUSHJ P,OUTFLS ;FLUSH THE OUTPUT BUFFERS
JUMPF SHUTIN ;CANT,,SHUT IT DOWN
$RETT ;OK,,JUST RETURN
LODV.3: MOVE S1,J$FVIF(J) ;GET VFU IFN.
PUSHJ P,F%IBUF ;GET ANOTHER BUFFER.
JUMPF LODV.2 ;IF NO MORE,,RETURN
MOVEM S1,J$FBYT(J) ;SAVE THE BYTE COUNT
MOVEM S2,J$FPTR(J) ;SAVE THE BYTE POINTER.
JRST LODV.1 ;CONTINUE PROCESSING.
VFUFD: $BUILD FDMSIZ
$SET(.FDLEN,FD.LEN,VFUFDL) ;FD LENGTH
$SET(.FDEXT,,<SIXBIT/VFU/>) ;FILENAME EXTENSION
$SET(.FDSTR,,<SIXBIT/SYS/>) ;FILE STRUCTURE
$EOB
VFUFDL==.-VFUFD ;FD LENGTH
;FOR FRONT END LINE PRINTERS, WE MUST DO THINGS A LITTLE DIFFERENTLY !!
LODV.4: OPEN 17,VFUFOB ;OPEN THE STRUCTURE
JRST NOVFU ;CANT,,TRY SOMETHING ELSE
MOVE S1,J$FTAP(J) ;GET THE VFU WE WANT
MOVEM S1,VLKUP+0 ;SAVE IN THE LOOKUP BLOCK
MOVSI S1,'VFU' ;GET THE EXTENSION
MOVEM S1,VLKUP+1 ;SAVE IN THE LOOKUP BLOCK
SETZM VLKUP+2 ;CLEAR 3'RD WORD OF LOOKUP BLOCK
SETZM VLKUP+3 ;CLEAR 4'TH WORD OF LOOKUP BLOCK
LOOKUP 17,VLKUP ;FIND THE FILE WE WANT
JRST VDON.2 ;NOT THERE,,TRY SOMETHING ELSE
PUSHJ P,M%GPAG ;GET A PAGE FOR A BUFFER
MOVE T4,S1 ;SAVE THE ADDRESS FOR LATER
MOVEI T1,-1(S1) ;GET BUFFER ADDRESS-1
HLL T1,VLKUP+3 ;GET -FILE LENGTH,,BUFFER ADDR-1
SETZM T2 ;END CCW
IN 17,T1 ;READ THE VFU FILE
SKIPA ;CONTINUE ON SUCCESSFUL RETURN
JRST VDON.1 ;AN ERROR,,TRY SOMETHING ELSE
HLRO T3,VLKUP+3 ;GET -FILE LENGTH
MOVMS T3 ;WANT POSITIVE LENGTH
IMULI T3,5 ;CALC NUMBER OF VFU BYTES
MOVEI T1,.DFLV2 ;WANT LOAD VFU FUNCTION
MOVE T2,J$LCHN(J) ;WANT LPT CHANNEL NUMBER
MOVE S1,[4,,T1] ;GET ARG COUNT,,BLOCK ADDRESS
SETZM S2 ;FLAG S2 (IF 0 THEN VFU LOADED OK)
DEVOP. S1, ;LOAD THE VFU
VDON.1: SETOM S2 ;FLAG THAT VFU LOAD FAILED
MOVE T1,S2 ;SAVE THE VFU LOAD FLAG
MOVE S1,T4 ;GET THE BUFFER ADDRESS BACK
PUSHJ P,M%RPAG ;RELEASE THE PAGE
VDON.2: MOVEI S1,17 ;GET THE CHANNEL NUMBER
RESDV. S1, ;WIPE IT OUT
JFCL ;IGNORE ANY ERROR RELEASING THE DEVICE
JUMPN T1,NOVF.1 ;LOAD FAILED,,TRY SOMETHING ELSE
MOVE S1,J$FTAP(J) ;GET THE VFU TYPE WE JUST LOADED
MOVEM S1,J$FLVT(J) ;SAVE IT AS LOADED VFU TYPE
TXZ S,VFULOD ;CLEAR THE VFU LOAD FLAG
PUSHJ P,OUTFLS ;FLUSH THE OUTPUT BUFFERS
JUMPF SHUTIN ;CANT,,SHUT IT DOWN
$RETT ;OK,,RETURN
VFUFOB: .IODMP ;DUMP MODE I/O
SIXBIT/SYS/ ;FILE ON SYS:
0,,0 ;DUMP MODE (NO BUFFERS)
VLKUP: BLOCK 4 ;LOOKUP BLOCK
> ;END TOPS10 CONDITIONAL
SUBTTL HERE IF VFU FILE THAT WE ARE LOOKING FOR IS NOT AROUND
NOVFU: MOVE T1,J$FTAP(J) ;TYPE WE TRIED TO LOAD
CAME T1,D$TAPE ;IS IT THE DEFAULT
JRST NOVF.1 ;NO, GIVE UP
TOPS10 <
MOVE T1,[2,,T2] ;ARGS FOR DEVOP
MOVEI T2,.DFLLV ;LOAD HARDWARE VFU
MOVE T3,J$LCHN(J) ;FOR CHANNEL
DEVOP. T1, ;DO IT
JRST NOVF.1 ;LOSE
MOVE T1,D$TAPE ;GET NAME OF NORMAL
MOVEM T1,J$FLVT(J) ;STORE IT
MOVE S1,STREAM ;GET STREAM NUMBER
$WTO (Error loading VFU,Loaded hardware VFU instead.,@JOBOBA(S1))
TXZ S,VFULOD ;CLEAR THE VFU LOAD FLAG
$RETT ;AND RETURN
;HERE WHEN DEVOP FAILS...CLEAR DAVFU FLAG AND RETURN
NODAVF: SETZM J$LDVF(J) ;CLEAR THE FLAG
MOVE S1,J$FTAP(J) ;GET THE FORMS TYPE.
MOVEM S1,J$FLVT(J) ; AND SAVE THEM AS LAST USED.
POPJ P, ;AND RETURN
> ;END TOPS10 CONDITIONAL
NOVF.1: MOVE S1,STREAM ;GET STREAM NUMBER
$WTOR (,<^I/VFUI1/^J^M^T/VFUI2/>,@JOBOBA(S1),JOBWAC(S1))
SETOM JOBCHK(S1) ;SAY WE WANT TO TAKE A CHECKPOINT.
$DSCHD (PSF%OR) ;WAIT FOR THE REPLY.
TXNE S,ABORT+RQB ;HAVE WE BEEN CANCELED OR REQUEUED ??
JRST [SETZM J$FORM(J) ;YES,,ZAP THE LOADED FORMS TYPE
TXZ S,VFULOD ;CLEAR THE VFU LOAD FLAG
$RETT ] ;AND RETURN
HRROI S1,J$RESP(J) ;GET THE OPERATORS RESPONSE
PUSHJ P,S%SIXB ;CONVERT IT TO SIXBIT
MOVEM S2,J$FTAP(J) ;SAVE THE FORMS TYPE
JRST LODVFU ;TRY LOADING AGAIN.
VFUI1: ITEXT (<VFU Error, can't load VFU '^W/J$FTAP(J)/'>)
VFUI2: ASCIZ /Respond with VFU type to continue/
SUBTTL LODRAM - ROUTINE TO LOAD THE TRANSLATION RAM
LODRAM: SKIPN J$MTAP(J) ;ARE WE SPOOLING TO TAPE ???
SKIPE J$LREM(J) ;OR IS THIS A REMOTE LPT ???
$RETT ;YES,,RETURN NOW !!!
MOVE S1,J$FRAM(J) ;GET THE RAM WE WANT
CAMN S1,J$FLRM(J) ;IS IT IN THERE ALREADY ???
$RETT ;YES,,RETURN NOW !!!
TOPS20 <
MOVE S1,STREAM ;GET OUR STREAM NUMBER
$WTO (Loading RAM with '^W/J$FRAM(J)/',,@JOBOBA(S1))
$TEXT (<-1,,J$XTBF(J)>,<SYS:^W/J$FRAM(J)/.RAM^0>) ;GEN RAM FILE NAME
LODR.1: MOVX S1,GJ%OLD+GJ%SHT ;SHORT, OLD FILE ONLY
HRROI S2,J$XTBF(J) ;POINT TO FILE NAME
GTJFN ;GET A JFN FOR THE TRANSLATION RAM
ERJMP NORAM ;CANT GET A JFN,,TRY SOMETHING ELSE
LODR.2: MOVE T3,S1 ;SAVE THE JFN
MOVE S1,J$LCHN(J) ;GET THE PRINTER JFN
MOVX S2,.MOLTR ;WANT 'LOAD RAM' MTOPR FUNCTION
MOVEI T1,T2 ;GET ARG BLOCK ADDRESS
MOVEI T2,2 ;GET ARG BLOCK LENGTH
PUSHJ P,$MTOPR ;GO DO THE MTOPR
MOVE S1,T3 ;GET THE JFN BACK
RLJFN ;RELEASE IT
JFCL ;IGNORE ANY ERRORS
JUMPF LODR.3 ;COULD NOT LOAD RAM,,FIND OUT WHY
MOVE S1,J$FRAM(J) ;GET THE RAM TYPE WE LOADED
MOVEM S1,J$FLRM(J) ;SAVE IT
$RETT ;AND RETURN
LODR.3: MOVX S1,.FHSLF ;GET MY HANDLE
GETER ;GET THE LAST ERROR
HRRZS S2,S2 ;GET JUST THE ERROR CODE
CAXE S2,MTOX17 ;IS THE ERROR 'LPT OFFLINE' ???
JRST NORAM ;NO,,LETS TRY SOME OTHER
PUSHJ P,OUTWON ;WAIT FOR THE LPT TO COME ONLINE
JRST LODR.1 ;AND TRY AGAIN
> ;END TOPS20 CONDITIONAL
TOPS10 <
MOVE S1,J$LCLS(J) ;GET THE CONTROLLER CLASS
CAIE S1,.DFS20 ;IS THIS A CONSOLE FRONT END LPT ???
$RETT ;NO,,THEN WE DONT LOAD THE RAM
MOVE S1,STREAM ;GET OUR STREAM NUMBER
$WTO (Loading RAM with '^W/J$FRAM(J)/',,@JOBOBA(S1))
OPEN 17,RAMFOB ;OPEN THE STRUCTURE
JRST NORAM ;CANT,,TRY SOMETHING ELSE
MOVE S1,J$FRAM(J) ;GET THE RAM WE WANT
MOVEM S1,RLKUP+0 ;SAVE IN THE LOOKUP BLOCK
MOVSI S1,'RAM' ;GET THE EXTENSION
MOVEM S1,RLKUP+1 ;SAVE IN THE LOOKUP BLOCK
SETZM RLKUP+2 ;CLEAR 3'RD WORD OF LOOKUP BLOCK
SETZM RLKUP+3 ;CLEAR 4'TH WORD OF LOOKUP BLOCK
LOOKUP 17,RLKUP ;FIND THE FILE WE WANT
JRST RDON.2 ;NOT THERE,,TRY SOMETHING ELSE
PUSHJ P,M%GPAG ;GET A PAGE FOR A BUFFER
MOVE T4,S1 ;SAVE THE ADDRESS FOR LATER
MOVEI T1,-1(S1) ;GET BUFFER ADDRESS-1
HLL T1,RLKUP+3 ;GET -FILE LENGTH,,BUFFER ADDR-1
SETZM T2 ;END CCW
IN 17,T1 ;READ THE RAM FILE
SKIPA ;CONTINUE ON SUCCESSFUL RETURN
JRST RDON.1 ;AN ERROR,,TRY SOMETHING ELSE
HLRO T3,RLKUP+3 ;GET -FILE LENGTH
MOVMS T3 ;WANT POSITIVE LENGTH
LSH T3,2 ;CONVERT TO 8 BIT BYTE COUNT
MOVEI T1,.DFLR2 ;WANT LOAD RAM FUNCTION
MOVE T2,J$LCHN(J) ;WANT LPT CHANNEL NUMBER
MOVE S1,[4,,T1] ;GET ARG COUNT,,BLOCK ADDRESS
SETZM S2 ;FLAG S2 (IF 0 THEN RAM LOADED OK)
DEVOP. S1, ;LOAD THE RAM
RDON.1: SETOM S2 ;INDICATE RAM LOAD ERROR
MOVE T1,S2 ;SAVE THE RAM LOAD FLAG
MOVE S1,T4 ;GET THE BUFFER ADDRESS BACK
PUSHJ P,M%RPAG ;RELEASE THE PAGE
RDON.2: MOVEI S1,17 ;GET OUR CHANNEL NUMBER
RESDV. S1, ;WIPE IT OUT
JFCL ;IGNORE ANY ERROR RELEASING THE DEVICE
JUMPN T1,NORAM ;IF AN ERROR,,GO TRY SOMETHING ELSE
MOVE S1,J$FRAM(J) ;GET THE RAM TYPE WE JUST LOADED
MOVEM S1,J$FLRM(J) ;SAVE IT AS LOADED RAM TYPE
$RETT ;AND RETURN
RAMFOB: .IODMP ;DUMP MODE I/O
SIXBIT/SYS/ ;FILE ON SYS:
0,,0 ;DUMP MODE (NO BUFFERS)
RLKUP: BLOCK 4 ;LOOKUP BLOCK
> ;END TOPS10 CONDITIONAL
SUBTTL NORAM - ROUTINE TO PROCESS RAM LOADING ERRORS
NORAM: MOVE S1,STREAM ;GET OUR STREAM NUMBER
$WTOR (,<^I/RAMI1/^J^M^T/RAMI2/>,@JOBOBA(S1),JOBWAC(S1))
SETOM JOBCHK(S1) ;WE WANT A CHECKPOINT TAKEN
$DSCHD (PSF%OR) ;WAIT FOR THE OPERATOR RESPONSE
TXNE S,ABORT+RQB ;CANCELED OR REQUEUED ???
JRST [SETZM J$FORM(J) ;YES,,ZAP THE LOADED FORMS TYPE
$RETT ] ;AND RETURN
HRROI S1,J$RESP(J) ;GET THE RESPONSE ADDRESS
PUSHJ P,S%SIXB ;CONVERT IT TO SIXBIT
MOVEM S2,J$FRAM(J) ;SAVE THE NEW RAM TYPE
JRST LODRAM ;AND TRY AGAIN
RAMI1: ITEXT (<RAM Error, Can't Load RAM '^W/J$FRAM(J)/'>)
RAMI2: ASCIZ /Respond With RAM Type to Continue/
SUBTTL I/O Subroutines for LPFORM.INI
;ROUTINE TO RETURN A SIXBIT WORD IN T1
;RETURNS WITH WORD IN T1. SKIPS NORMALLY, NON-SKIP ON EOF.
FH$SIX: CLEAR T1, ;CLEAR FOR RESULT
MOVE T2,[POINT 6,T1] ;POINTER FOR RESULT
FH$SX1: PUSHJ P,FH$CHR ;GET A CHARACTER
JUMPF .RETF ;FAIL IF EOF
CAIL C,"A" ;CHECK FOR ALPHA
CAILE C,"Z"
SKIPA ;ITS NOT!!
JRST FH$SX2 ;IT IS, DEPOSIT IT
CAIL C,"0" ;CHECK FOR NUMBER
CAILE C,"9"
$RETT ;NO REASONALBE
FH$SX2: SUBI C,40 ;CONVERT TO SIXBIT
TLNE T2,770000 ;GET SIX YET?
IDPB C,T2 ;NO, DEPOSIT ANOTHER
JRST FH$SX1 ;AND LOOP AROUND
;ROUTINE TO RETURN 1 CHARACTER IN ACCUMULATOR C
FH$CHR: SOSGE FMBYT ;MAKE SURE THERE IS DATA IN BUFFER.
JRST FH$C.1 ;IF NOT,,GET ANOTHER BUFFER.
ILDB C,FMPTR ;PICK UP A BYTE
CAIE C,.CHTAB ;CONVERT TABS
CAIN C,.CHCRT ;AND CARRIAGE RETURNS
MOVEI C,40 ;INTO SPACES
CAIE C,.CHFFD ;CONVERT FORM FEEDS
CAIN C,.CHVTB ;AND VERTICAL TABS
MOVEI C,.CHLFD ;INTO LINEFEED
CAIL C,141 ;CHECK LOWER CASE
CAILE C,172 ;141-172
$RETT ;ITS NOT
SUBI C,40 ;YUP, CONVERT TO UPPER
$RETT ;AND SKIP BACK
FH$C.1: MOVE S1,FMIFN ;PICK UP THE IFN.
PUSHJ P,F%IBUF ;READ A BUFFER.
JUMPF .RETF ;IF AN ERROR,,RETURN.
MOVEM S1,FMBYT ;SAVE THE INPUT BYTE COUNT.
MOVEM S2,FMPTR ;SAVE THE INPUT BYTE POINTER.
JRST FH$CHR ;CONTINUE PROCESSING.
;ROUTINE TO SEARCH FOR EOL IN LPFORM.INI
FH$EOL: PUSHJ P,FH$CHR ;GET A CHARACTER
JUMPF .RETF ;FAIL IF EOF
CAIE C,.CHLFD ;EOL?
JRST FH$EOL ;NO, LOOP
$RETT ;YES, RETURN!
;ROUTINE TO PICK UP A DECIMAL NUMBER
FH$DEC: CLEAR T1, ;PLACE TO ACCUMULATE RESULT
FH$DE1: PUSHJ P,FH$CHR ;GET A CHARACTER
JUMPF .RETF ;EOF, RETURN
CAIL C,"0" ;CHECK THE RANGE
CAILE C,"9" ;0-9
POPJ P, ;RETURN
IMULI T1,12 ;SHIFT A PLACE
ADDI T1,-"0"(C) ;ADD IN A DIGIT
JRST FH$DE1 ;AND LOOP AROUND
SUBTTL OUTGET -- OPEN the output device
;THIS ROUTINE OPENS THE SPECIFIED OUTPUT DEVICE, AND SETS UP A BUFFER RING
TOPS10 <
OUTGET: PUSHJ P,GENDEV ;CREATE THE PHYSICAL DEVICE NAME.
MOVEM S1,J$LDEV(J) ;AND SAVE IT
MOVE S1,STREAM ;GET OUR STREAM NUMBER
MOVEM S1,J$LCHN(J) ;SAVE IT AS THE CHANNEL NUMBER
MOVX S2,PSF%DO+PSF%OB ;GET OFFLINE+OUTPUT BLOCKED BITS
ANDCAM S2,JOBSTW(S1) ;AND CLEAR THE SCHEDULING BITS
LSH S1,^D23 ;SHIFT CHANNEL # TO RIGHT PLACE
IOR S1,[OPEN T1] ;MAKE IT AN INSTRUCTION
MOVX T1,.IOASC+IO.SFF+UU.PHS+UU.AIO
;ASCII+SUPRESS FF+PHONLY+NBIO
MOVE T2,J$LDEV(J) ;OUTPUT DEVICE NAME
MOVSI T3,J$LBRH(J) ;BUFFER HEADER
XCT S1 ;AND EXECUTE IT
JRST OUTDNA ;LOSE GIVE ERROR
MOVE T1,[2,,T2] ;ARG POINTER
MOVX T2,.DFHCW ;HARDWARE CHARACTERISTICS WORD
MOVE T3,J$LCHN(J) ;GET CHANNEL NUMBER
DEVOP. T1, ;READ THE CHARS
JRST OUTDDE ;SHOULDN'T HAPPEN
TXNE T1,DF.LCP ;IS IT A LOWER-CASE PRINTER?
SETOM J$LLCL(J) ;YES, SET THE FLAG
MOVE S1,[SIXBIT/LP64/] ;DEFAULT RAM TO 64 CHARACTER
SKIPE J$LLCL(J) ;UNLESS ITS LOWER CASE
MOVE S1,[SIXBIT/LP96/] ;THEN DEFAULT TO 96 CHARACTER SET
MOVEM S1,J$LRAM(J) ;SAVE THE DEFAULT RAM FILE NAME
MOVE S1,D$TAPE ;GET THE DEFAULT VFU TYPE.
SKIPN J$FTAP(J) ;HAS THE VFU ALREADY BEEN DEFAULTED ???
MOVEM S1,J$FTAP(J) ;NO,,SAVE AS THE VFU DEFAULT.
LDB S1,[POINTR(T1,DF.CLS)] ;GET THE COBTROLLER TYPE
MOVEM S1,J$LCLS(J) ;SAVE IT FOR LATER
LDB T1,[POINTR(T1,DF.VFT)] ;GET VFU TYPE
CAIN T1,.DFVTD ;IS IT A DAVFU?
SETOM J$LDVF(J) ;YES, SET THE FLAG
SKIPGE J$LREM(J) ;SKIP IF LOCAL PRINTER
JRST OUTG.2 ;SETUP REGULAR BFRS FOR REMOTE
MOVE T1,J$LBUF(J) ;GET ADDRESS OF BUFFER PAGE
SUBI T1,BUFSIZ ;BACK UP ONE BUFFER
SETZ T2, ;CLEAR A COUNTER
OUTG.1: ADDI T1,BUFSIZ ;POINT TO NEXT BUFFER
MOVEI S1,BUFSIZ+1(T1) ;GET LINK TO NEXT BUFFER
HRLI S1,BUFSIZ-2 ;AND NUMBER DATAWORDS+1
MOVEM S1,1(T1) ;AND STORE IT AWAY IN BUFFER
CAIGE T2,BUFNUM-1 ;GOT THEM ALL?
AOJA T2,OUTG.1 ;NO, LOOP AROUND
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
MOVNI T2,BUFSIZ*BUFNUM ;LOAD -<COMPLETE BUFFER SIZE>
ADDM T2,1(T1) ;MAKE LAST BUFFER POINT TO FIRST
MOVE T1,J$LBUF(J) ;GET ADDRESS OF BUFFER PAGE BACK
ADDI T1,1 ;POINT TO WORD 1
TXO T1,BF.VBR ;MAKE IT A VIRGIN RING
MOVEM T1,J$LBRH(J) ;AND PUT IT WHERE MONITOR WILL FIND IT
JRST OUTSOK ;AND CONTINUE ON
OUTG.2: MOVE S1,J$LBUF(J) ;GET ADR OF BUFFER PAGE
EXCH S1,.JBFF ;SWAP IT WITH JOBFF
MOVE S2,J$LCHN(J) ;GET THE CHANNEL NUMBER
LSH S2,^D23 ;POSITION IT
IOR S2,[OUTBUF 2] ;MAKE AN INSTRUCTION
XCT S2 ;AND EXECUTE IT
MOVEM S1,.JBFF ;RESTORE JOBFF
JRST OUTSOK ;AND CONTINUE ON
GENDEV: SKIPE S1,J$MTAP(J) ;IS THERE A SPECIFIC DEVICE TO WRITE ON
$RETT ;YES,,RETURN WITH DEVICE IN S1
MOVE T1,STREAM ;PICK UP STREAM NUMBER.
MOVE T1,JOBOBA(T1) ;PICK UP OBJECT BLOCK ADDRESS.
MOVE S1,OBJ.ND(T1) ;PICK UP THE NODE NUMBER.
CAME S1,CNTSTA ;IS IT THE CENTRAL SITE ???
SETOM J$LREM(J) ;NO,,THEN ITS A REMOTE LPT.
IDIVI S1,10 ;SPLIT NODE NUMBER IN HALF.
IMULI S1,100 ;SHIFT LEFT 2 DIGITS.
ADD S1,S2 ;ADD SECOND NODE DIGIT.
IMULI S1,100 ;SHIFT LEFT ANOTHER 2 DIGITS.
ADD S1,OBJ.UN(T1) ;ADD THE UNIT NUMBER.
ADD S1,[SIXBIT/LPT000/] ;CREATE THE PHYSICAL DEVICE NAME.
POPJ P, ;RETURN. . . . .
> ;END TOPS10 CONDITIONAL
TOPS20 <
OUTGET: SKIPE J$MTAP(J) ;ARE WE SPOOLING TO TAPE ???
PJRST TAPGET ;YES,,OPEN DIFFERENTLY
MOVSI S1,(POINT 8,0) ;GET 8 BIT BYTE POINTER
MOVEM S1,J$LBTZ(J) ;SAVE IT FOR LATER
MOVE S1,STREAM ;GET OUR STREAM NUMBER
MOVE S1,JOBOBA(S1) ;GET OUR OBJECT BLOCK ADDRESS
SKIPN J$LREM(J) ;IS THIS A LOCAL LPT ???
$TEXT (<-1,,J$LSTG(J)>,<PLPT^O/OBJ.UN(S1)/:^0>) ;YES,,GEN UNIT NAME
SKIPGE J$LREM(J) ;IS THIS A REMOTE LPT ???
$TEXT (<-1,,J$LSTG(J)>,<^W/OBJ.ND(S1)/::PLPT^O/OBJ.UN(S1)/:^0>)
MOVX S1,GJ%FOU!GJ%SHT ;LOAD GTJFN FLAGS
HRROI S2,J$LSTG(J) ;POINT TO THE STRING
PUSHJ P,$GTJFN ;GET THE LPT JFN
JUMPF OUTDDE ;CANT,,FATAL ERROR
MOVEM S1,J$LCHN(J) ;WIN, SAVE THE JFN
MOVX S2,OF%WR+OF%OFL+8B5 ;OPEN FOR WRITING 8 BIT BYTES
PUSHJ P,$OPENF ;OPEN THE DEVICE
JUMPF OUTDNA ;CANT,,DEVICE NOT AVAILABLE NOW.
PUSHJ P,OUTRES ;SETUP/RESET THE OUTPUT BUFR POINTERS
SKIPLE J$LREM(J) ;IS THIS A DN60 (IBM) LPT ???
JRST [MOVX S1,%RSUOK ;YES,,GET 'SETUP OK'
$RETT ] ; AND SKIP THE REST OF THIS !!!
MOVE S1,J$LCHN(J) ;GET LPT JFN
MOVX S2,.MORST ;GET FUNCTION TO READ STATUS
MOVEI T1,T2 ;LOAD ADDRESS OF ARG BLOCK
MOVEI T2,3 ;LOAD LENGTH OF ARG BLOCK
PUSHJ P,$MTOPR ;GO GET THE DEVICE STATUS
JUMPF OUTSOK ;CANT,,IGNORE THE ERROR
TXNE T3,MO%FNX ;DOES THE LPT EXIST ???
PJRST [PUSHJ P,OUTREL ;NO,,RELEASE JFN AND CLOSE THE LPT
PJRST OUTDDE ] ; AND RETURN THROUGH 'DOES NOT EXIST'
TXNE T3,MO%LCP ;IS IT A LOWER CASE PRINTER?
SETOM J$LLCL(J) ;YES, SET THE FLAG
MOVE S1,[SIXBIT/LP64/] ;DEFAULT TO 64 CHARACTER RAM
SKIPE J$LLCL(J) ;UNLESS IT IS A LOWER CASE LPT,
MOVE S1,[SIXBIT/LP96/] ;THEN ITS A 96 CHARACTER RAM
MOVEM S1,J$LRAM(J) ;SAVE THE DEFAULT RAM FILE NAME
MOVE S1,D$TAPE ;GET THE DEFAULT VFU TYPE.
SKIPN J$FTAP(J) ;HAS THE VFU ALREADY BEEN DEFAULTED ???
MOVEM S1,J$FTAP(J) ;NO,,SAVE AS THE VFU DEFAULT.
TXNN T3,MO%LVU ;IS IT NOT OPTICAL VFU
SETOM J$LDVF(J) ;YES, SET THAT
MOVX S1,PSF%DO ;DEVICE OFFLINE FLAG
ANDCAM S1,JOBSTW ;CLEAR THE VALUE
TXNE T3,MO%OL ;IS IT OFF-LINE?
IORM S1,JOBSTW ;YES, SET FLAG
JRST OUTSOK ;CONTINUE ON OK
> ;END TOPS20 CONDITIONAL
SUBTTL OUTGET Exit Subroutines
OUTSOK: PUSHJ P,INTCNL ;CONNECT UP THE LPT
JUMPF OUTDDE ;DID NOT SUCCEED,,DEVICE DOES NOT EXIST
TXO S,INTRPT ;INDICATE WE'RE CONNECTED
MOVX S1,%RSUOK ;LOAD THE CODE
$RETT ;AND RETURN
OUTDNA: MOVX S1,%RSUNA ;NOT AVAILABLE RIGHT NOW
$RETF ;AND RETURN
OUTDDE: MOVX S1,%RSUDE ;NEVER AVAILABLE
$RETF ;RETURN
SUBTTL TAPGET - ROUTINE TO SETUP A MAG TAPE DEVICE FOR OUTPUT
TOPS20 <
TAPGET: SKIPN J$LSTG(J) ;DO WE HAVE A DEVICE NAME YET ???
$TEXT (<-1,,J$LSTG(J)>,<^W/J$MTAP(J)/:^0>) ;NO,,GEN THE DEVICE NAME
SETZM J$LREM(J) ;FORCE US TO BE LOCAL
HRLI S1,(POINT 7,0) ;GET 7 BIT BYTE POINTER (OUTPUT)
MOVEM S1,J$LBTZ(J) ;SAVE IT FOR LATER
MOVX S1,GJ%SHT+GJ%FOU ;GET GTJFN FLAG BITS
HRROI S2,J$LSTG(J) ;POINT TO THE DEVICE NAME
GTJFN ;GET A JFN
JRST TAPG.2 ;CANT,,TOUGH BREAKEEE
MOVEM S1,J$LCHN(J) ;SAVE THE JFN
DVCHR ;GET THE DEVICE CHARACTERISTICS
ERJMP TAPG.1 ;SHOULD NOT HAPPEN
MOVX S1,DEVX2 ;GET ALREADY ASSIGNED ERROR CODE
HLRZS T1 ;MOVE LEFT TO RIGHT,,ZERO LEFT
CAIE T1,-1 ;THE TAPE SHOULD NOT BE ASSIGNED !!!
JRST TAPG.1 ;IT IS,,CAN THE REQUEST
MOVE S1,J$LCHN(J) ;GET THE JFN BACK
MOVX S2,OF%WR+7B5 ;WRITE+7 BIT BYTES
OPENF ;OPEN THE MAG TAPE
JRST TAPG.1 ;CANT,,TOUGH !!!
MOVE S1,J$LCHN(J) ;GET THE JFN
MOVX S2,.MONOP ;WAIT FOR I/O or SET TTY PAGE WIDTH
SETZM T1 ;NO ARGS or INFINITE PAGE WIDTH
MTOPR ;DO IT !!!
ERJMP .+1 ;IGNORE THE ERROR
PUSHJ P,OUTRES ;SETUP THE OUTPUT POINTERS
PJRST OUTSOK ;SO FAR HE WINS...
TAPG.1: MOVE T1,S1 ;SAVE THE ERROR CODE
MOVE S1,J$LCHN(J) ;GET THE JFN
RLJFN ;RELEASE IT
JFCL ;IGNORE THE ERROR
MOVE S1,T1 ;RESTORE THE ERROR CODE TO S1
TAPG.2: MOVE S2,STREAM ;GET OUR STREAM NUMBER
$WTO (<^T/J$LSTG(J)/ ^E/S1/>,,@JOBOBA(S2)) ;TELL THE OPERATOR
PJRST OUTDDE ;GIVE UP THE SHIP
>
SUBTTL OUTOUT -- Routine to output a buffer
TOPS10 <
;NOTE: The 'Output-Blocked' bit is set here in order to avoid
; a race condition which would allow LPTSPL to miss the
; 'Output-Done' Interrupt. In particular, this avoids
; the problem of getting the 'Output-Done' interrupt
; before LPTSPL has set the 'Output-Blocked' bit when
; de-scheduling the stream. This situation would cause
; the stream to block forever, waiting for an interrupt
; which it had already received.
OUTOUT: MOVE S1,STREAM ;GET THE STREAM NUMBER
MOVX S2,PSF%OB ;GET THE 'OUTPUT-BLOCKED' BIT
IORM S2,JOBSTW(S1) ;TURN ON THE 'OUTPUT-BLOCKED' BIT
MOVE S1,J$LCHN(J) ;GET THE CHANNEL NUMBER
LSH S1,^D23 ;POSITION IT
TLO S1,(OUT 0,0) ;MAKE IT AN OUTPUT UUO
XCT S1 ;OUTPUT THE BUFFER
JRST [MOVE S1,STREAM ;NO ERROR,,GET OUR STREAM NUMBER
ANDCAM S2,JOBSTW(S1) ; AND CLEAR THE OUTPUT BLOCKED BITS
$RETT ] ; NOW WE CAN RETURN
PJRST OUTERR ;ERROR,,GO PROCESS IT
> ;END TOPS10 CONDITIONAL
TOPS20 <
OUTOUT: PUSHJ P,.SAVET ;SAVE THE 'T' ACS
OUTO.1: PUSHJ P,OUTWON ;CHECK OFFLINE STATUS
$DSCHD(0) ;FORCE A SCHEDULING PASS
SKIPGE T1,J$LBCT(J) ;GET BYTES REMAINING IN BUFFER
SETZM T1 ;IF LESS,,MAKE IT ZERO
SUB T1,J$LIBC(J) ;CALC -BYTE COUNT IN BUFFER
JUMPGE T1,OUTRES ;NOTHING TO PUT OUT,,RESET BUFR PTRS
MOVE S1,J$LCHN(J) ;GET THE LPT JFN
MOVE S2,J$LIBP(J) ;GET THE STARTING BYTE POINTER
PUSHJ P,$SOUT ;OUTPUT THE DATA
MOVEM S2,J$LIBP(J) ;SAVE THE BUFFER POINTER AND
MOVMM T1,J$LIBC(J) ; THE BYTE COUNT JUST IN CASE
SETZM J$LBCT(J) ;CLEAR BYTE COUNT FOR THE BUFFER
SKIPT ;SKIP IF SOUT WAS OK
PUSHJ P,OUTERR ;ELSE GO PROCESS THE ERROR
SKIPLE J$LIBC(J) ;ANY BYTES LEFT IN THE BUFFER ???
JRST OUTO.1 ;YES,,GO PUT THEM OUT
OUTRES: MOVEI S1,BUFCHR ;GET CHARACTERS PER BUFFER
MOVEM S1,J$LBCT(J) ;SAVE AS BUFFER BYTE COUNT
MOVEM S1,J$LIBC(J) ;HERE ALSO
MOVE S1,J$LBUF(J) ;GET THE BUFFER ADDRESS
ADD S1,J$LBTZ(J) ;ADD THE BYTE PTR (LEFT HALF)
MOVEM S1,J$LBPT(J) ;SAVE AS BUFFER BYTE POINTER
MOVEM S1,J$LIBP(J) ;HERE ALSO
$RETT ;AND RETURN
> ;END TOPS20 CONDITIONAL
SUBTTL OUTERR -- Handle Output Device Errors
OUTERR:
TOPS10 <
MOVE S1,J$LCHN(J) ;GET THE CHANNEL NUMBER
LSH S1,^D23 ;POSITION IT
IOR S1,[GETSTS J$LIOS(J)] ;MAKE IT AN INSTRUCTION
XCT S1 ;AND EXECUTE IT
MOVE S1,J$LIOS(J) ;GET THE IOERROR STATUS
TXNE S1,IO.ERR!IO.EOT ;WAS THERE AN ERROR? OR HIT END OF TAPE?
JRST OUTE.1 ;YES, GIVE THE ERROR
$DSCHD(0) ;BLOCK FOR OUTPUT DONE (See Above)
JRST OUTOUT ;AND TRY AGAIN
OUTE.1: PUSHJ P,.SAVET ;SAVE ALL THE 'T' ACS
MOVE T4,STREAM ;GET THE STREAM NUMBER
MOVE S1,J$LIOS(J) ;GET THE ERROR STATUS
TRC S1,IO.ERR ;TEST FOR ALL FOUR ERROR BITS
TRCE S1,IO.ERR ;BEING SET.
JRST OUTE.5 ;AND THEY ARE NOT
MOVE T1,[2,,T2] ;PREPARE FOR DEVOP. UUO
MOVEI T2,.DFRES ;READ EXTENDED ERROR STATUS
MOVE T3,J$LCHN(J) ;GET CHANNEL NUMBER
DEVOP. T1,
JRST OUTE.2 ;LOSE, JUST GIVE STATUS
CAXN T1,IOVFE% ;IS THE ERROR BAD VFU ?
JRST OUTE.4 ;YES,,DO SOME SPECIAL PROCESSING
CAXE T1,IOPAR% ;IS IT RAM TROUBLE ???
JRST OUTE.2 ;NO,,GENERAL I/O ERROR
;YES,,FALL THROUGH AND PROCESS IT
> ;END TOPS10 CONDITIONAL
TOPS20 <
MOVE T4,STREAM ;GET OUR STREAM NUMBER
PUSHJ P,$GDSTS ;GET THE DEVICE STATUS
MOVEM S1,J$LIOS(J) ;SAVE THE DEVICE STATUS
MOVE T1,S1 ;SAVE IT HERE ALSO
TXZ S1,MO%OL ;CLEAR THE OFFLINE BIT
PUSHJ P,$SDSTS ;RESET THE DEVICE STATUS
TXNE T1,MO%LVF ;VFU ERR ???
JRST OUTE.4 ;YES,,GO PROCESS IT
TXNN T1,MO%RPE ;WAS IT A RAM PARITY ERROR
JRST OUTE.2 ;NO,,PROCESS AS AN I/O ERROR
> ;END TOPS20 CONDITIONAL ;YES,,PROCESS IT
;RAM PARITY ERROR
OUT.2A: $WTO (RAM Parity Error,,@JOBOBA(T4)) ;YES,,TELL OPERATOR
PUSHJ P,OUTE.3 ;PERFORM SOME PRELIMINARY PROCESSING
SETZM J$FLRM(J) ;FORCE A RAM RELOAD
PUSHJ P,LODRAM ;GO DO IT !!!
$RETT ;AND RETURN
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;UNKNOWN TYPE I/O ERROR OCCURED
OUTE.2: $WTO (I/O Error,<Status is: ^O/J$LIOS(J)/>,@JOBOBA(T4))
;GENERAL I/O ERROR RECOVERY ROUTINE
OUTE.3: PUSHJ P,OUTDIE ;SEE IF TOO MANY ERRORS
PUSHJ P,OUTFLS ;RESET THE OUTPUT CHANNEL
JUMPF [MOVX S1,%RSUNA ;CAN'T,,GET 'DEVICE NOT AVAILABLE' ERROR
PUSHJ P,RSETUP ;TELL QUASAR TO RESET THE OBJECT
PJRST SHUTIN ] ;SHUT DOWN THE DEVICE
TXNN S,VFULOD+BANHDR ;IF LOADING VFU OR PRINTING HDRS
TXNN S,DSKOPN ; OR IF WE ARE NOT IN A FILE?
$RETT ;THEN JUST RETURN
MOVE S1,J$RNCP(J) ;GET NUMBER OF COPIES PRINTED
AOS S1 ;MAKE INTO CURRENCT COPY NUMBER
$TEXT (LOGCHR,<^I/LPERR/LPT I/O Error occurred during ^F/@J$DFDA(J)/, Copy:^D/S1/, Page:^D/J$RNPP(J)/; Status is: ^O/J$LIOS(J)/>)
MOVEI S1,[EXP 5] ;PREPARE TO BACKSPACE 5 PAGES
PUSHJ P,BSPACE ;BACKSPACE 5 PAGES
$RETT ;RETURN
;VFU ERROR OCCURED
OUTE.4: $WTOR (VFU error,<Re-align forms and put on-line^M^J^T/ENDRSP/>,@JOBOBA(T4),JOBWAC(T4))
SETOM JOBCHK(T4) ;SAY WE WANT A CHECKPOINT TAKEN
$DSCHD(PSF%OR) ;WAIT FOR THE OPERATOR RESPONSE
TXNE S,ABORT+RQB ;HAVE WE BEEN CANCELED OR REQUEUED ???
$RETT ;YES,,JUST RETURN
MOVEI S1,CONANS ;POINT TO THE CONTINUE ANSWER BLOCK
HRROI S2,J$RESP(J) ;POINT TO THE ANSWER
PUSHJ P,S%TBLK ;DO WE MATCH ???
TXNE S2,TL%NOM+TL%AMB ;DID WE FIND IT OK ???
JRST OUTE.4 ;NO,,STUPID OPERATOR SO TRY AGAIN
PUSHJ P,OUTE.3 ;GO PERFORM SOME PRELIMINARY PROCESSING
SETZM J$FLVT(J) ;FORCE A VFU RELOAD
PUSHJ P,LODVFU ;GO RELOAD THE VFU
$RETT ;AND RETURN
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;NO STOCK ERROR BITS SET, TRY EOF (END OF TAPE)
TOPS10<
OUTE.5: SKIPE J$MTAP(J) ;ARE WE SPOOLING TO TAPE?
TRZN S1,IO.EOT ;YES, HIT EOT?
JRST OUTE.2 ;NO, UNKNOWN ERROR
MOVE T1,J$LCHN(J) ;GET CHANNEL NUMBER
LSH T1,^D23 ;MOVE INTO PLACE (AC FIELD)
TLO T1,(SETSTS (S1)) ;MAKE INTO A UUO
XCT T1 ;CLEAR THE ERROR (EOT)
MOVE T1,[XWD 2,T2] ;AIM AT ARGUMENT BLOCK FOR TAPOP.
MOVX T2,.TFWTM ;CODE TO WRITE A TAPE MARK
MOVE T3,J$LCHN(J) ;DEVICE ON THIS CHANNEL
TAPOP. T1, ;WRITE ONE MARK
JFCL ;OH WELL
TAPOP. T1, ;WRITE ANOTHER (MARK END OF TAPE)
JFCL ;ITS A BAD DAY (AND A BAD TAPE!)
MOVX T2,.TFUNL ;CODE TO GET RID OF THE TAPE
TAPOP. T1, ;UNLOAD THIS FULL REEL
JFCL ;HAVE TO LIVE WITH IT
OUT.5A: $WTOR (End of tape,<Mount next reel on ^W/J$MTAP(J)/^M^Jand RESPOND with CONTINUE>,@JOBOBA(T4),JOBWAC(T4))
SETOM JOBCHK(T4) ;ASK FOR A CHECKPOINT
$DSCHD (PSF%OR) ;DROP THE STREAM TILL RESPONSE COMES IN
TXNE S,ABORT+RQB ;HAVE WE BEEN GIVEN THE GONG?
$RETT ;YES, QUIT NOW
MOVEI S1,CONANS ;POINT TO THE VALID RESPONSES
HRROI S2,J$RESP(J) ;AIM AT WHAT THE OPR TYPED
$CALL S%TBLK ;BOUNCE RESPONSE OFF TABLE
TXNE S2,TL%NOM+TL%AMB ;MATCH?
JRST OUT.5A ;NO, ASK OPR AGAIN
JRST OUTOUT ;NEW REEL IS UP, TRY OUTPUT AGAIN
>;END OF TOPS10
CONANS: 1,,1 ;TBLK CONTROL BLOCK
[ASCIZ/CONTINUE/],,0 ;POSSIBLE RESPONSE
OUTDIE: SOSL J$LERR(J) ;COUNT DOWN ERRORS
POPJ P, ;STILL ALIVE
MOVE S1,STREAM ;GET STREAM NUMBER
$WTO (TOO MANY DEVICE ERRORS,,@JOBOBA(S1))
MOVEI S1,%RSUDE ;GET DEVICE DOES NOT EXIST BIT.
PUSHJ P,RSETUP ;TELL QUASAR PRINTER IS OUT TO LUNCH.
PJRST SHUTIN ;AND SHUT IT DOWN
SUBTTL OUTWON -- Wait for on-line
;On the -10, this routine should only be gotten to by DEBRKing to it
; on a device off-line interrupt. On the -20, it can be called
; from anywhere.
; NOTE: The ONLINE/OFFLINE (PSF%DO) status bits are set and cleared
; at interrupt level. This pervents a race condition from
; occuring where the device comes online while we are still
; processing the device offline interrupt. In this case
; it was possible for LPTSPL to miss the on-line
; change-of-state, and sleep forever waiting for the
; online interrupt.
TOPS10 <
OUTWON: PUSH P,S1 ;SAVE S1
PUSH P,S2 ;SAVE S2
MOVE S1,STREAM ;GET STREAM NUMBER
$WTO (<^T/BELL/>,,@JOBOBA(S1)) ;TELL THE OPERATOR.
$DSCHD(0) ;BLOCK THE PROCESS
POP P,S2 ;RESTORE S2
POP P,S1 ;RESTORE S1
JRST @J$LIOA(J) ;AND CONTINUE ON
> ;END TOPS10 CONDITIONAL
TOPS20 <
OUTWON: MOVX S2,PSF%DO ;DEVICE OFFLINE FLAG
MOVE S1,STREAM ;AND THE STREAM NUMBER
TDNN S2,JOBSTW(S1) ;IS IT OFF-LINE?
POPJ P, ;NO, JUST RETURN
$WTO (<^T/BELL/>,,@JOBOBA(S1)) ;TELL THE OPERATOR.
$DSCHD(0) ;BLOCK FOR DEVICE ONLINE
POPJ P, ;NO, RETURN
> ;END TOPS20 CONDITIONAL
BELL: BYTE(7) 07,07,117,146,146
ASCIZ/line/
SUBTTL OUTREL -- Release device on SHUTDOWN
TOPS10 <
OUTREL: TXZE S,INTRPT ;ARE WE CONNECTED TO INTRPT SYSTEM ??
PUSHJ P,INTDCL ;YES,,RELEASE THE INTERRUPTS
MOVE S1,J$LCHN(J) ;GET THE CHANNEL
SKIPE J$MTAP(J) ;ARE WE SPOOLING TO TAPE ???
JRST OUTR.1 ;YES,,ISSUE A CLOSE/RELEASE INSTEAD
RESDV. S1, ;RESET THE CHANNEL
JFCL ;IGNORE ANY ERRORS
$RETT ;AND RETURN
OUTR.1: LSH S1,^D23 ;POSITION THE CHANNEL NUMBER
TLO S1,(CLOSE 0,0) ;MAKE IT A CLOSE UUO
XCT S1 ;CLOSE THE MAG TAPE
MOVE S1,J$LCHN(J) ;GET THE CHANNEL NUMBER AGAIN
LSH S1,^D23 ;POSITION IT
TLO S1,(RELEASE 0,0) ;MAKE IT A RELEASE UUO
XCT S1 ;RELEASE THE DEVICE
$RETT ;AND RETURN
> ;END TOPS10 CONDITIONAL
TOPS20 <
OUTREL: MOVE S1,J$LCHN(J) ;GET THE CHANNEL(JFN)
MOVX S2,.MOFLO ;GET FLUSH BUFFERS CODE
SETZ T1, ;SET AC 3 TO 0
PUSHJ P,$MTOPR ;FLUSH THE BUFFERS
JUMPF .+1 ;IGNORE ANY ERRORS
SKIPE J$MTAP(J) ;ARE WE SPOOLING TO TAPE ???
JRST OUTR.1 ;YES,,DO THINGS A LITTLE DIFFERENTLY
MOVE S1,J$LCHN(J) ;NO,,GET THE JFN AGAIN
TXO S1,CZ%ABT ;ABORT ALL OUTPUT OPERATIONS
PUSHJ P,$CLOSF ;CLOSE IT DOWN
$RETT ;NO,, RETURN
OUTR.1: MOVE S1,J$LCHN(J) ;GET THE JFN
MOVX S2,.MONOP ;WAIT FOR ALL OUTPUT TO STOP
SETZM T1 ;NO ARGS
MTOPR ;DO IT !!!
ERJMP .+1 ;IGNORE THE ERROR
MOVX S2,.MOEOF ;WANT TO WRITE SOME TAPE MARKS
MTOPR ;WRITE ONE
ERJMP .+1 ;IGNORE ANY ERROR
MTOPR ;WRITE ANOTHER !!!
ERJMP .+1 ;IGNORE THE ERROR
MTOPR ;ONE MORE FOR GOOD LUCK !!!!
ERJMP .+1 ;IGNORE THE ERROR
MOVX S2,.MORUL ;WANT TO REWIND AND UNLOAD THE TAPE
MTOPR ;DO IT !!!
ERJMP .+1 ;IGNORE THE ERROR
TXO S1,CZ%ABT ;LITE THE ABORT BIT
CLOSF ;CLOSE DOWN THE MAG TAPE
JFCL ;IGNORE THE ERROR
$RETT ;AND RETURN
>;END TOPS20 CONDITIONAL
SUBTTL OUTEOF - ROUTINE TO CLEAR THE LPT OUTPUT BUFFERS
TOPS10 <
OUTEOF: $SAVE <T1> ;SAVE T1 FOR A MINUTE
MOVX S1,.TFWTM ;GET WRITE TAPE MARK CODE
MOVE S2,J$LCHN(J) ;GET THE DEVICE CHANNEL #
MOVE T1,[XWD 2,S1] ;GET LENGTH,,PARM BLOCK ADDRESS
TAPOP. T1, ;DO IT
JFCL ;IGNORE ANY ERRORS
$RETT ;AND RETURN
>
TOPS20 <
OUTEOF: MOVE S1,J$LCHN(J) ;GET THE LPT JFN
MOVX S2,.MOEOF ;GET THE FLUSH BUFFERS CODE
SETZM T1 ;NO ARGS
PUSHJ P,$MTOPR ;DO IT
$RETT ;AND RETURN
>
SUBTTL OUTDMP -- Dump out buffers and wait
TOPS10 <
OUTDMP:
REPEAT BUFNUM+1,<
PUSHJ P,OUTOUT ;DUMP THE BUFFER
> ;END REPEAT BUFNUM
POPJ P, ;AND RETURN
> ;END TOPS10 CONDITIONAL
TOPS20 <
OUTDMP: PUSHJ P,OUTOUT ;DUMP THE INTERNAL BUFFERS
MOVE S1,J$LCHN(J) ;GET THE LPT JFN
MOVX S2,.MONOP ;AND NO-OP FUNCTION
SETZM T1 ;ZAP AC 3
PUSHJ P,$MTOPR ;DO IT
SKIPT ;OK,,CONTINUE
PUSHJ P,OUTERR ;ELSE GO PROCESS THE ERROR
$RETT ;AND RETURN
> ;END TOPS20 CONDITIONAL
SUBTTL OUTFLS -- Flush already buffered output
;OUTFLS IS CALLED TO FLUSH OUTPUT TO THE PRINTER WHICH HAS ALREADY BEEN
; BUFFERED (AND POSSIBLE SENT TO THE PRINTER).
TOPS10 <
OUTFLS: PUSHJ P,INTDCL ;DISCONNECT PRINTER INTERRUPTS
MOVE S1,J$LCHN(J) ;LOAD THE CHANNEL NUMBER
RESDV. S1, ;RESET THE CHANNEL
JFCL ;??
PUSHJ P,OUTGET ;GO RESET UP THE OUTPUT DEVICE
CAIN S1,%RSUOK ;ARE WE ALL RIGHT ???
$RETT ;YES,,JUST RETURN
PUSHJ P,RSETUP ;NO,,SEND RESPONSE TO SETUP MSG
$RETF ;AND RETURN
> ;END TOPS10 CONDITIONAL
TOPS20 <
OUTFLS: MOVE S1,J$LCHN(J) ;GET OUTPUT JFN
MOVX S2,.MOFLO ;LOAD FLUSH FUNCTION
MOVEI T1,0 ;AND ZERO ARGUMENTS
PUSHJ P,$MTOPR ;FLUSH THE BUFFERS
JUMPF OUTF.1 ;ON AN ERROR,,SHUT IT DOWN AND RESET IT
PUSHJ P,OUTRES ;RESET THE OUTPUT POINTERS
MOVX S1,%RSUOK ;RETURN 'FLUSH' OK
$RETT ;HEAD BACK
OUTF.1: MOVE S1,J$LCHN(J) ;GET THE LPT JFN
TXO S1,CZ%ABT ;LITE THE ABORT BIT
PUSHJ P,$CLOSF ;CLOSE IT DOWN
PJRST OUTGET ;AND SET THE DEVICE UP AGAIN
> ;END TOPS20 CONDITIONAL
SUBTTL LPT CONTROL ROUTINES
;CONTROL CHARACTER TABLE
NCLRFF==1B0 ;DON'T CLEAR FORMFEED FLAG
SUPRCH==1B1 ;SUPPRESSABLE CHARACTER
EOLCHR==1B2 ;CHARACTER IS AN EOL (IN REPORT FILES)
CHTAB: EXP <NCLRFF+.POPJ> ;(00) NULL
EXP CHKARO ;(01) CONTROL-A
EXP CHKARO ;(02) CONTROL-B
EXP CHKARO ;(03) CONTROL-C
EXP CHKARO ;(04) CONTROL-D
EXP CHKARO ;(05) CONTROL-E
EXP CHKARO ;(06) CONTROL-F
EXP CHKARO ;(07) CONTROL-G
EXP CHKARO ;(10) CONTROL-H
EXP NCLRFF+DEVOUT ;(11) THIS IS A TAB
EXP SUPRCH+EOLCHR+DOLF ;(12) THIS IS A LINE FEED
EXP SUPRCH+EOLCHR+3+DOFRAC ;(13) THIS SKIPS 1/3 PAGE (VERT TAB)
EXP SUPRCH+NCLRFF+EOLCHR+DOFORM ;(14) THIS IS A FORM-FEED
EXP NCLRFF+EOLCHR+DEVOUT ;(15) CARRIAGE RETURN
EXP CHKARO ;(16) CONTROL-N
EXP CHKARO ;(17) CONTROL-O
EXP SUPRCH+EOLCHR+2+DOFRAC ;(20) THIS SKIPS 1/2 PAGE
EXP SUPRCH+EOLCHR+30+DOFRAC ;(21) THIS SKIPS 2 LINES (DC1)
EXP SUPRCH+EOLCHR+20+DOFRAC ;(22) THIS SKIPS 3 LINES (DC2)
EXP SUPRCH+EOLCHR+DODC3 ;(23) DC3 SKIPS 1 LINE
EXP SUPRCH+EOLCHR+6+DOFRAC ;(24) THIS SKIPS 1/6 OF A PAGE (DC4)
EXP CHKARO ;(25) CONTROL-U
EXP CHKARO ;(26) CONTROL-OL-V
EXP CHKARO ;(27) CONTROL-W
EXP CHKARO ;(30) CONTROL-X
EXP CHKARO ;(31) CONTROL-Y
EXP CHKARO ;(32) CONTROL-Z
EXP CHKARO ;(33) ESCAPE
EXP CHKARO ;(34) CONTROL-\
EXP CHKARO ;(35) CONTROL-]
EXP CHKARO ;(36) CONTROL-^
EXP CHKARO ;(37) CONTROL-
;FORTRAN CONTROL CHARACTOR TRANSLATION TABLE
DEFINE FORCHR(CHR,TRANS,N),<
EXP <CHR>B17+<N>B26+TRANS
> ;END DEFINE FORCHR
FORTAB: FORCHR " ",.CHLFD,1
FORCHR "0",.CHLFD,2
FORCHR "1",.CHFFD,1
FORCHR "2",20,1
FORCHR "3",13,1
FORCHR "/",24,1
FORCHR "*",23,1
FORCHR "+",.CHCRT,1
FORCHR 54,21,1
FORCHR "-",.CHLFD,3
FORCHR ".",22,1
NFORCH==.-FORTAB
SUBTTL FILOUT - SUBROUTINE TO SET UP FOR LPTIN AND LPTOUT
; CALL WITH:
; PUSHJ P,FILOUT
; RETURN HERE
;
FILOUT: MOVE T1,J$FLIN(J) ;START AT TOP OF PAGE
MOVEM T1,J$XPOS(J) ;SAVE IT
PUSHJ P,SETPFT ;SETUP FILE TYPE
PUSHJ P,(T1) ;DISPATCH
TXNN S,RQB ;HAVE WE BEEN REQUEUED ???
SKIPE J$XTOP(J) ;OR ARE WE AT TOP-OF-FORM?
POPJ P, ;YES TO EITHER,,JUST RETURN
AOS J$APRT(J) ;NO, CHARGE HIM FOR THE REST
AOS J$RNPP(J) ;HERE ALSO
POPJ P, ;AND RETURN
SUBTTL SETLST - SUBROUTINE TO COMPILE CODE TO TEST EACH LINE FOR A MATCH AGAINST
; THE /REPORT VALUE.
; CALL WITH:
; PUSHJ P,SETLST
; RETURN HERE
;
SETLST: MOVEI T2,J$XCOD-1(J) ;SET UP PDP TO COMPILED CODE
SKIPN .FPFR1(E) ;WAS /REPORT SPECIFIED?
$RETT ;NO, JUST RETURN
STLST1: MOVE T3,[POINT 6,.FPFR1(E)] ;POINTER TO LIST
MOVEI T4,^D12 ;ABSOLUTE LIMIT
STLST2: ILDB T1,T3 ;GET A CHAR
JUMPE T1,STLSC ;JUMP IF DONE
ADDI T1,"A"-'A' ;CONVERT TO ASCII
CAIN T4,^D12 ;1ST TIME THRU, WE'VE GOT A CHARACTER
JRST STLST4 ;YES--CHAR ALRADY IN C
PUSH T2,SETLSA ;COMPILE A PUSHJ
PUSH T2,SETLSB ;WE HAVE AN ERROR RETURN THEN
STLST4: HLL T1,SETLSC ;PLACE CHAR IN CAIE
PUSH T2,T1 ;COMPILE THE CAIE
PUSH T2,SETLSD ;COMPILE THE JRST TO FLUSH7
SOJG T4,STLST2 ;LOOP FOR WHOLE STRING
STLSC: PUSH T2,[POPJ P,] ;AND PROCESS THE CHARACTER
POPJ P, ;RETURN
;THE INSTRUCTIONS WHICH ARE GENERATED:
SETLSA: PUSHJ P,INPBYT
SETLSB: JUMPF .RETT
SETLSC: CAIE C,0
SETLSD: JRST FLUSH7
SUBTTL SETPFT -- Setup file processing type
;CALLED TO DETERMINE WHICH TYPE OF PROCESSING SHOULD BE DONE ON THE
; INPUT FILE.
;
;RETURNS WITH T1 CONTAINING ADDRESS OF PROCESSING ROUTINE AS FOLLOWS:
;
; LPTOCT <--> /PRINT:OCTAL
; LPTCOB <--> /FILE:COBOL
; LPTFOR <--> /FILE:FORTRAN /PRINT:(ARROW,ASCII,SUPPRESS)
; LPTRPT <--> /FILE:ASCII /REPORT:XXX /PRINT:(ARROW,ASCII,SUP)
; LPTASC <--> /FILE:ASCII /PRINT:(ARROW,ASCII,SUPPRESS)
; LPTELV <--> /FILE:ELEVEN
;THE DETERMINATION IS DONE IN THE ABOVE ORDER
SETPFT: LOAD S1,.FPINF(E),FP.FFF ;GET /FILE
LOAD S2,.FPINF(E),FP.FPF ;GET /PRINT
TXZ S,ARROW ;CLEAR SOME INITIAL FLAGS
TXO S,NEWLIN!FCONV ;AND SET SOME OTHERS
MOVEI T1,LPTOCT ;ASSUME /PRINT:OCTAL
CAIN S2,%FPLOC ;IS IT?
POPJ P, ;YES, RETURN
MOVEI T1,LPTCOB ;NO, ASSUME /FILE:COBOL
CAIN S1,.FPFCO ;IS IT?
POPJ P, ;YES, RETURN
CAIN S2,%FPLAR ;/PRINT:ARROW?
TXO S,ARROW ;YES, LIGHT A FLAG
CAIN S2,%FPLSU ;/PRINT:SUPPRESS?
TXO S,SUPFIL ;YES, LIGHT A BIT
MOVEI T1,LPTFOR ;ASSUME /FILE:FORTRAN
CAIN S1,.FPFFO ;IS IT?
POPJ P, ;YES, RETURN
MOVEI T1,LPTELV ;ASSUME /FILE:ELEVEN
CAIN S1,.FPF11 ;IS IT?
POPJ P, ;YES, RETURN
MOVEI T1,LPTASC ;ASSUME STANDARD ASCII
SKIPE .FPFR1(E) ;UNLESS /REPORT WAS SPECIFIED
MOVEI T1,LPTRPT ;USE REPORT ROUTINE
POPJ P, ;AND RETURN
SUBTTL LPTASC -- Print Regular ASCII on LPT
LPTASC: SOSL J$DBCT(J) ;COUNT DOWN AND JUMP IF DATA IS THERE.
JRST LPTA.2 ;GO GET A DATA BYTE.
PUSHJ P,INPBUF ;ELSE, GET A BUFFER FULL
JUMPT LPTASC ;IF OK,,CONTINUE PROCESSING.
$RETT ;ELSE RETURN.
LPTA.2: ILDB C,J$DBPT(J) ;GET A CHARACTER
CAIGE C,40 ;PRINTABLE ASCII?
JRST LPTA.5 ;NO, GO HANDLE SPECIAL CHARS
TXNE S,FORWRD ;ARE WE FORWARD SPACING ???
JRST LPTASC ;YES,,SKIP THIS.
SETZM J$XTOP(J) ;CLEAR TOF FLAG
LPTA.3: SOSGE J$LBCT(J) ;ANY ROOM IN BUFFER?
JRST LPTA.4 ;NO, FILL IT
IDPB C,J$LBPT(J) ;YES, DEPOSIT IN BUFFER
JRST LPTASC ;AND GET ANOTHER
LPTA.4: PUSHJ P,OUTOUT ;GET A BUFFER
JRST LPTA.3 ;AND LOOP
LPTA.5: PUSHJ P,CHKSP ;GO HANDLE SPECIAL CHARS
JRST LPTASC ;AND LOOP AROUND
SUBTTL LPTELV -- Print MACY11 file as regular ASCII
LPTELV: PUSHJ P,.SAVE1 ;PRESERVE P1
LPTE.1: SOSL J$DBCT(J) ;COUNT DOWN AND JUMP IF DATA IS THERE.
JRST LPTE.2 ;GO GET A DATA BYTE.
PUSHJ P,INPBUF ;ELSE, GET A BUFFER FULL
JUMPT LPTE.1 ;IF OK,,GET NEXT FOUR BYTES
$RETT ;ELSE RETURN.
LPTE.2: ILDB P1,J$DBPT(J) ;GET 4 BYTES TO PRINT
LDB C,[POINT 8,P1,17] ;GET THE FIRST BYTE
PUSHJ P,LPTE.3 ;PRINT IT
LDB C,[POINT 8,P1,9] ;GET SECOND BYTE
PUSHJ P,LPTE.3 ;PRINT IT
LDB C,[POINT 8,P1,35] ;GET THIRD BYTE
PUSHJ P,LPTE.3 ;PRINT IT
LDB C,[POINT 8,P1,27] ;GET FOURTH BYTE
PUSHJ P,LPTE.3 ;PRINT IT
JRST LPTE.1 ;GET THE NEXT FOUR BYTES
LPTE.3: CAIGE C,40 ;PRINTABLE ASCII?
JRST LPTE.6 ;NO, GO HANDLE SPECIAL CHARS
TXNE S,FORWRD ;ARE WE FORWARD SPACING ???
POPJ P, ;YES,,SKIP THIS.
SETZM J$XTOP(J) ;CLEAR TOF FLAG
LPTE.4: SOSGE J$LBCT(J) ;ANY ROOM IN BUFFER?
JRST LPTE.5 ;NO, FILL IT
IDPB C,J$LBPT(J) ;YES, DEPOSIT IN BUFFER
POPJ P, ;AND GET ANOTHER
LPTE.5: PUSHJ P,OUTOUT ;GET A BUFFER
JRST LPTE.4 ;AND LOOP
LPTE.6: PUSHJ P,CHKSP ;GO HANDLE SPECIAL CHARS
POPJ P, ;AND LOOP AROUND
SUBTTL LPTFOR -- Process FORTRAN data files
LPTFOR: SOSLE J$DBCT(J) ;AND CHARACTERS LEFT
JRST LPTF.1 ;YUP, GET THEM
PUSHJ P,INPBUF ;NO, GET MORE DATA
JUMPF .RETT ;RETURN AT EOF
LPTF.1: ILDB C,J$DBPT(J) ;GET ONE
JUMPE C,LPTFOR ;IGNORE NULLS
TXZE S,FCONV ;CHECK FOR CTL CHAR
JRST FORCNV ;GO DO IT
CAIN C,.CHLFD ;LINEFEED?
TXOA S,FCONV ;FLAG NEXT CHAR AS CTL CHAR
PUSHJ P,LPTOUT ;OTHERWISE PRINT IT
JRST LPTFOR ;AND LOOP AROUND AGAIN.
FORCNV: MOVSI T1,-NFORCH ;MAKE AN AOBJN POINTER
FORC.1: HLRZ T2,FORTAB(T1) ;GET CHAR FROM TABLE
CAMN C,T2 ;MATCH?
JRST FORC.2 ;YES, GO TRANSLATE
AOBJN T1,FORC.1 ;NO, LOOP
MOVEI C,.CHLFD ;DIDN'T FIND A MATCH, SO LOAD
PUSHJ P,LPTOUT ; A LINEFEED, SEND IT, AND
JRST LPTFOR ; CONTINUE ON
FORC.2: HRRZ C,FORTAB(T1) ;GET TRANS CHAR AND REPEAT COUNT
LDB T1,[POINT 9,C,26] ;GET REPEAT COUNT IN T1
MOVEM T1,J$XFRC(J) ;SAVE THE REPEAT COUNT
ANDI C,177 ;AND DOWN TO CHARACTER
FORC.3: PUSHJ P,LPTOUT ;SEND THE CHARACTER
SOSLE J$XFRC(J) ;COUNT DOWN THE REPEAT COUNTER
JRST FORC.3 ;AND LOOP
JRST LPTFOR ;AND CONTINUE
SUBTTL LPTRPT -- Process REPORT files
LPTRPT: PUSHJ P,INPBYT ;GET A BYTE FROM THE FILE
JUMPF .RETT ;AND RETURN WHEN DONE
PUSHJ P,LPTOUT ;DO ALL THE CHECKING
JRST LPTRPT ;AND GET ANOTHER
SUBTTL LPTOCT -- Give an Octal Dump
LPTOCT: PUSHJ P,.SAVE3 ;SAVE P1 - P3
LOAD T1,.FPINF(E),FP.FSP ;GET THE SPACING CODE
CAIE T1,1 ;SINGLE SPACE?
SKIPA P2,[22,,1] ;NO--THEN TRIPLE SPACE, DOUBLE SPACE
;IS UGLY --DO NOT ALLOW IT
MOVE P2,[12,,3] ;SINGLE SPACE THE LISTING
OCT1: MOVEI T1,(P2) ;BLOCK PER PAGE
OCT2: MOVEI T2,^D16 ;LINES PER BLOCK
OCT3: MOVEI T3,^D8 ;WORDS PER LINE
MOVE P1,J$FWCL(J) ;GET THE WIDTH CLASS
CAIN P1,2 ;IS IT 2?
MOVEI T3,4 ;YES, USE 4 WORDS/LINE
CAIN P1,1 ;IS IT 1?
MOVEI T3,2 ;YES, USE 2 WORDS/LINE
OCT4: MOVEI T4,^D12 ;DIGITS PER WORD
MOVEI C," " ;EACH WORD BEGINS WITH 3 BLANKS
PUSHJ P,DEVOUT ;ONE
PUSHJ P,DEVOUT ;TWO
PUSHJ P,DEVOUT ;THREE
PUSHJ P,INPBYT ;GET A WORD
JUMPF .RETT ;DONE!!
MOVE P3,C ;COPY WORD
SETZM J$XTOP(J) ;FLAG MIDDLE OF FORM
MOVE P1,[POINT 3,P3] ;LOAD BYTE POINTER
OCT5: ILDB C,P1 ;GET NEXT DIGIT
MOVEI C,60(C) ;MAKE ASCII
PUSHJ P,DEVOUT ;PRINT CHAR
SOJG T4,OCT5 ;END OF WORD?
SOJG T3,OCT4 ;END OF LINE?
HLRZ C,P2 ;GET MOTION CHARACTER
PUSHJ P,DEVOUT ; ..
SOJG T2,OCT3 ;END OF BLOCK?
PUSHJ P,DEVOUT ;YES--2 EXTRA LINE FEEDS
PUSHJ P,DEVOUT ; ..
SOJG T1,OCT2 ;END OF PAGE?
MOVEI C,.CHFFD ;PRINT A FORM FEED
PUSHJ P,DOFORM ;AND ENFORCE QUOTA ETC.
JRST OCT1 ;PRINT NEXT PAGE
SUBTTL LPTCOB -- Process COBOL Sixbit Files
LPTCOB: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
SETZM J$XTOP(J) ;CAUSE A FORM FEED AT END
PUSHJ P,INPBYT ;GET THE FIRST WORD OF THE FILE
JUMPF .RETT ;NULL FILE
HLRZ T1,C ;COPY THE FIRST 3 LETERS
CAIE T1,'HDR' ;IS IT A HDR
JRST COBOL2 ;NO--NORMAL INPUT
MOVEI T1,15 ;FLUSH TAPE HEADER
PUSHJ P,INPBYT ;GET A WORD
JUMPF COBOL5 ;EOF
SOJG T1,.-2 ;LOOP FOR MORE
COBOL1: PUSHJ P,INPBYT ;GET A WORD
JUMPF COBOL5 ;THE LAST WORD HAS COME
COBOL2: ANDI C,7777 ;MASK TO 12 BITS
JUMPLE C,COBOL1 ;IGNORE 0 COUNTS FOR OBVIOUS REASON
MOVEI P1,(C) ;COPY THE COUNT
MOVEI S1,-1(P1) ;GET COUNT-1 IN S1
SUB S1,J$FWID(J) ;ROUND DOWN TO A LINE
IDIV S1,J$FWID(J) ;CONVERT TO # LINES
MOVNS S1 ;NEGATE IT
ADDM S1,J$XPOS(J) ;AND DECREMENT POSITION
COBOL3: PUSHJ P,INPBYT ;GET A DATA WORD
JUMPF .RETT ;END OF FILE-- ACTUALY THIS SHOULD
; NEVER HAPPEN SINCE THE COUNT IS EXACT.
MOVEI T1,6 ;CHARS PER WORD.
CAIG P1,6 ;ARE WE DOWN TO LAST DREGS?
MOVEI T1,(P1) ;YES--USE EXACT COUNT TO AVOID FREE
; CRLF ON EXTRA BLANKS.
MOVE T2,C ;COPY WORD
MOVE P2,[POINT 6,T2] ;POINT TO WORD
COBOL4: ILDB C,P2 ;AND GET THE CHARACTER
MOVEI C,40(C) ;MAKE ASCII
PUSHJ P,DEVOUT ;PRINT
SOJG T1,COBOL4 ;LOOP FOR NEXT CHAR
SUBI P1,6 ;COUNT 6 MORE CHARS
JUMPG P1,COBOL3 ;GET MORE
MOVEI C,.CHCRT ;LOAD A CARRIAGE RETURN
PUSHJ P,DEVOUT ;PRINT IT
MOVEI C,.CHLFD ;LOAD A LINE FEED
PUSHJ P,DOLF ;AND SEND EOL
JRST COBOL1 ;LOOP FOR MORE.
COBOL5: MOVEI C,.CHFFD ;GET A FORM FEED.
PUSHJ P,DEVOUT ;PUT IT OUT.
$RETT ;AND RETURN.
SUBTTL Character Interrogation Routines
;SUBROUTINE TO PLACE A CHAR ON THE LINE PRINTER
;CALL WITH:
; PUSHJ P,LPTOUT
; RETURN HERE (EOF SET IF OVER LIMIT)
LPTOUT: CAIGE C,40 ;VISABLE ASCII
JRST CHKSP ;NO--SEE IF SPACE
LPTOU1: TXZE S,NEWLIN ;AND THIS IS A NEW LINE
SKIPN J$XCOD(J) ;LETS NOT DO A /REPORT IS THERE IS NO CODE.
SKIPA ;DONT GO DOWN THE TUBES.
JRST J$XCOD(J) ;SEE IF REPORT LINE MATCHES
SETZM J$XTOP(J) ;CLEAR FORM FEED FLAG
PJRST DEVOUT ;PRINT IT
CHKSP: MOVE S1,CHTAB(C) ;GET THE DISPATCH
TXNE S1,EOLCHR ;IS THIS AN END OF LINE CHARACTER ???
TXO S,NEWLIN ;YES,,LITE NEW LINE BIT
TXNN S1,NCLRFF ;CLEAR FORMFEED FLAG?
SETZM J$XTOP(J) ;YES
TXNE S,SUPFIL!SUPJOB ;IN SUPPRESS MODE?
TXNN S1,SUPRCH ;YES, IS THIS CHARACTER SUPPRESSABLE?
JRST (S1) ;DISPATCH THE CHARACTER NORMALLY
JRST DOSUP ;SUPPRESS THE CHARACTER
;HERE TO THROW AWAY A LINE
FLUSH7: PUSHJ P,INPBYT ;GET A BYTE
JUMPF .RETT ;RETURN ON EOF
PUSHJ P,ISEOL ;END OF LINE?
JUMPF FLUSH7 ;NO--LOOP FOR REST OF LINE
FLUSH8: PUSHJ P,INPBYT ;GET A BYTE
JUMPF .RETT ;RETURN ON EOF
PUSHJ P,ISEOL ;GOT EOL CHARACTER?
JUMPF LPTOUT ;NO, NEW LINE, DO THE MATCH
JRST FLUSH8 ;YES, LOOP AGAIN
ISEOL: CAIL C," " ;IS IT PRINTABLE?
$RETF ;YES, ITS NOT AN EOL
MOVE S1,CHTAB(C) ;NO, GET TABLE ENTRY
TXNN S1,EOLCHR ;IS IT AN EOL?
$RETF ;NO, JUST RETURN
TXO S,NEWLIN ;YES, SET NEW LINE
$RETT ;AND RETURN
;HERE ON A LINE FEED
DOLF: LOAD T1,.FPINF(E),FP.FSP ;GET SPACING PARAMETER
SETO S1, ;START WITH 1 LINE
DOLF1: SOJLE T1,CNTDWN ;ANY MORE?
MOVEI C,.CHLFD ;LOAD A LINE-FEED
PUSHJ P,DEVOUT ;YES--GIVE IT
SOJA S1,DOLF1 ;AND SUBTRACT FROM QUOTA
;HERE TO PROCESS A FORM FEED
DOFORM: SKIPE J$XTOP(J) ;SKIP IF NOT AT TOP OF FORM
POPJ P, ;DO NOT PRINT BLANK PAGES
MOVN S1,J$XPOS(J) ;THIS TAKES ALL WE HAVE ON PAGE
SKIPL S1 ;WAS VPOS NEGATIVE?
CLEAR S1, ;DONT CHARGE FOR ANYTHING THEN.
;THIS MIGHT GIVE THE USER A
;BONUS OF 1-3 FREE LINES.
JRST CNTDWN ;COUNT DOWN THE LIMIT
;HERE IF /PRINT:SUPPRESS
DOSUP: MOVEI C,.CHLFD ;MAKE IT A LINEFEED, REGARDLESS
SKIPE J$XTOP(J) ;SKIP IF NOT TOP
POPJ P, ;ONLY 1 LINE FEED IN A ROW
SETOM J$XTOP(J) ;AND SET TOP
SETO S1,
JRST CNTDWN ;CHARGE FOR THE LINE
;HERE TO DO ARROW MODE STUFF IF NEEDED
CHKARO: TXNN S,ARROW ;ARROW MODE?
JRST DEVOUT ;NO--JUST PRINT
DOARO: PUSH P,C ;SAVE C
MOVEI C,"^" ;LOAD A ^
PUSHJ P,DEVOUT ;PRINT THE ^
POP P,C ;RESTORE C
MOVEI C,100(C) ;MAKE INTO REAL LETTER
PJRST DEVOUT ;PRINT
;HERE ON A DC3
DODC3: SETOM S1 ;DC3 SKIPS 1 LINE
JRST CNTDWN ;AND COUNT DOWN
;HERE IF SPECIAL CHARACTER SKIPS A FRACTION OF A PAGE
DOFRAC: HLRZS S1 ;GET 0,,FRACTION
ANDI S1,777 ;AND OUT FLAGS
MOVE T1,J$FLIN(J) ;GET CURRENT PAGE SIZE
IDIVI T1,(S1) ;FIND THE RIGHT PART
MOVE T2,J$XPOS(J) ;GET CURRENT POSITION
SOJL T2,[MOVN S1,J$XPOS(J) ;COPY VPOS
SUBI S1,3 ;SUBTRACT 3
JRST CNTDWN] ;AND CHARGE HIM
IDIVI T2,(T1) ;GET RESIDUE MOD SKIPSIZE
MOVNI S1,1(T3) ;AND MAKE IT NEGATIVE
JRST CNTDWN ;GO CHECK QUOTA
SUBTTL CNTDWN - COUNT DOWN LINE FEEDS AND PAGE FEEDS
;CALL: S1/ Line Count Modifier
; C/ The Character Being Printed
;
;RET: TRUE ALWAYS
CNTDWN: CAIL C,12 ;MAKE SURE THIS IS A CARRIAGE CONTROL
CAILE C,24 ; CHARACTER.
PJRST DEVOUT ;IF NOT,,JUST DUMP IT OUT.
CAIN C,.CHFFD ;IS IT A FORM FEED ???
JRST CNTDW1 ;YES,,SKIP THIS.
ADDB S1,J$XPOS(J) ;REDUCE VERTICAL POSITION
JUMPG S1,DEVOUT ;JUMP IF STILL ON PAGE
CAIN C,23 ;WAS IT A DC3?
CAMG S1,[-3] ;YES, GIVE HIM 3 EXTRA LINES
JRST CNTDW1 ;OFF PAGE ANYWAY
PJRST DEVOUT ;HE WINS!!
CNTDW1: MOVE S1,J$FLIN(J) ;BACK TO TOP OF PAGE
MOVEM S1,J$XPOS(J) ;SAVE POSITION
SOSG J$FPIG(J) ;DECREMENT THE FORWARD SPACING COUNT.
TXZ S,FORWRD ;TURN OFF THE FORWARD SPACE BIT.
TXNE S,FORWRD ;FORWARD SPACING ???
JRST .+3 ;YES,,SKIP THIS
AOS J$APRT(J) ;NO,,ADD 1 TO TOTAL PAGES COUNTER
AOS J$RNPP(J) ;NO,,ADD 1 TO PAGES PER COPY COUNTER
;Here we keep track of where we are for backspaceing
MOVE S1,J$FCBC(J) ;GET NUMBER OF BYTES IN THIS BUFFER
SUB S1,J$DBCT(J) ;CALC BYT POS OF THIS PAGE IN THIS BUFR
ADD S1,J$FTBC(J) ;CALC BYT POS OF THIS PAGE IN THIS FILE
MOVEM S1,@J$FBPT(J) ;SAVE THE PAGE ADDRESS IN THE PAGE TABLE
AOS S1,J$FBPT(J) ;BUMP TO NEXT PAGE TABLE ENTRY
CAIG S1,J$FPAG+PAGSIZ(J) ;ARE WE AT THE END OF THE PAGE TABLE ???
JRST .+4 ;NO,,CONTINUE ON
TXO S,FBPTOV ;YES,,LITE PAGE TABLE OVERFLOW FLAG
MOVEI S1,J$FPAG(J) ;AND WRAP THE
MOVEM S1,J$FBPT(J) ; PAGE TABLE AROUND ITSELF
PUSH P,C ;SAVE THE CURRENT CHAR
PUSHJ P,CHKALN ;CHECK FOR ALIGNMENT
POP P,C ;RESTORE THE OLD CHARACTER
MOVEI S1,3 ;LOAD A 3
CAIN C,23 ;GET HERE VIA DC3?
ADDM S1,J$XPOS(J) ;YES, GIVE HIM 3 XTRA LINES
CAIE C,23 ;WAS IT A DC3
SETOM J$XTOP(J) ;NO, SET TOP OF FORM
MOVE S1,J$RLIM(J) ;GET LIMIT
SUB S1,J$APRT(J) ;GET AMOUNT PRINTED
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
TXNN S,ABORT+GOODBY ;ARE WE ON OUR WAY OUT OR
SKIPL S1 ; STILL UNDER QUOTA ???
PJRST DEVOUT ;YES,,PRINT THE POOR CHARACTER
GETLIM S1,.EQLIM(J),FLEA ;GET FORMS-LIMIT-EXCEED ACTION
CAIN S1,.STCAN ;SEE IF CANCEL
JRST CNTDW2 ;IT WAS, DO IT
CAIN S1,.STIGN ;SEE IF IGNORE
PJRST DEVOUT ;YES, PRINT THE CHARACTER AND RETURN
;DEFAULT TO ASK IF NOT IGNORE OR CANCEL
CNTDWX: MOVE S1,STREAM ;GET THE STREAM NUMBER
SETOM JOBCHK(S1) ;SAY WE WANT TO TAKE A CHECKPOINT
$WTOR (Page Limit Exceeded,<^R/.EQJBB(J)/^T/LIMSG/>,@JOBOBA(S1),JOBWAC(S1))
$DSCHD (PSF%OR) ;WAIT FOR OPERATOR RESPONSE
TXNE S,ABORT+RQB ;HAVE WE BEEN CANCELED OR REQUEUED ???
JRST CNTIGN ;YES,,IGNORE THE ERROR
MOVEI S1,LIMANS ;POINT TO THE LIMIT ANSWER BLOCK
HRROI S2,J$RESP(J) ;POINT TO THE ANSWER
PUSHJ P,S%TBLK ;DO WE MATCH ???
TXNE S2,TL%NOM+TL%AMB ;DID WE FIND IT OK ???
JRST CNTDWX ;NO,,STUPID OPERATOR SO TRY AGAIN
HRRZ S1,0(S1) ;GET THE ROUTINE ADDRESS
JRST 0(S1) ;AND PROCESS THE RESPONSE
;IF ANSWER WAS 'IGNORE' COME HERE
CNTIGN: MOVX S1,.STIGN ;YES,,GET THE IGNORE BITS
STOLIM S1,.EQLIM(J),FLEA ;SAVE IT AS NEW LIMIT EX ACTION
PJRST DEVOUT ;GO DUMP THE BUFFERS
;IF ANSWER WAS 'ABORT' COME HERE
CNTDWC: MOVE S1,STREAM ;GET THE STREAM NUMBER
$WTO (Aborting,<^R/.EQJBB(J)/>,@JOBOBA(S1)) ;TELL THE OPERATOR
CNTDW2: $TEXT(LOGCHR,<^I/LPERR/Page Limit Exceeded>)
SETZM J$XTOP(J) ;CLEAR TOP-OF-FORM FLAG
PUSHJ P,SENDFF ;SEND A FORM FEED
TXO S,ABORT ;LIGHT THE ABORT BIT
PJRST INPFEF ;YES,,FORCE AN EOF
LIMANS: 2,,2
[ASCIZ/ABORT/],,CNTDWC ;ABORT ENTRY
[ASCIZ/IGNORE/],,CNTIGN ;IGNORE ENTRY
;SUBROUTINE TO OUTPUT ONE CHAR ON SELECTED DEVICE
;CALL WITH:
; PUSHJ P,DEVOUT
; RETURN HERE (HALTS IF ERROR)
;
DEVOUT: TXNE S,FORWRD ;ARE WE FORWRD SPACING ???
POPJ P, ;YES,,RETURN.
DEVO.0: SOSGE J$LBCT(J) ;DECREMENT THE BYTE COUT
JRST DEVO.1 ;LOSE, GO DUMP THE BUFFER
IDPB C,J$LBPT(J) ;DEPOSIT A BYTE
POPJ P, ;AND RETURN
DEVO.1: PUSH P,S1 ;SAVE S1
PUSHJ P,OUTOUT ;DUMP THE BUFFER
POP P,S1 ;RESTORE S1
JRST DEVO.0 ;AND TRY AGAIN
;SENDFF - ROUTINE TO SEND A FF IF J$XTOP IS OFF
;
SENDFF: MOVEI C,.CHFFD ;LOAD A FF
SKIPN J$XTOP(J) ;SKIP IF ALREADY AT TOP
PUSHJ P,DEVOUT ;NO, SEND IT
SETOM J$XTOP(J) ;SET THE FLAG
POPJ P, ;RETURN
CHKALN: SKIPL J$APRG(J) ;IS AN ALIGNMENT SCHEDULED ???
POPJ P, ;NO,,RETURN.
PUSHJ P,ALIGN ;YES,,THEN DO IT.
$RETT ;RETURN TO HIS CALLER.
SUBTTL Subroutines to send messages to the output device
;Since output to the output-device is interruptable $TEXT calls which
; send characters directly to the device cannot be done.
;
;A per-context buffer (J$XTBF) is defined to store $TEXT'ed characters
; in and the following set of subroutines exist to initialize,
; deposit characters in, and dump this buffer to the output device.
;TBFINI initializes the byte-pointer to J$XTBF
TBFINI: MOVEI S1,J$XTBF(J) ;GET THE ADDRESS OF THE BUFFER
HRLI S1,(POINT 7,0) ;MAKE IT A BYTE POINTER
MOVEM S1,J$XTBP(J) ;STORE IT
MOVEI S2,0 ;LOAD A NULL
IDPB S2,S1 ;AND INITIALIZE THE BUFFER
$RETT ;AND RETURN
;TBFCHR is the $TEXT subroutine to deposit characters in the text buffer.
TBFCHR: IDPB S1,J$XTBP(J) ;DEPOSIT THE CHARACTER
$RETT ;RETURN
;TBFDMP dumps the text buffer to output device and re-initializes the buffer
TBFDMP: SETZ S1, ;CLEAR THE AC
IDPB S1,J$XTBP(J) ;DEPOSIT THE BYTE
MOVEI S1,J$XTBF(J) ;GET ADDRESS OF BUFFER
PUSHJ P,BFRDMP ;DUMP THE BUFFER
PJRST TBFINI ;RE-INIT THE BUFFER AND RETURN
;STGOUT is included to allow dumping of any arbitrary buffer of characters
; Call with S1 containing either a byte pointer or the address of the buffer
STGOUT: PUSH P,S1 ;SAVE S1
PUSHJ P,TBFDMP ;FORCE ANY BUFFERED STUFF OUT
POP P,S1 ;RESTORE S1
;AND FALL INTO BFRDMP
;BFRDMP to dump the buffer pointed to by S1
BFRDMP: PUSHJ P,.SAVE1 ;SAVE P1
MOVE P1,S1 ;PUT THE POINTER IN P1
TLNN P1,-1 ;IS LEFT HALF ZERO
HRLI P1,(POINT 7,0) ;YES, MAKE IT A BYTE POINTER
BFRD.1: ILDB C,P1 ;GET A CHARACTER
JUMPE C,.RETT ;RETURN WHEN DONE
SETZM J$XTOP(J) ;CLEAR THE TOP-OF-FORM FLAG
CAIN C,.CHFFD ;IS IT A FORMFEED?
SETOM J$XTOP(J) ;YES, SET IT
PUSHJ P,DEVOUT ;OUTPUT THE CHARACTER
JRST BFRD.1 ;AND LOOP
SUBTTL ROUTINES TO GENERATE HEADERS AND TRAILERS
;JOB HEADERS AND TRAILERS
JOBTRL: MOVEI T4,[ASCIZ /END/] ;ADDRESS OF END TEXT
TXNE S,RQB ;CLEAR REQUE AND SKIP IF NOT SET
MOVEI T4,[ASCIZ /REQUE/] ;SAY SO
PUSHJ P,GIVHDR ;GO SETUP THE LINE
JRST TRAILR ;AND NOW GO PRINT THE TRAILER
JOBHDR: MOVEI T4,LPTERR ;ALLOW FOR LPT ERRORS HERE
MOVEM T4,J$LERR(J) ;STORE COUNTER
MOVEI T4,[ASCIZ /START/] ;ADDRESS OF START TEXT
PUSHJ P,GIVHDR ;GO SET THE LINE
JRST BANNER ;AND GO PRINT THE BANNER PAGES
GIVHDR: $TEXT (<-1,,J$XHBF(J)>,<^T7C*/0(T4)/ ^R/.EQJBB(J)/ ^I/DATMON/^0>)
MOVE S1,J$FWID(J) ;GET THE PAGE WIDTH
IDIVI S1,5 ;GET WORDS/BYTES TO THE END OF THE LINE
ADDI S1,J$XHBF(J) ;POINT TO THE LOGICAL END OF THE LINE
LOAD S2,PTRS(S2) ;GET BYTE PTR FOR END OF LINE
SETZM T1 ;GET A NULL BYTE
IDPB T1,S2 ;CUT THE HEADER OFF HERE !!!
$RETT ;RETURN.
PTRS: POINT 7,0(S1)
POINT 7,0(S1),6
POINT 7,0(S1),13
POINT 7,0(S1),20
POINT 7,0(S1),27
POINT 7,0(S1),34
SUBTTL BANNER -- Routine to print a banner
BANNER: PUSHJ P,.SAVE3 ;SAVE P1 THRU P3
SKIPN P3,J$FBAN(J) ;GET NUMBER OF BANNER PAGES
POPJ P, ;RETURN WHEN DONE
TOPS10 <
$TEXT(<-1,,J$PUSR(J)>,<^W6/.EQOWN(J)/^W/.EQOWN+1(J)/^0>)
> ;END TOPS10 CONDITIONAL
TOPS20 <
$TEXT(<-1,,J$PUSR(J)>,<^T/.EQOWN(J)/^0>)
> ;END TOPS20 CONDITIONAL
BANN.1: PUSHJ P,SENDFF ;SEND A FORM FEED
SETZM J$XPOS(J) ;AND SET 0 POSITION
MOVEI T1,4 ;LOAD AN OFFSET
CAIN P3,1 ;IS THIS THE LAST BANNER?
ADDM T1,J$XPOS(J) ;YES, DON'T PRINT OVER CREASE
PUSHJ P,BANN.2 ;PRINT A BANNER PAGE
SOJG P3,BANN.1 ;AND LOOP
POPJ P, ;RETURN
BANN.2: PUSHJ P,PLPBUF ;PRINT A LINE
PUSHJ P,PLPBUF ;PRINT ANOTHER LINE
PUSHJ P,CRLF ;TYPE A CRLF
MOVEI S1,1 ;LOAD THE BLOCKSIZE
MOVEI S2,J$PUSR(J) ;AND THE STRING ADDRESS
PUSHJ P,PICTUR ;AND PRINT A PICTURE
MOVEI T1,^D12 ;COUNT'EM
ADDM T1,J$XPOS(J) ;...
PUSHJ P,PLPBUF ;PRINT A LINE
PUSHJ P,PLPBUF ;AND ANOTHER
PUSHJ P,PLPBUF ;AND A THIRD
MOVEI T1,[0,,0] ;LOAD A NULL.
MOVE S1,J$FWCL(J) ;GET THE WIDTH CLASS
CAIN S1,3 ;ROOM ENOUGH FOR THE TITLE?
MOVEI T1,[ASCIZ /Note:/] ;YES, LOAD IT
GETLIM T2,.EQLIM(J),NOT1 ;GET FIRST HALF OF NOTE
JUMPE T2,PLINES ;NO NOTE, FINISH THE PAGE
GETLIM T3,.EQLIM(J),NOT2 ;AND THE SECOND HALF
$TEXT(<-1,,J$PNOT(J)>,<^T/0(T1)/^W6/T2/^W/T3/^0>)
MOVEI S1,1 ;GET THE BLOCKSIZE
MOVEI S2,J$PNOT(J) ;GET THE ADDRESS
PUSHJ P,PICTUR ;AND SEND IT OUT
MOVEI S1,^D11 ;LOAD NUMBER OF LINES
ADDM S1,J$XPOS(J) ;AND MOVE DOWN THE PAGE
PJRST PLINES ;GO TO EOP AND RETURN
SUBTTL TRAILR -- Routine to Print a Trailer
TRAILR: PUSHJ P,.SAVE3 ;SAVE P1 - P3
MOVE P3,J$FTRA(J) ;AND THE NUMBER OF TRAILERS
JUMPE P3,OUTDMP ;RETURN IF ZERO
TRAI.1: PUSHJ P,SENDFF ;SEND A FORMFEED
SETZM J$XPOS(J) ;CLEAR THE VERTICAL POSITION
PUSHJ P,TRAI.3 ;PRINT THE INTERNAL LOG
PUSHJ P,PLINES ;PRINT TILL END OF PAGE
SOJG P3,TRAI.1 ;LOOP UNTIL DONE
PJRST OUTDMP ;AND DUMP BUFFERS AND RETURN
;HERE TO PRINT THE INTERNAL LOG
TRAI.3: SKIPN J$GNLN(J) ;ANYTHING IN THE INTERNAL LOG?
POPJ P, ;NO, RETURN
PUSHJ P,PLPBUF ;YES, PRINT A LINE
PUSHJ P,PLPBUF ;AND ANOTHER LINE
MOVEI C,.CHTAB ;LOAD A TAB
MOVE T1,J$FWCL(J) ;GET THE WIDTH CLASS
PUSHJ P,DEVOUT ;PRINT A TAB
SOJG T1,.-1 ;PRINT N OF THEM
MOVEI S1,[ASCIZ /* * * L P T S P L R u n L o g * * *
/]
PUSHJ P,STGOUT ;AND DUMP IT
MOVE T2,J ;COPY OVER J
MOVE T3,J$GINP(J) ;GET NUMBER OF PAGES
TRAI.4: MOVE S1,J$GBUF(T2) ;GET ADR OF BUFFER
PUSHJ P,STGOUT ;AND DUMP IT OUT
MOVE S1,J$GBUF(T2) ;GET THE PAGE ADDRESS
CAME T2,J ;SKIP IF THIS IS THE PRE-ALLOCATED PAGE
PUSHJ P,M%RPAG ;AND RELEASE IT
CAMN T2,J ;SKIP IF THIS IS NOT PRE-ALLOC PAGE
PUSHJ P,.ZPAGA ;ZERO IT THEN
SOSLE T3 ;DECREMENT COUNT
AOJA T2,TRAI.4 ;AND LOOP IF NOT DONE
PUSHJ P,CRLF ;PRINT 1 CRLF
PUSHJ P,CRLF ;AND ANOTHER
PUSHJ P,CRLF ;AND ANOTHER
MOVE T1,J$GNLN(J) ;GET NUMBER OF LOG LINES
ADDI T1,4 ;ADD IN THE OVERHEAD
ADD T1,J$XPOS(J) ;AND ACCUMULATE VERTICAL POSITION
IDIV T1,J$FLIN(J) ;DID WE OVERFLW A PAGE?
MOVEM T2,J$XPOS(J) ;SAVE CURRENT POSITION
SETZM J$GNLN(J) ;AND DON'T PRINT IT AGAIN
SUB P3,T1 ;REDUCE PAGES TO PRINT
POPJ P, ;AND RETURN
SUBTTL - UTILITY ROUTINES
PLPBUF: MOVEI S1,J$XHBF(J) ;GET ADDRESS OF THE LINE
PUSHJ P,STGOUT ;AND DUMP IT
PUSHJ P,CR23 ;END THE LINE WITH A CR23
PUSHJ P,CR23 ;PRINT A CR23
PUSHJ P,CR23 ;AND ANOTHER
PUSHJ P,CR23 ;AND ANOTHER
MOVEI S1,4 ;WE PRINT 4 LINES
ADDM S1,J$XPOS(J) ;ADD TO COUNT
POPJ P,
PLINES: MOVE T2,J$FLIN(J) ;GET LINES/PAGE
ADDI T2,1 ;ACCOUNT FOR MARGIN
SUB T2,J$XPOS(J) ;SUBTRACT AMOUNT PRINTED
JUMPLE T2,PEOP ;JUMP IF DONE
IDIVI T2,4 ;ELSE GET NUMBER OF LINES TO PRINT
PLINE1: SOJL T2,PEOP ;JUMP IF DONE
PUSHJ P,PLPBUF ;PRINT A LINE (4 LINES)
JRST PLINE1 ;AND LOOP
PEOP: MOVE T2,J$FLIN(J) ;GET NUMBER OF LINES/PAGE
SUB T2,J$XPOS(J) ;SUBTRACT THOSE PRINTED
ADDI T2,1 ;COUNT THE MARGIN
PEOP1: JUMPLE T2,PEOP2 ;GO FINISH OFF
PUSHJ P,CR23 ;PRINT A CR23
SOJA T2,PEOP1 ;AND LOOP
PEOP2: MOVEI S1,STARS ;LOAD ADDRESS OF STRING
PUSHJ P,STGOUT ;AND SEND TO THE PRINTER
POPJ P, ;AND RETURN
CR23: SKIPE J$MTAP(J) ;SPOOLING TO TAPE ???
JRST CRLF ;YES,,JUST INSERT CRLF
MOVEI S1,[BYTE (7) 15,23,0,0,0] ;PRINT OUT CR23
SKIPA ;SKIP CRLF ENTRY POINT
CRLF: MOVEI S1,[BYTE (7) 15,12,0,0,0] ;PRINT AT CRLF
PUSHJ P,STGOUT ;PUT IT OUT
$RET ;AND RETURN
SUBTTL HEAD -- Generate File-header pages
HEAD: PUSHJ P,.SAVE3 ;SAVE SOME ACS
PUSHJ P,SENDFF ;SEND A FORMFEED
LOAD P1,.FPINF(E),FP.NFH ;GET THE NO HEADER BIT
SKIPN P1 ;SKIP IF WE DON'T WANT HEADERS
SKIPN P3,J$FHEA(J) ;GET NUMBER OF PICTURE PAGES
PJRST OUTDMP ;DUMP BUFFERS AND RETURN
PUSHJ P,SETHDR ;SETUP THE FILENAME FOR BLOCK LETTERS
PUSHJ P,HEAD.1 ;PRINT THE HEADER
SOJG P3,.-1 ;LOOP FOR THE WHOLE WORKS
PJRST OUTDMP ;FORCE EVERYTHING OUT, AND RETURN
HEAD.1: MOVE S1,J$PFLS(J) ;GET BLOCKSIZE
MOVEI S2,J$PFL1(J) ;AND ADDRESS OF FIRST LINE
PUSHJ P,PICTUR ;PRINT THE LINE
MOVE S1,J$PFLS(J) ;GET BLOCKSIZE
MOVEI S2,J$PFL2(J) ;AND ADDRESS OF SECOND LINE
PUSHJ P,PICTUR ;AND PRINT THE SECOND LINE
MOVE P1,J$FWCL(J) ;LOAD THE WIDTH CLASS
MOVEI S1,J$XHBF(J) ;LOAD ADDRESS OF BANNER LINE
PUSHJ P,STGOUT ;AND SEND IT
MOVE S1,J$DIFN(J) ;GET THE IFN
MOVX S2,FI.CRE ;WANT CREATION TIME
PUSHJ P,F%INFO ;GET IT
MOVEI S2,[ASCIZ /, /] ;GET A STRING
CAIE P1,3 ;WIDTH CLASS 3?
MOVEI S2,[BYTE (7) .CHCRT,.CHLFD,.CHTAB,0]
$TEXT(TBFCHR,<^M^JFile ^F/@J$DFDA(J)/, created: ^H/S1/^T/(S2)/printed: ^H/[-1]/>)
PUSHJ P,TBFDMP ;AND DUMP THE BUFFER
GETLIM S1,.EQLIM(J),FORM ;GET FORMS NAME
$TEXT(TBFCHR,<Job parameters: Request created:^H/.EQAFT(J)/ Page limit:^D/J$RLIM(J)/ Forms:^W/S1/ Account:^T/.EQACT(J)/^A>)
GETLIM S1,.EQLIM(J),NOT1 ;GET FIRST HALF OF NOTE
GETLIM S2,.EQLIM(J),NOT2 ;GET SECOND HALF OF NOTE
SKIPE S1 ;IS THERE A NOTE?
$TEXT(TBFCHR,< Note:^W6/S1/^W/S2/^A>)
PUSHJ P,CRLF ;END THE LINE
PUSHJ P,TBFDMP ;AND DUMP IT
LOAD S1,.FPINF(E),FP.FSP ;GET /SPACING
LOAD S2,.FPINF(E),FP.FCY ;GET THE TOTAL COPY COUNT
LOAD T1,J$RNCP(J) ;GET THE COPIES DONE SO FAR
ADDI T1,1 ;MAKE THIS THE CURRENT COPY
$TEXT(TBFCHR,<File parameters: Copy: ^D/T1/ of ^D/S2/ Spacing:^W/SPCTAB-1(S1)/^A>)
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
PUSHJ P,TBFDMP ;SEND THE LINE
LOAD S1,.FPINF(E),FP.FPF ;GET /PRINT
LOAD S2,.FPINF(E),FP.FFF ;GET /FILE
CAXN S2,.FPF8B ;/FILE:8-BIT?
MOVEI S2,4 ;YES, RECORD THE VALUE
CAXN S2,.FPF11 ;/FILE:ELEVEN?
MOVEI S2,5 ;YES,,RECODE THE VALUE
$TEXT(TBFCHR,< File format:^W/FFMTAB-1(S2)/ Print mode:^W/FMTAB-1(S1)/^A>)
LOAD S1,.FPINF(E),FP.DEL ;GET /DELETE BIT
SKIPE S1 ;IS IT SET?
$TEXT(TBFCHR,< /DELETE^A>) ;YES,,SAY SO
PUSHJ P,CRLF ;END THE LINE
MOVE S1,J$FPIG(J) ;GET STARTING PAGE
CAILE S1,1 ;SKIP IF 0 OR 1
$TEXT(TBFCHR,<^M^JPrinting will start at page ^D/J$FPIG(J)/>)
PUSHJ P,TBFDMP ;DUMP THE BUFFER
PJRST SENDFF ;SEND A FORM FEED
FMTAB: SIXBIT /ARROW/
SIXBIT /ASCII/
SIXBIT /OCTAL/
SIXBIT /SUPRES/
FFMTAB: SIXBIT /ASCII/
SIXBIT /FORT/
SIXBIT /COBOL/
SIXBIT /8-BIT/
SIXBIT /ELEVEN/
SPCTAB: SIXBIT /SINGLE/
SIXBIT /DOUBLE/
SIXBIT /TRIPLE/
SUBTTL SETHDR -- Setup header name for file
;SETHDR is called to setup the strings to be used for the two lines of
; block letters on the file header pages.
;
;Call: E/ address of the file's FP
;
;T Ret: always
SETHDR: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
SETZM J$PFL1+1(J) ;CLEAR THE 2ND WORD OF FIRST BUFFER
SETZM J$PFL2+1(J) ; AND 2ND BUFFER, (SEE SETH.W)
SKIPN .FPFR1(E) ;IS THERE A /REPORT KEY?
JRST SETH.1 ;NO, CONTINUE ON
$TEXT(<-1,,J$PFL1(J)>,<Report:^0>) ;FIRST LINE
$TEXT(<-1,,J$PFL2(J)>,< ^W6/.FPFR1(E)/^W/.FPFR2(E)/^0>)
JRST SETH.W ;SET BLOCKSIZE AND RETURN
SETH.1: LOAD S1,.FPINF(E) ;GET FLAGS FOR FILE
TXNN S1,FP.SPL ;IS IT A SPOOLED FILE?
JRST SETH.3 ;NO, CONTINUE ON
TXNN S1,FP.FLG ;YES, IS IT ALSO THE LOG FILE?
JRST SETH.2 ;NO, JUST A PLAIN SPOOLED FILE
$TEXT(<-1,,J$PFL1(J)>,<Batch^0>) ;SPOOLED LOGS HAVE NO REASONABLE NAME
$TEXT(<-1,,J$PFL2(J)>,< Log File^0>) ;SO USE SOMETHING DESCRIPTIVE
JRST SETH.W ;AND FINISH UP
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
TOPS20 <
SETH.2:
SETH.3: MOVE P1,[POINT 7,J$PFL1(J)] ;GET THE FILENAME BYTE PTR
MOVE P2,[POINT 7,J$PFL2(J)] ;GET THE EXTEN BYTE PTR
MOVX S1,GJ%SHT!GJ%OFG ;PARSE-ONLY + SHORT-GTJFN
MOVE S2,J$DFDA(J) ;GET THE FD ADDRESS
HRROI S2,.FDFIL(S2) ;AND POINT TO THE FILESPEC
GTJFN ;GET A JFN FOR THE FILE
ERJMP SETH.S ;ERROR,,GIVE NON-DESCRIPT NAME
EXCH S1,P1 ;SAVE JFN IN P1, GET POINTER IN S1
MOVE S2,P1 ;GET JFN IN S2
MOVX T1,1B8 ;FILENAME ONLY
JFNS ;GET IT
MOVE S1,P2 ;GET THE 2ND LINE POINTER
MOVE S2,P1 ;GET THE JFN
MOVX T1,1B11 ;EXTENSION ONLY
JFNS ;GET THE EXTENSION
MOVEI T2,"." ;FIRST, LOAD A BLANK
IDPB T2,S1 ;AND DEPOSIT IT
MOVX T1,1B14 ;GET THE GENERATION NUMBER
JFNS ;DO IT!!
MOVE S1,P1 ;GET THE JFN
RLJFN ;RELEASE IT
ERJMP .+1 ;IGNORE THE ERROR
LOAD S1,.FPINF(E),FP.SPL ;GET THE SPOOL BIT
JUMPE S1,SETH.W ;IF NOT SPOOLED, THERE WE'RE DONE
MOVE P1,[POINT 7,J$PFL1(J)] ;RESTORE THE FILENAME BYTE PTR.
MOVEI S1,3 ;HOW MANY DASHES TO LOOK FOR
MOVE S2,P1 ;AND AN INPUT POINTER
SETH.4: ILDB T1,S2 ;GET A CHARACTER
JUMPE T1,SETH.S ;NO, SPOOLED NAME IF NULL
CAIE T1,"-" ;A DASH?
JRST SETH.4 ;NO, LOOP
SOJG S1,SETH.4 ;YES, LOOP UNTIL 4TH FIELD
MOVE S1,P1 ;GET A NEW POINTER TO SET DOWN CHARS
SETH.5: ILDB T1,S2 ;GET A CHARACTER
IDPB T1,S1 ;DEPOSIT IT
JUMPN T1,SETH.5 ;AND LOOP UNTIL A NULL
MOVEI S2,6 ;LOAD A COUNTER
IDPB T1,S1 ;AND DEPOSIT MORE NULLS
SOJG S2,.-1 ;FOR WIDTH CALCULATION
MOVE T1,J$PFL1(J) ;GET THE FIRST WORD ON 1ST LINE
TLNN T1,774000 ;IS THERE AT LEAST ONE CHARACTER?
JRST SETH.S ;NO, NO NAME
JRST SETH.W ;YES, FILL IN WIDTH AND RETURN
> ;END TOPS20 CONDITIONAL
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
TOPS10 <
SETH.2: MOVE S1,J$DIFN(J) ;GET THE FILE'S IFN
MOVX S2,FI.SPL ;GET THE SPOOL NAME INFO CODE
PUSHJ P,F%INFO ;GET THE SPOOLED NAME (.RBSPL)
JUMPE S1,SETH.S ;NO SPOOLED NAME
$TEXT(<-1,,J$PFL1(J)>,<^W/S1/^0>) ;GENERATE THE SPOOLED NAME
SETZM J$PFL2(J) ;AND NO EXTENSION
JRST SETH.W ;AND FINISH UP
SETH.3: MOVE P1,J$DFDA(J) ;GET THE FD ADDRESS
$TEXT(<-1,,J$PFL1(J)>,<^W/.FDNAM(P1)/^0>)
$TEXT(<-1,,J$PFL2(J)>,<^W3/.FDEXT(P1)/^0>)
JRST SETH.W ;FINISH UP AND RETURN
> ;END TOPS10 CONDITIONAL
;COMMON SUBROUTINES
;SETH.S is used to setup a non-descript name if we can't do any better
SETH.S: $TEXT(<-1,,J$PFL1(J)>,<Spooled^0>)
$TEXT(<-1,,J$PFL2(J)>,< Printer File^0>)
;AND FALL INTO SETH.W
;SETH.W is called to figure out the blocksize to use, set it, and return.
; If both lines are 6 characters or less, the current width-class is
; used as the blocksize, else, blocksize of 1 is used.
SETH.W: MOVE S1,J$FWCL(J) ;GET THE WIDTH CLASS
MOVE S2,J$PFL1+1(J) ;GET 2ND WORD OF LINE 1
IOR S2,J$PFL2+1(J) ;OR IN SECOND WORD OF LINE 2
TLNE S2,003760 ;IS THE 7TH CHARACTER THERE IN EITHER?
MOVEI S1,1 ;YES, USE BLOCKSIZE 1
MOVEM S1,J$PFLS(J) ;SAVE IT
$RETT ;AND RETURN
SUBTTL PICTUR -- Routine to print block letters
;Call: S1/ blocksize of letters
; S2/ pointer to string (left half can be 0 or byte-pointer)
PICTUR: PUSHJ P,.SAVE3 ;SAVE P1 THRU P3
PUSHJ P,.SAVET ;AND SAVE T1 THRU T4
DMOVE P1,S1 ;SAVE THE INPUT ARGUMENTS
MOVNI P3,^D35 ;GET A BIT COUNTER
PICT.1: MOVE T4,P1 ;COPY OVER THE BLOCK SIZE
PUSHJ P,PICT.2 ;PRINT A LINE
SOJG T4,.-1 ;AND DO IT "BLOCKSIZE" TIMES
ADDI P3,5 ;BUMP TO NEXT SEGMENT OF CHARACTER
JUMPL P3,PICT.1 ;AND LOOP FOR NEXT SEGMENT
MOVEI S1,[BYTE (7) 15,12,12,12,12,0,0]
PJRST STGOUT ;SEND FOUR BLANK LINES AND RETURN
;HERE TO PRINT ONE LINE OF THE CURRENT SEGMENT
PICT.2: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
PUSH P,T4 ;SAVE T4
TLNN P2,-1 ;MAKE SURE ITS A BYTE POINTER
HRLI P2,(POINT 7,0) ;MAKE IT ONE
MOVE T2,J$FWID(J) ;GET LINEWIDTH
IDIV T2,[EXP 7,^D14,^D21]-1(P1) ;AND DIVIDE BY CHARACTER SIZE
MOVE T4,T2 ;SAVE MAX NUMBER OF CHARS/LINE
PICT.3: ILDB T2,P2 ;GET A CHARACTER
JUMPE T2,PICT.6 ;LAST CHARACTER, DONE
CAIGE T2,40 ;MUST BE GREATER THEN ' '
JRST PICT.3 ;ELSE GET THE NEXT CHAR
MOVE T1,CHRTAB-40(T2) ;GET THE WORD FROM THE TABLE
ROT T1,^D35(P3) ;POSITION TO CORRECT SEGMENT
TLZ T1,017777 ;ZERO BITS FOR SPACE BETWEEN CHARS
MOVEI T3,7 ;PRINT 5 CHARS + 2 SPACES
PICT.4: MOVEI C," " ;LOAD A SPACE
TLNE T1,(1B0) ;SEE IF HIGH BIT IS ONE
LDB C,P2 ;IT IS, GET THE CHARACTER
CAIN C,":" ;IS IT A COLON ???
MOVEI C,"#" ;MAKE IT A # SIGN.
PUSHJ P,PICT.5 ;PRINT IT THE CORRECT NUMBER OF TIMES
ROT T1,1 ;ROTATE WORD 1 BIT
SOJG T3,PICT.4 ;AND LOOP THE CORRECT NUMBER OF TIMES
SOJG T4,PICT.3 ;AND GET THE NEXT CHARACTER
JRST PICT.6 ;NO MORE ROOM, DONE
PICT.5: MOVE T2,P1 ;GET THE BLOCKSIZE
PUSHJ P,DEVOUT ;PRINT IT
SOJG T2,.-1 ;LOOP
POPJ P, ;AND RETURN
PICT.6: POP P,T4 ;RESTORE T4
PJRST CRLF ;TYPE A CR AND RETURN
CHRTAB: BYTE (5) 00,00,00,00,00,00,00 ;SP
BYTE (5) 04,04,04,04,04,00,04 ;!
BYTE (5) 12,12,00,00,00,00,00 ;"
BYTE (5) 12,12,37,12,37,12,12 ;#
BYTE (5) 04,37,24,37,05,37,04 ;$
BYTE (5) 31,31,02,04,10,23,23 ;%
BYTE (5) 10,24,10,24,23,22,15 ;&
BYTE (5) 06,02,00,00,00,00,00 ;'
BYTE (5) 04,10,20,20,20,10,04 ;(
BYTE (5) 04,02,01,01,01,02,04 ;)
BYTE (5) 00,25,16,33,16,25,00 ;*
BYTE (5) 00,04,04,37,04,04,00 ;+
BYTE (5) 00,00,00,00,00,06,02 ;,
BYTE (5) 00,00,00,37,00,00,00 ;-
BYTE (5) 00,00,00,00,00,06,06 ;.
BYTE (5) 00,00,01,02,04,10,20 ;/
BYTE (5) 16,21,23,25,31,21,16 ;0
BYTE (5) 04,14,04,04,04,04,16 ;1
BYTE (5) 16,21,01,02,04,10,37 ;2
BYTE (5) 16,21,01,02,01,21,16 ;3
BYTE (5) 22,22,22,37,02,02,02 ;4
BYTE (5) 37,20,34,02,01,21,16 ;5
BYTE (5) 16,20,20,36,21,21,16 ;6
BYTE (5) 37,01,01,02,04,10,20 ;7
BYTE (5) 16,21,21,16,21,21,16 ;8
BYTE (5) 16,21,21,17,01,01,16 ;9
BYTE (5) 00,00,06,06,00,06,06 ;:
BYTE (5) 00,06,06,00,06,06,02 ;;
BYTE (5) 02,04,10,20,10,04,02 ;<
BYTE (5) 00,00,37,00,37,00,00 ;=
BYTE (5) 10,04,02,01,02,04,10 ;>
BYTE (5) 16,21,01,02,04,00,04 ;?
BYTE (5) 16,21,21,27,25,25,07 ;@
BYTE (5) 16,21,21,21,37,21,21 ;A
BYTE (5) 36,21,21,36,21,21,36 ;B
BYTE (5) 17,20,20,20,20,20,17 ;C
BYTE (5) 36,21,21,21,21,21,36 ;D
BYTE (5) 37,20,20,36,20,20,37 ;E
BYTE (5) 37,20,20,36,20,20,20 ;F
BYTE (5) 17,20,20,20,27,21,16 ;G
BYTE (5) 21,21,21,37,21,21,21 ;H
BYTE (5) 16,04,04,04,04,04,16 ;I
BYTE (5) 01,01,01,01,21,21,16 ;J
BYTE (5) 21,21,22,34,22,21,21 ;K
BYTE (5) 20,20,20,20,20,20,37 ;L
BYTE (5) 21,33,25,21,21,21,21 ;M
BYTE (5) 21,21,31,25,23,21,21 ;N
BYTE (5) 16,21,21,21,21,21,16 ;O
BYTE (5) 36,21,21,36,20,20,20 ;P
BYTE (5) 16,21,21,21,25,22,15 ;Q
BYTE (5) 36,21,21,36,24,22,21 ;R
BYTE (5) 17,20,20,16,01,01,36 ;S
BYTE (5) 37,04,04,04,04,04,04 ;T
BYTE (5) 21,21,21,21,21,21,37 ;U
BYTE (5) 21,21,21,21,21,12,04 ;V
BYTE (5) 21,21,21,21,25,33,21 ;W
BYTE (5) 21,21,12,04,12,21,21 ;X
BYTE (5) 21,21,12,04,04,04,04 ;Y
BYTE (5) 37,01,02,04,10,20,37 ;Z
BYTE (5) 14,10,10,10,10,10,14 ;[
BYTE (5) 00,00,20,10,04,02,01 ;\
BYTE (5) 06,02,02,02,02,02,06 ;]
BYTE (5) 04,12,21,00,00,00,00 ;^
BYTE (5) 00,00,00,00,00,00,37 ;_
BYTE (5) 14,10,00,00,00,00,00 ;ACCENT GRAVE
BYTE (5) 00,00,36,01,17,21,17 ;LC A
BYTE (5) 20,20,20,36,21,21,36 ;LC B
BYTE (5) 00,00,17,20,20,20,17 ;LC C
BYTE (5) 01,01,01,17,21,21,17 ;LC D
BYTE (5) 00,00,16,21,36,20,17 ;LC E
BYTE (5) 16,21,20,34,20,20,20 ;LC F
BYTE (5) 00,00,16,21,17,01,37 ;LC G
BYTE (5) 20,20,20,36,21,21,21 ;LC H
BYTE (5) 00,04,00,04,04,04,04 ;LC I
BYTE (5) 00,04,00,04,04,24,10 ;LC J
BYTE (5) 20,22,22,24,30,24,22 ;LC K
BYTE (5) 04,04,04,04,04,04,04 ;LC L
BYTE (5) 00,00,24,37,25,25,25 ;LC M
BYTE (5) 00,00,20,36,21,21,21 ;LC N
BYTE (5) 00,00,16,21,21,21,16 ;LC O
BYTE (5) 00,00,36,21,36,20,20 ;LC P
BYTE (5) 00,00,17,21,17,01,01 ;LC Q
BYTE (5) 00,00,26,31,20,20,20 ;LC R
BYTE (5) 00,00,17,20,16,01,36 ;LC S
BYTE (5) 00,10,34,10,10,10,06 ;LC T
BYTE (5) 00,00,21,21,21,21,16 ;LC U
BYTE (5) 00,00,21,21,12,12,04 ;LC V
BYTE (5) 00,00,21,21,25,25,12 ;LC W
BYTE (5) 00,00,21,12,04,12,21 ;LC X
BYTE (5) 00,00,21,12,04,04,30 ;LC Y
BYTE (5) 00,00,37,02,04,10,37 ;LC Z
BYTE (5) 04,10,10,20,10,10,04 ;OPEN BRACE
BYTE (5) 04,04,04,00,04,04,04 ;VERTICAL BAR
BYTE (5) 04,02,02,01,02,02,04 ;CLOSE BRACE
BYTE (5) 00,10,25,02,00,00,00 ;TILDE
BYTE (5) 00,00,00,00,00,00,00 ;RUBOUT
SUBTTL SYSTEM INITIALIZATION FUNCTIONS
TOPS10 <
OPDINI: MOVEI T3,4 ;NUMBER OF WORDS IN SYSNAM - 1
MOVS T1,[%CNFG0] ;ADR OF FIRST WORD
GETSYN: MOVS T2,T1 ;GET THE GETTAB ADR
GETTAB T2, ;GET THE WORD
JFCL ;IGNORE THIS
MOVEM T2,LPCNF(T1) ;SAVE NAME
CAILE T3,(T1) ;DONE?
AOJA T1,GETSYN ;NO, LOOP
PUSHJ P,I%HOST ;GET THE HOST NAME AND NUMBER
MOVEM S2,CNTSTA ;SAVE THE NUMBER
MOVX T3,%%.MOD ;GET PROGRAM NAME
SETNAM T3, ;NO, TURN OFF JACCT
> ;END TOPS10 CONDITIONAL
TOPS20 <
OPDINI: PUSHJ P,I%HOST ;GET THE HOST NAME
MOVEM S1,CNTSTA ;SAVE IT
MOVX S1,.MSIIC ;GET 'IGNORE STR ACCTING' FUNCTION
MSTR ;WE WANT TO IGNORE STRUCTURE ACCOUNTING
ERJMP .+1 ;IGNORE ANY ERROR
MOVX S1,'SYSVER' ;NAME OF GETTAB FOR SYSNAME
SYSGT ;GET IT
HRLZ T1,S2 ;GET TABLE#,,0
MOVEI T2,10 ;AND LOAD LOOP COUNTER
GETSYN: MOVS S1,T1 ;GET N,,TABLE#
GETAB ;GET THE ENTRY
MOVEI S1,0 ;USE ZERO IF LOSING
MOVEM S1,LPCNF(T1) ;STORE THE RESULT
CAILE T2,(T1) ;DONE ENUF?
AOJA T1,GETSYN ;NO, LOOP
MOVX S1,RC%EMO ;EXACT MATCH
HRROI S2,[ASCIZ /PS:<SPOOL>/] ;DIRECTORY NAME
RCDIR ;GET THE NUMBER
MOVEM T1,SPLDIR ;SAVE IT
> ;END TOPS20 CONDITIONAL
IFN FTDN60,<
PUSHJ P,D60INI## ;INIT D60 DATA BASE
>
SETZM FMOPN ;CLEAR FORMS.INI OPEN FLAG
$RETT ;AND RETURN
SUBTTL OPNFRM -- Routine to open LPFORM.INI
OPNFRM: SKIPN FMOPN ;OPEN ALREADY?
JRST OPNF.1 ;NO, CONTINUE ON
MOVE S1,FMIFN ;YES, GET THE IFN
PUSHJ P,F%REL ;AND RELEASE IT
SETZM FMOPN ;CLEAR "OPEN"
OPNF.1: MOVEI S1,FOB.SZ ;FOB SIZE
MOVEI S2,FOB ;FOB ADDRESS
PUSHJ P,.ZCHNK ;ZERO IT
MOVEI S1,FMFD ;GET FD ADDRESS
STORE S1,FOB+FOB.FD ;STORE IT
MOVEI S1,7 ;LOAD BYTE SIZE
STORE S1,FOB+FOB.CW,FB.BSZ ;STORE IT
MOVEI S1,FOB.SZ ;LOAD THE FOB SIZE
MOVEI S2,FOB ;AND THE FOB ADDRESS
PUSHJ P,F%IOPN ;AND OPEN THE FILE
JUMPF .RETF ;LOSE?
MOVEM S1,FMIFN ;SAVE THE IFN
SETOM FMOPN ;SET "OPEN"
$RETT ;AND RETURN
TOPS10 <
FMFD: XWD FMFDL,0 ;FD SIZE
SIXBIT /SYS/ ;DEVICE
SIXBIT /LPFORM/ ;FILE NAME
SIXBIT /INI/ ;EXTENSION
EXP 0 ;AND PPN WORD
FMFDL==.-FMFD ;FD SIZE
> ;END TOPS10 CONDITIONAL
TOPS20 <
FMFD: XWD FMFDL,0 ;FD SIZE
ASCIZ /SYS:LPFORM.INI/ ;AND THE STRING
FMFDL==.-FMFD ;THE FD SIZE
> ;END TOPS20 CONDITIONAL
SUBTTL Interrupt Module
; INTINI INITIALIZE INTERRUPT SYSTEM
; INTON ENABLE INTERRUPTS
; INTOFF DISABLE INTERRUPTS
; INTCNL CONNECT THE LINEPRINTER
; INTDCL DISCONNECT THE LINEPRINTER
; INTIPC INTERRUPT ROUTINE -- IPCF
; INTDEV INTERRUPT ROUTINE -- LPT OFF-LINE
SUBTTL - INTERRUPT SYSTEM DATABASE
TOPS10 <
VECTOR: BLOCK 0 ;BEGINNING OF INTERRUPT VECTOR
VECIPC: BLOCK 4 ;IPCF INTERRUPT BLOCK
VECDEV: BLOCK 4*NPRINT ;DEVICE INTERRUPT BLK
ENDVEC==.-1 ;END OF INTERRUPT VECTOR
> ;END TOPS10 CONDITIONAL
TOPS20 <
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: XWD 1,INTIPC ;IPCF INT - LEVEL 1
XWD 1,INTDEV ;DEV OFF LINE INT - LEVEL 1
BLOCK ^D34 ;RESTORE OF THE TABLE
LEV1PC: BLOCK 1 ;LVL 1 INTERRUPT PC STORED HERE
LEV2PC: BLOCK 1 ;LVL 2 INTERRUPT PC STORED HERE
LEV3PC: BLOCK 1 ;LVL 3 INTERRUPT PC STORED HERE
> ;END TOPS20 CONDITIONAL
TOPS10 <
DEFINE LPINHD(Z),<
XLIST
$BGINT 1,
MOVEI S1,Z
MOVEI S2,VECDEV+<4*Z>
JRST LPINTR
LPHDSZ==4
LIST
> ;END DEFINE LPINHD
> ;END TOPS10 CONDITIONAL
TOPS10 <
INTINI: MOVEI S1,INTIPC ;GET ADDRESS OF IPCF INT RTN
MOVEM S1,VECIPC+.PSVNP ;SAVE IN VECTOR
Z==0
REPEAT NPRINT,<
MOVEI S1,INTDEV+<LPHDSZ*Z> ;GET ADDRESS OF LPT HEADER
MOVEM S1,VECDEV+<4*Z>+.PSVNP ;STORE IN THE VECTOR
Z==Z+1
> ;END REPEAT NPRINT
POPJ P, ;AND RETURN
> ;END TOPS10 CONDITIONAL
TOPS20 <
INTINI: MOVX S1,.FHSLF ;LOAD MY FORK HANDLE
MOVX S2,1B0!1B1 ;CHANNELS 0 AND 1
AIC ;ACTIVATE THE CHANNELS
POPJ P, ;AND RETURN
> ;END TOPS20 CONDITIONAL
TOPS10 <
INTDCL: SKIPA S1,[PS.FRC+T1] ;REMOVE CONDITION USINGS ARGS IN T1
INTCNL: MOVX S1,PS.FAC+T1 ;ADD CONDITION USING ARGS IN T1
MOVE T1,J$LCHN(J) ;USE CHANNEL AS CONDTION
MOVE T2,STREAM ;GET STREAM NUMBER
IMULI T2,4 ;GET BLOCK OFFSET
ADDI T2,VECDEV-VECTOR ;GET OFFSET FROM BEGINNING
HRLZS T2 ;GET OFFSET,,0
HRRI T2,PS.RDO+PS.ROD+PS.ROL ;AND CONDITIONS
SETZ T3, ;ZERO T3
PISYS. S1, ;TO THE INTERRUPT SYSTEM
$RETF ;WE FAILED !!!
$RETT ;RETURN OK.
> ;END TOPS10 CONDITIONAL
TOPS20 <
INTCNL: MOVE S1,J$LCHN(J) ;GET THE LPT JFN
MOVX S2,.MOPSI ;GET MTOPR FUNCTION
MOVEI T1,T2 ;AND ADDRESS OF ARGS
MOVEI T2,3 ;1ST ARG IS # ARGS
MOVEI T3,1 ;2ND ARG IS INT CHANNEL NUMBER
MOVX T4,MO%MSG ;DON'T TYPE THE MESSAGE
PUSHJ P,$MTOPR ;CONNECT IT
JUMPF .RETF ;IF AN ERROR,,RETURN ERROR
$RETT ;ELSE RETURN OK
> ;END TOPS20 CONDITIONAL
;INTERRUPT ROUTINES
INTIPC: $BGINT 1, ;SETUP FOR THE INTERRUPT.
PUSHJ P,C%INTR ;FLAG THE INTERRUPT.
TOPS10 <
$DEBRK ;DISMISS THE INTERRUPT.
> ;END TOPS10 CONDITIONAL
TOPS20 <
SKIPN J,JOBPAG ;DOES A STREAM EXIST ??
$DEBRK ;NO,,JUST FINISH UP HERE.
JRST INTDON ;FINISH UP -20 INTERRUPT PROCESSING.
> ;END TOPS20 CONDITIONAL
;Here on device interrupts on the -10. This routine consists of multiple
; interrupt headers (one for each stream) which load S1 and S2 and
; call the main interrupt body, LPINTR. Note that on the -10, while
; it is assumed that 'output done' and 'on-line' interrupts can happen
; anytime and anywhere, it is also assumed that 'device off-line'
; interrupts ONLY HAPPEN IN THE STREAM CONTEXT.
TOPS10 <
INTDEV: Z==0
REPEAT NPRINT,<
LPINHD(Z)
Z==Z+1 >
LPINTR: MOVE J,JOBPAG(S1) ;GET THE JOB PARAMETER PAGE
HRRZ T1,.PSVFL(S2) ;GET I/O REASON FLAGS
ANDCAM T1,.PSVFL(S2) ;AND CLEAR THEM
SETZ T2, ;CLEAR AN AC
TXNE T1,PS.ROL+PS.RDO ;IS IT DEVICE ONLINE OR OFFLINE ???
SETOM JOBCHK(S1) ;YES,,SAY WE WANT A CHECKPOINT
TXNE T1,PS.ROL ;IS IT ON-LINE?
MOVX T2,PSF%DO+PSF%OB ;YES,,CLEAR ON-LINE & OUTPUT-BLOCKED
TXNE T1,PS.ROD ;IS IT OUTPUT DONE?
TXO T2,PSF%OB ;YES, GET SCHEDULER BIT
ANDCAM T2,JOBSTW(S1) ;CLEAR THE SCHEDULER FLAGS
TXNN T1,PS.RDO ;IS IT DEVICE OFF-LINE?
$DEBRK ;NO,,DISMISS THE INTERRUPT.
TXNE T1,PS.ROL ;IF BOTH OFFLINE AND ONLINE,
$DEBRK ;DISMISS THE INTERRUPT.
MOVX T2,PSF%DO ;GET OFF-LINE BIT.
IORM T2,JOBSTW(S1) ; AND SET IT.
MOVEI T1,OUTWON ;LOAD RESTART ADDRESS
EXCH T1,.PSVOP(S2) ;STORE FOR DEBRK AND GET OLD ADRESS
MOVEM T1,J$LIOA(J) ;STORE OLD-ADDRESS FOR DEVICE ON AGAIN
$DEBRK ;DISMISS THE INTERRUPT.
> ;END TOPS10 CONDITIONAL
;HERE ON DEVICE INTERRUPTS ON THE -20.
; SINCE ALL I/O IS DONE BY CALLING A SUBROUTINE,
; IF AN INTERRUPT OCCURS WHILE WE ARE I/O ACTIVE,
; WE DONT WANT TO JUST DEBRK BACK INTO THE SOUT
; (UNLESS WE ARE PROCESSING A REMOTE LPT).
; FOR LOCAL LPT'S, WE JUST WANT TO RETURN FROM THE
; SUBROUTINE, WITH THE UPDATED BYTE POINTER AND BYTE
; COUNT. THIS IS WHY WE ALTER THE RETURN PC FOR LOCAL
; LPT'S IF WE ARE I/O ACTIVE. IN THIS CASE WE JUST
; RETURN TO THE CALLING ROUTINE (OUTOUT)
TOPS20 <
INTDEV: $BGINT 1, ;SETUP FOR INTERRUPT
SKIPN J,JOBPAG ;DOES A STREAM EXIST ??
$DEBRK ;NO,,DEBREAK
SETOM JOBCHK ;SAY WE WANT A CHECKPOINT TAKEN
MOVE S1,J$LCHN(J) ;GET THE LPT JFN
MOVX S2,.MORST ;READ-STATUS FUNCTION
MOVEI T1,T2 ;AND ADDRESS OF ARGS
MOVEI T2,3 ;LENGTH OF ARG BLOCK
PUSHJ P,$MTOPR ;GET THE LPT STATUS
MOVX S1,PSF%DO ;DEVICE OFFLINE FLAG
ANDCAM S1,JOBSTW ;CLEAR THE VALUE
TXNE T3,MO%OL ;IS IT OFF-LINE?
IORM S1,JOBSTW ;YES, SET FLAG
INTDON: SKIPE J$LREM(J) ;IS THIS A REMOTE PRINTER ???
JRST INTD.1 ;YES,,SKIP THIS 'LOCAL' STUFF
MOVEI S1,.RETT ;YES,,POINT TO EXIT ADDRESS
SKIPE J$LIOA(J) ;WERE WE I/O ACTIVE ???
MOVEM S1,LEV1PC ;DEBRK ADDRESS, SO SAVE IT.
INTD.1: SETZM J$LIOA(J) ;CLEAR I/O ACTIVE.
$DEBRK ;DISMISS THE INTERRUPT.
> ;END TOPS20 CONDITIONAL
SUBTTL TOPS-20 I/O LOCAL/REMOTE SUBROUTINES ($SOUT)
TOPS20 <
$SOUT: SETOM J$LIOA(J) ;INDICATE I/O IS ACTIVE
SKIPE JOBSTW ;ANY STATUS BITS SET ???
JRST SOUT.T ;YES,,RETURN NOW
SKIPE J$LREM(J) ;IS THIS A REMOTE LPT ???
JRST [SKIPG J$LREM(J) ;YES,,IS THIS A DN200 REQUEST ???
JRST SOUT.2 ;YES,,GO PROCESS IT
JRST SOUT.6 ] ;NO,,MUST BE DN60
SOUT ;LOCAL,,ISSUE THE SOUT NORMALLY
ERJMP SOUT.F ;ON ERROR,,TAKE FAIL RETURN
SOUT.T: SETZM J$LIOA(J) ;CLEAR I/O ACTIVE
$RETT ;AND RETURN
SOUT.F: SETZM J$LIOA(J) ;CLEAR I/O ACTIVE
$RETF ;AND RETURN
$GTJFN: SKIPE J$LREM(J) ;IS THIS A REMOTE LPT ???
JRST [SKIPG J$LREM(J) ;YES,,IS THIS A DN200 REQUEST ???
JRST GTJF.2 ;YES,,GO PROCESS IT
JRST GTJF.6 ] ;NO,,MUST BE DN60
GTJFN ;LOCAL,,ISSUE THE GTJFN NORMALLY
$RETF ;NO GOOD,,RETURN FALSE
$RETT ;ELSE RETURN OK
$OPENF: SKIPE J$LREM(J) ;IS THIS A REMOTE LPT ???
JRST [SKIPG J$LREM(J) ;YES,,IS THIS A DN200 REQUEST ???
JRST OPEN.2 ;YES,,GO PROCESS IT
JRST OPEN.6 ] ;NO,,MUST BE DN60
OPENF ;LOCAL,,OPEN THE LPT NORMALLY
$RETF ;NO GOOD,,RETURN FALSE
$RETT ;ELSE RETURN OK
$CLOSF: SKIPE J$LREM(J) ;IS THIS A REMOTE LPT ???
JRST [SKIPG J$LREM(J) ;YES,,IS THIS A DN200 REQUEST ???
JRST CLOS.2 ;YES,,GO PROCESS IT
JRST CLOS.6 ] ;NO,,MUST BE DN60
CLOSF ;LOCAL,,CLOSE IT DOWN NORMALLY
$RETF ;NO GOOD,,RETURN FALSE
$RETT ;ELSE RETURN OK
$MTOPR: SKIPE J$LREM(J) ;IS THIS A REMOTE LPT ???
JRST [SKIPG J$LREM(J) ;YES,,IS THIS A DN200 REQUEST ???
JRST MTOP.2 ;YES,,GO PROCESS IT
JRST MTOP.6 ] ;NO,,MUST BE DN60
MTOPR ;LOCAL,,DO THE MTOPR NORMALLY
ERJMP .RETF ;ON AN ERROR,,RETURN NO GOOD
$RETT ;ELSE RETURN OK
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
$GDSTS: SKIPE J$LREM(J) ;IS THIS A REMOTE LPT ???
JRST [SKIPG J$LREM(J) ;YES,,IS THIS A DN200 REQUEST ???
JRST GDST.2 ;YES,,GO PROCESS IT
JRST .RETT ] ;NO,,MUST BE DN60 (NO MTOPR)
MOVE S1,J$LCHN(J) ;LOCAL,,GET THE DEVICE JFN
GDSTS ;GET THE DEVICE STATUS
ERJMP .RETF ;ON AN ERROR,,RETURN NO GOOD
MOVE S1,S2 ;RETURN STATUS BITS IN S1
$RETT ;RETURN OK
$SDSTS: SKIPE J$LREM(J) ;IS THIS A REMOTE LPT ???
$RETT ;YES,,CANT SET DEVICE STATUS
MOVE S2,S1 ;GET THE STATUS BITS IN S2
MOVE S1,J$LCHN(J) ;GET THE DEVICE JFN IN S1
SDSTS ;SET THE LPT STATUS
ERJMP .RETF ;ON AN ERROR,,RETURN NO GOOD
$RETT ;ELSE RETURN OK
SUBTTL DN200 I/O SUPPORT ROUTINES
IFN FTRJE,<
SOUT.2: PUSHJ P,USOUT## ;OUTPUT THE DATA
ERJMP SOUT.F ;ON ERROR,,TAKE FAIL RETURN
JRST SOUT.T ;OK,,JUST RETURN
GTJF.2: PUSHJ P,UGTJFN## ;MAKE GTJFN CALL VIA NURD
ERJMP .RETF ;NO GOOD,,SAY SO
$RETT ;ELSE HE WINS
OPEN.2: PUSHJ P,UOPENF## ;MAKE CALL VIA NURD
ERJMP .RETF ;NO GOOD,,SAY SO
$RETT ;ELSE HE WINS
CLOS.2: PUSHJ P,UCLOSF## ;MAKE CALL VIA NURD
ERJMP .RETF ;NO GOOD,,SAY SO
$RETT ;ELSE HE WINS
MTOP.2: PUSHJ P,UMTOPR## ;MAKE CALL VIA NURD
ERJMP .RETF ;NO GOOD,,SAY SO
$RETT ;ELSE HE WINS
GDST.2: MOVE S1,J$LCHN(J) ;GET THE JFN
MOVX S2,.MORST ;GET READ DEVICE FUNCTION
MOVEI T1,T2 ;AND ADDRESS OF ARGS
MOVEI T2,3 ;ARG BLOCK LENGTH
PUSHJ P,UMTOPR## ;MAKE CALL VIA NURD
ERJMP .RETF ;NO GOOD,,SAY SO
MOVE S1,T3 ;RETURN STATUS BITS IN S1
$RETT ;HE WINS
>
IFE FTRJE,<
SOUT.2:
GTJF.2:
OPEN.2:
CLOS.2:
MTOP.2:
GDST.2:
MOVE S1,STREAM ;GET OUT STREAM NUMBER
$WTO (DN200 Remote not Supported,,@JOBOBA(S1))
$RETF ;RETURN
>
SUBTTL DN60 I SUPPORT ROUTINES
IFN FTDN60,<
SOUT.6: SETZM J$LIOA(J) ;ZAP I/O ACTIVE (NONE FOR DN60)
PUSHJ P,D60SOUT## ;OUTPUT THE DATA
JUMPT SOU.6B ;IF OK,,RETURN
CAIN S1,D6NBR ;IS IT A NON-BLOCKING RETURN ???
JRST SOU.6B ;YES,,JUST RETURN
MOVE T2,STREAM ;GET OUR STREAM NUMBER
CAIE S1,D6DOL ;IS THE ERROR OFFLINE ???
CAIN S1,D6CGO ;OR IS IT CANT GET OUTPUT PERMISSION ??
JRST SOU.6A ;YES TO EITHER,,SKIP THIS
$WTO(<DN60 I/O Error # ^O/S1/ on ^B/@JOBOBA(T2)/>,,,<$WTFLG(WT.SJI)>)
PUSHJ P,OUTDIE ;COUNT DOWN I/O ERRORS
SOU.6A: PUSHJ P,I%NOW ;GET THE CURRENT TIME
ADDI S1,^D12 ;GET TIME + 4 SECONDS
MOVEM S1,JOBWKT(T2) ;SAVE IT FOR THE SCHEDULER
SKIPE J$OFLN(J) ;WERE WE ALREADY OFFLINE ???
JRST .+3 ;YES,,SKIP THIS
SETOM JOBCHK(T2) ;FLAG THAT WE WANT A CHECKPOINT TAKEN
$WTO (<^T/BELL/>,,@JOBOBA(T2)) ;NO,,TELL OPR LPT IS OFFLINE
SETOM J$OFLN(J) ;SET THE LPT OFFLINE FLAG
$DSCHD(PSF%AL+PSF%DO) ;DESCHEDULE THE PROCESS
$RETT ;AND RETURN
SOU.6B: SKIPN J$OFLN(J) ;WERE WE OFFLINE BEFORE THIS ???
$RETT ;NO,,JUST RETURN
SETZM J$OFLN(J) ;CLEAR THE OFFLINE FLAG
PUSH P,S2 ;SAVE S2 (BYTE POINTER)
PUSH P,T1 ;SAVE T1 (BYTE COUNT)
PUSHJ P,UPDTST ;UPDATE THE DEVICE STATUS
POP P,T1 ;RESTORE T1 (BYTE COUNT)
POP P,S2 ;RESTORE S2 (BYTE POINTER)
$RETT ;AND RETURN
GTJF.6: SETOM S1 ;NO JFN HERE (MUST RETURN -1)
$RETT ;AND RETURN (NO JFN HERE)
OPEN.6: SETOM J$LINK(J) ;INDICATE NO OPR MSG LIST YET
MOVE S1,STREAM ;GET OUR STREAM NUMBER
MOVE S1,JOBOBA(S1) ;GET OUR OBJECT BLOCK ADDRESS
MOVE S1,OBJ.UN(S1) ;GET OUR UNIT NUMBER
STORE S1,MSGBLK,OP$UNT ;SAVE THE UNIT NUMBER IN OPEN BLOCK
MOVX S1,.OPLPT ;WANT 'LPT' DEVICE
STORE S1,MSGBLK,OP$TYP ;SAVE THE DEVICE TYPE IN THE OPEN BLOCK
LOAD S1,J$DCND(J),CN$PRT ;GET THE PORT NUMBER
STORE S1,MSGBLK,OP$PRT ;SAVE IT IN THE OPEN BLOCK
LOAD S1,J$DCND(J),CN$LIN ;GET THE LINE NUMBER
STORE S1,MSGBLK,OP$LIN ;SAVE IT IN THE OPEN BLOCK
LOAD S1,J$DCND(J),CN$SIG ;GET THE LINE SIGNATURE
STORE S1,MSGBLK,OP$SIG ;SAVE IT IN THE OPEN BLOCK
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
HRROI S1,-OP$SIZ ;GET THE NEGATIVE BLOCK LENGTH
MOVEI S2,MSGBLK ;GET THE PARM BLOCK ADDRESS
PUSHJ P,D60OPN## ;OPEN THE PRINTER
JUMPF .RETF ;CANT OPEN IT (OH WELL !!!)
MOVEM S1,J$LCHN(J) ;SAVE THE LPT HANDLE
HRLZI S1,.OPCOU ;WANT OUTPUT CONSOLE FOR REMOTE
MOVEM S1,MSGBLK ;SAVE THE DEV-TYP,,UNIT NUMBER IN WORD 0
HRROI S1,-OP$SIZ ;GET THE NEGATIVE PARM BLOCK LENGTH
MOVEI S2,MSGBLK ;GET THE PARM BLOCK ADDRESS
PUSHJ P,D60OPN## ;OPEN THE OUTPUT CONSOLE
JUMPF [MOVE S1,J$LCHN(J) ;NO GOOD,,GET THE LPT ID
PUSHJ P,D60RLS## ;RELEASE THE LINE PRINTER
$RETF ] ;RETURN FALSE
MOVEM S1,J$D6OP(J) ;SAVE THE OPERATORS CONSOLE ID
PUSHJ P,L%CLST ;CREATE A LIST FOR OPERATOR MESSAGES
MOVEM S1,J$LINK(J) ;SAVE THE LIST ID
$RETT ;AND RETURN
MTOP.6: CAXE S2,.MOEOF ;IS THIS END OF FILE ??
$RETT ;NO,,JUST RETURN
MOVE S1,J$LCHN(J) ;GET THE LPT ID
PUSHJ P,D60EOF## ;CLEAR BUFFERS,,TURN THE LINE AROUND
$RETT ;AND RETURN
CLOS.6: MOVE S1,J$LCHN(J) ;MAKE SURE WE HAVE JUST THE HANDLE
PUSHJ P,D60RLS## ;CLOSE DOWN THE DN60
MOVE S1,J$D6OP(J) ;GET THE CONSOLE ID
PUSHJ P,D60RLS## ;CLOSE DOWN THE OPERATORS CONSOLE
SKIPL S1,J$LINK(J) ;CHECK AND GET THE OPERATORS LIST ID
PUSHJ P,L%DLST ;DELETE THE LIST IF THERE IS ONE
$RETT ;AND RETURN (NO JFN HERE)
>
IFE FTDN60,<
SOUT.6:
GTJF.6:
OPEN.6:
MTOP.6:
CLOS.6:
GDST.6:
MOVE S1,STREAM ;GET OUR STREAM NUMBER
$WTO (DN60 Type Remote not Supported,,@JOBOBA(S1))
$RETF ;RETURN
>
> ;END TOPS20 CONDITIONAL
SUBTTL STARS - JOB DEFINITION/SEPARATION LINE DEFINITIONS.
STARS: ASCII /000000000000000000000000000000000000000000000000000000000000/
ASCII /000000000000000000000000000000000000000111111111111111111111/
ASCII /1111111111/
BYTE(7) 61,61,23,15,15
ASCII /000000000111111111122222222223333333333444444444455555555556/
ASCII /666666666777777777788888888889999999999000000000011111111112/
ASCII /2222222223/
BYTE(7) 63,63,23,15,15
ASCII /123456789012345678901234567890123456789012345678901234567890/
ASCII /123456789012345678901234567890123456789012345678901234567890/
ASCII /1234567890/
BYTE(7) 61,62,23,0,0
LPTEND::END LPTSPL