Trailing-Edge
-
PDP-10 Archives
-
bb-jr93j-bb
-
7,6/ap020/lptspl.x20
There are 4 other files named lptspl.x20 in the archive. Click here to see a list.
TITLE LPTSPL - TOPS10 LINE PRINTER DRIVER
;
;
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION
; 1975,1976,1977,1978,1979,1980,1981,1982,1983,1984,1985,1986,1987,1988.
; ALL RIGHTS RESERVED.
;
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
; AND WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS
; SOFTWARE OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
; OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON. NO TITLE TO
; AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE
; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
; BY DIGITAL EQUIPMENT CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
; OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY
; DIGITAL.
;
SEARCH GLXMAC ;SEARCH GALAXY PARAMETERS
SEARCH QSRMAC ;SEARCH QUASAR PARAMETERS
SEARCH ORNMAC ;SEARCH ORION/OPR PARAMETERS
SEARCH LPTMAC ;LPTSPL PARAMETERS
PROLOGUE(LPTSPL)
.DIRECT FLBLST
IF2,<
TOPS20 <PRINTX ASSEMBLING GALAXY-20 LPTSPL>
TOPS10 <PRINTX ASSEMBLING GALAXY-10 LPTSPL>
> ;END IF2
SALL ;SUPPRESS MACRO EXPANSIONS
%%.LPT==:%%.LPT ;EDIT LEVEL
;STORE VERSION NUMBER IN JOBVER
LOC 137
.JBVER::EXP %%.LPT
IFDEF .MCRV.,<IFDEF .VERSION,<.VERSION <%%.LPT>>>
RELOC 0
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1971,1988. ALL RIGHTS RESERVED.
\;END COPYRIGHT MACRO
DEFINE FACT,<IFN FTFACT>
SUBTTL Table of Contents
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.
SUBTTL Generate table of switch names
;*Note* FF is used in macro F defined in LPTMAC.
DEFINE FF(A,C),<
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$WCL1==^D60 ;WIDTH CLASS ONE IS 1 TO F$WCL1
F$WCL2==^D100 ;WIDTH CLASS TWO IS F$WCL1 TO F$WCL2
F$LCL1==^D41 ;Length class one is 1 to F$LCL1
F$LCL2==^D55 ;Length class two is F$LCL1 to F$LCL2
;NOW GENERATE A BIT TABLE OF WHICH WORDS IN THE JOB DATA PAGE TO ZERO
; ON A NEW JOB
ZTABLE: ;PUT TABLE HERE
DEFINE ZTAB(A),<
IFNDEF ..Z'A,<..Z'A==0>
EXP ..Z'A
> ;END DEFINE ZTAB
ZZ==0
REPEAT <J$$LEN+^D35>/^D36,<
XLIST
ZTAB(\ZZ)
ZZ==ZZ+1
LIST
> ;END REPEAT
SUBTTL 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
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
IMESS: BLOCK 1 ;IPCF message -1=one to be released
LPCNF:: BLOCK 11 ;SYSNAME
LPJOB: BLOCK 1 ;LPTSPL'S JOB NUMBER
LPTRM: BLOCK 1 ;TERMINAL DESIGNATOR
LPCON: BLOCK 1 ;CONNECT TIME
LPLNO: BLOCK 1 ;LINE NUMBER
JOBITS::BLOCK 1 ;SAVE JOB STATUS BITS FLAG.
STRSEQ: EXP 4000 ;STREAM SEQ #'S (START AT 4000)
SCHEDL: -NPRINT,,0 ;STREAM SCHEDULING DATA
FNTLST::BLOCK 1 ;DEVICE SPECIFIC FONT LISTS
SLEEPT::BLOCK 1 ;SLEEP TIME FOR SCHEDULING.
;This is always the min. amount to sleep
;-1 if no sleep time specified
ACTIVE::BLOCK 1 ;NUMBER OF ACTIVE STREAMS PER SCHED PASS
SSETUP::EXP 0 ;NUMBER OF STREAMS SETUP PER SCHED PASS
BYEUDT::BLOCK 1 ;IF -1, LPTSPL IS A %ONCE OBJECT PROCESSOR,
; SETUP OR ACTIVE CHECKS NOT DONE
;IF 0, LPTSPL IS A %STCMD OBJECT PROCESSOR,
; LPTSPL WILL SAY GOODBYE AND LOGOUT WHEN
; ALL STREAMS ARE SHUTDOWN.
;IF >0, LPTSPL IS A %DEMND OBJECT PROCESSOR
; BYEUDT WILL CONTAIN UDT LPTSPL WILL
; SAY GOODBYE AND LOGOUT IF ALL STREAMS
; ARE INACTIVE UP UNTIL THIS TIME
CNTSTA::BLOCK 1 ;NUMBER OF THE CENTRAL STATION
RUTINE: BLOCK 1 ;MESSAGE PROCESSING ROUTINE ADDRESS.
STRTAB: BLOCK STRLEN ;STRUCTURE TABLE
STRBLK: BLOCK STRSLS ;ARGUMENT BLOCK FOR BUILDING SEARCH LISTS
TOPS10 <
DCHBLK: BLOCK .DCSNM+1 ;DSKCHR BLOCK
>
TOPS20 <
SPLDIR: BLOCK 1 ;DIRECTORY NUMBER OF PS:<SPOOL>
> ;END TOPS20 CONDITIONAL
; INIT FILE DATA STORAGE
INIFOB: BLOCK FOB.SZ ;FILE OPEN BLOCK
INIFD: BLOCK FDXSIZ ;FILE DESCRIPTOR BLOCK
INIIFN: BLOCK 1 ;INTERNAL FILE NUMBER
INITMP: BLOCK 1 ;TEMP STORAGE USED DURING I/O ERROR REPORTING
INIEPC: BLOCK 1 ;CALLER'S PC FOR I/O ERROR RECOVERY
INIPDP: BLOCK 1 ;PDL POINTER FOR I/O ERROR RECOVERY
INILIN: BLOCK 1 ;LINE NUMBER WITHIN FILE
INISAV: BLOCK 1 ;SAVED CHARACTER
INIATM: BLOCK INIWDS ;ATOM BUFFER
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 INDICATOR
;Contains the time for the next checkpoint
; or 0 if one is requested
JOBUPD::BLOCK NPRINT ;Stream update indicator
; if set, update is indicated for the stream
JOBWAC::BLOCK NPRINT ;STREAM WTOR ACK CODE.
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
$SET(PB.SYS,IP.BQT,-1) ;MAX SEND/RECIEVE IPCF QUOTAS
$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 terminate the job now
Type 'RESPOND <number> PROCEED' to allow the job to continue printing/
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 Device table
DEFINE LL(DEVNAM)<.TEXT \'DEVNAM/LOCALS\>
G..LPT ;CAUSE DRIVERS TO LOAD
.TEXT ",LPTLP5/LOCALS" ;ALWAYS LOAD THE LP05 CLASS DRIVER
.TEXT ",LPTMTA/LOCALS" ;ALWAYS LOAD THE MAGTAPE DRIVER
.TEXT ",LPTD60/LOCALS" ;ALWAYS LOAD THE DN60 DRIVER
.LNKEN DEVLNK,DEVLST ;DEFINE HEAD OF DEVICE DRIVER CHAIN
DEVLST::BLOCK 1 ;START OF DEVICE DRIVER CHAIN
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.
PUSHJ P,OPDINI ;GET OPERATING SYSTEM INFO.
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.
SETZM ACTIVE ;INIT ACTIVE STREAM COUNT
MOVX S1,OPTYP% ;GET OUR OBJECT PROCESSOR TYPE
SETOM BYEUDT ;ASSUME %ONCE (SHOULDN'T BE, BUT..)
SKIPE DEBUGW ;DEBUGGING?
JRST MAIN ;YES, WE'LL STAY AROUND EVEN IF IDLE
CAXN S1,%DEMND ;"FIRED UP" WHEN JOB TO DO?
AOSA BYEUDT ;YES, MAKE BYEUDT +1
CAXN S1,%STCMD ;NO, "FIRED UP" ON START COMMAND?
AOS BYEUDT ;YES, MAKE BYEUDT 0
;FALL THROUGH TO MAIN LOOP.
SUBTTL Idle Loop
MAIN: SKIPE J,JOBPAG(P1) ;Stream setup?
PUSHJ P,@J$SCHD(J) ;CALL DRIVER
SKIPN JOBACT(P1) ;IS THE STREAM ACTIVE ???
JRST MAIN.2 ;NO, GET THE NEXT STREAM.
AOS ACTIVE ;YES, BUMP COUNTER
HRRZM P1,STREAM ;RUNNABLE STREAM!!!
MOVE J,JOBPAG(P1) ;YES, GET JOB PAGE
PUSHJ P,CHKTIM ;Adjust sleep time if needed
$CALL DSTATUS ;Do any status stuff
SKIPE JOBSTW(P1) ;IS THE STREAM BLOCKED ???
JRST MAIN.2 ;YES, GET THE NEXT STREAM.
MOVEM P1,SCHEDL ;SAVE THE SCHEDULING STREAM.
MOVSI 0,J$RACS+1(J) ;Setup first source address for BLT
HRRI 0,1 ;Setup first destination address
BLT 0,17 ;GET SOME ACS
POPJ P, ;AND RETURN
MAIN.1: MOVE P1,SCHEDL ;GET THE LAST SCHEDULED STREAM.
$CALL DSTATUS ;Do any status stuff
PUSHJ P,CHKTIM ;SET THE WAKEUP TIMER
MAIN.2: AOBJN P1,MAIN ;LOOP BACK FOR SOME MORE.
PUSHJ P,CHKQUE ;CHECK FOR INCOMMING MESSAGES.
SKIPE MESSAGE ;DID WE PROCESS A MESSAGE ???
JRST MAIN.6 ;YES, CONTINUE PROCESSING
SKIPLE S1,BYEUDT ;CARE ABOUT IDLENESS?
SKIPE ACTIVE ;YES, ARE STREAMS ACTIVE?
JRST [SOJL S1,MAIN.4 ;ACTIVE STREAMS. JUMP IF DONT'T CARE
MOVEI S1,1 ;ELSE FLAG TIME IS TO BE SET
MOVEM S1,BYEUDT ;NEXT TIME NO STREAMS ARE ACTIVE
JRST MAIN.4]
SOJE S1,MAIN.3 ;JUMP IF TIME NEEDS TO BE SET
$CALL I%NOW ;ELSE GET CURRENT TIME
CAMGE S1,BYEUDT ;TIME TO SAY GOODBYE TO QUASAR?
JRST MAIN.4
PJRST IDLBYE ;YES, GO TELL QUASAR AND LOGOUT
MAIN.3: $CALL I%NOW ;GET CURRENT TIME
ADD S1,[EXP IDLMIN*^D60*^D3];COMPUTE BYEBYE TIME
MOVEM S1,BYEUDT ;SAVE IT
MAIN.4: MOVE S1,SLEEPT ;NO, PICK UP SLEEP TIME.
JUMPE S1,MAIN.6 ;Don't sleep if 0 sleep specified
JUMPG S1,MAIN.5 ;JUMP IF SLEEP TIME SPECIFIED
SKIPLE BYEUDT ;KEEPING TRACK OF IDLENESS?
SKIPA S1,[EXP ^D60] ;YES, ONLY SNOOZE FOR A MINUTE
SETZ S1, ;NO, SLEEP UNTIL AWAKENED
TOPS20 <
SKIPE JOBACT ;CHECK IF STREAM ACTIVE..
SKIPE JOBSTW ;ANY BLOCKING CONDITIONS
>;END TOPS20 CONDITIONAL
MAIN.5: PUSHJ P,I%SLP ;ELSE,,GO WAIT
MAIN.6: MOVE P,[IOWD PDSIZE,PDL] ;RESET THE STACK POINTER.
SETOM SLEEPT ;Start fresh
MOVSI P1,-NPRINT ;GET LOOP AC.
SETZM ACTIVE ;INIT ACTIVE STREAM COUNT
JRST MAIN ;KEEP ON PROCESSING.
SUBTTL CHKTIM - ROUTINE TO CHECK WAKEUP TIME BASED ON CURRENT STREAM
; The purpose of this routine is to check and set the sleep time based
; on current conditions. The sleeptime is checked based on the stream's
; wakeup time and the console wakeup time (on DN60). Whoever wants to
; wakeup the earliest sets the sleeptime if the time is less than the
; current.
; Returns: False if it is not time to wake up this stream
; True if it is time to wakeup this stream
CHKTIM::PUSHJ P,I%NOW ;GET CURRENT TIME INTO S1
MOVE T1,STREAM ;GET OUR STREAM NUMBER
MOVE S2,JOBWKT(T1) ;GET WAKEUP TIME OF JOB
PUSHJ P,@J$WAKE(J) ;DO WAKEUP TIMER CHECKING
JUMPE S2,.RETF ;NO TIME SET, THIS IS IRRELEVANT
SUB S2,S1 ;CALCULATE THE NUMBER
IDIVI S2,3 ; OF SECONDS TO WAKE-UP.
JUMPLE S2,CHKT.1 ;IF TIME IS UP,,WAKE UP STREAM.
CAILE S2,^D60 ;IF WAKE UP TIME IS GREATER THEN
MOVEI S2,^D60 ; 60 SECS,, THEN MAKE IT 60 SECS.
SKIPL SLEEPT ;IF -1 THEN NONE SET - GO SET
CAMGE S2,SLEEPT ;IF WAKE UP TIME IS LESS THEN
MOVEM S2,SLEEPT ;CURRENT WAKE UP TIME,,THEN RESET IT.
$RETF ;DO NOT WAKE UP THE JOB.
CHKT.1: SETZM SLEEPT ;NO SLEEP TIME NEEDED
MOVX S1,PSF%AL ;PICK UP ALIGN BLOCK BIT.
MOVE T1,STREAM ;GET STREAM NUMBER AGAIN
ANDCAM S1,JOBSTW(T1) ;CLEAR ALIGN BIT
MOVE T1,STREAM ;GET THE STREAM NUMBER
SKIPF ;SKIP IF DRIVER SAID DON'T ZERO JOBWKT
SETZM JOBWKT(T1) ;CLEAR JOB WAKE TIME
$RETT ;WAKE UP THE STREAM.
SUBTTL DSCHD -- Deschedule process
; The purpose of this routine is to provide a generalized blocking
; mechanism. It differs from the old DSCHD in that it will block
; whether in stream context or not.
; DSCHD is called by the $DSCHD macro where the call is:
; $DSCHD (flags) where flags are flags and/or a number of seconds
; to sleep
; ASSUMPTIONS. . .
; 1. STREAM is assumed to be correct.
; 2. If not in stream context, it is assumed that J contains the
; address of the jobpage. This has a side problem. If J indicates
; a jobpage of an already existing stream with a context and
; the stream is in the overhead context, the old stream context
; will be destroyed which must be avoided by the caller.
; 3. If called with an IPCF message currently in use, it is assumed
; that the user has everything needed from the message and the
; message will be released. This assumption is necessary to
; prevent another message being received before the old message
; is released.
; All registers are preserved in the JOBPAG.
; Only AC's S1, S2 and T1 are touched before jumping to MAIN.
; parameters:
; J / Address of the current jobpage (if not, expect a stopcd)
;Save the AC's in any case
DSCHD:: MOVEM 0,J$RACS(J) ;Save AC0
MOVEI 0,J$RACS+1(J) ;Place to put AC1
HRLI 0,1 ;Setup the BLT pointer
BLT 0,J$RACS+17(J) ;Save the AC's
MOVE T1,STREAM ;Get the current stream number
;Take care of the flags passed
HRRZ S2,0(P) ;Get address of JUMP [FLAGS]
HLLZ S1,@0(S2) ;Get the flags
HRRZ S2,@0(S2) ;Get the sleep time
IORM S1,JOBSTW(T1) ;set only the flags
JUMPE S2,DSCH.D ;No sleep time to worry about
$CALL I%NOW ;Get the current time
IMULI S2,3 ;Seconds to jiffies
ADD S1,S2 ;Build wake-up time
MOVEM S1,JOBWKT(T1) ;Save the wake-up time
;Check to see our current context
DSCH.D: HRRZ S1,P ;Get current address of PDL
CAIL S1,J$RPDL(J) ;Less than beginning of current PDL
CAILE S1,PDSIZE+J$RPDL(J) ;or Greater than end?
SKIPA ;No not in stream context
JRST DSCH.Z ;Yes - already in stream context
;Since we have to make a stream context, we must do the following:
; 1. Release any IPCF messages
; 2. Given then the stream number:
; Save JOBACT for this stream and info needed to restore JOBACT
; Set JOBACT for this stream so it can be selected to run
; 3. Save PDL and AC17
SKIPE IMESS ;Any IPCF messages?
$CALL C%REL ;Yes, release it
SETZM IMESS ;Set no IPCF messages
SKIPN JOBACT(T1) ;Stream already active?
PUSH P,[EXP FIXACT] ;no - remember to fix JOBACT
SETOM JOBACT(T1) ;pretend we are active now in any case
PUSH P,[EXP FIXPDL] ;Remember to fix up the stack later
MOVEI S1,J$RPDL(J) ;Get stream's PDL location
HRLI S1,PDL ;Get beginning of PDL
HRRZ T1,P ;Get current PDL pointer
SUBI T1,PDL ;Find current length
ADDI T1,J$RPDL(J) ;Add stream's base
HRR P,T1 ;Set new pointer
BLT S1,(T1) ;Save PDL
MOVEM P,J$RACS+P(J) ;Save new PDL pointer
JRST MAIN.6 ;Return to restart main loop
DSCH.Z: MOVE P,[IOWD PDSIZE,PDL] ;Reset stack pointer
JRST MAIN.1 ;Return to main loop
SUBTTL FIXPDL -- Fix PDL routine
;The purpose of this subroutine is to return the pseudo stream
;context back to overhead context. (See DSCHD)
FIXPDL: MOVEI S1,PDL ;Get overhead PDL
HRLI S1,J$RPDL(J) ;Get beginning of stream's PDL
HRRZ S2,P ;Get current pointer
SUBI S2,J$RPDL(J) ;Find the current length
ADDI S2,PDL ;Add the base of the PDL
HRR P,S2 ;Set the new pointer
BLT S1,(S2) ;Restore PDL
MOVE S1,J$RACS+S1 ;Restore S1
MOVE S2,J$RACS+S2 ;Restore S2
$RET ;Continue on
SUBTTL FIXACT - Routine to set stream to inactive
;This routine is use to return a stream to an inactive state when
;the stream was descheduled when not in stream context. It is
; "called" by DSCHD pushing FIXACT on the stack when the need is
;determined.
FIXACT: $SAVE <S1> ;Save a register
MOVE S1,STREAM ;Get the stream #
SETZM JOBACT(S1) ;Make it inactive
$RET ;Don't change anything
SUBTTL FORFOR -- Force Forms change mess.
; This routine causes a forms change to occur even if there is no
; job currently scheduled for the printer.
; Assumes J contains the pointer to the job data base
; M contains a pointer to the message
; The object block has already been parsed correctly
FORFOR: MOVE S1,.OFLAG(M) ;Get the forms type
MOVEM S1,.EQLIM(J) ;Save it where NXTJOB does
MOVE S1,STREAM ;Get the stream number
SETOM JOBACT(S1) ;Set the stream active
MOVX S2,PSF%OB+PSF%ST+PSF%OR+PSF%AL
;Get a bunch of bits
ANDCAM S2,JOBSTW(S1) ;And clear them
MOVEI S1,J$RPDL-1(J) ;Point to the context PDL
HRLI S1,-PDSIZE ;And the length
PUSH S1,[EXP DOFFOR] ;Push address of the stack
MOVEM S1,J$RACS+P(J) ;And save the PDL
$CALL TBFINI ;Init the buffer
$CALL CHKLPT ;Check for online
$RET
SUBTTL DOFFOR -- Do the force forms
; This forces the forms change to occur in stream context. Is called
; implicitly by being placed on the stream's stack by FORFOR.
; Simply calls the routine to set the forms, sends a reset status message
; to notify QUASAR that the forms change has been effected, and returns
; to the scheduler.
DOFFOR: $CALL FORMS ;Try to set the forms
SKIPF ;Did we succeed?
$CALL CHKALN ;Yes, do an alignment if needed
MOVE S1,STREAM ;Get the stream number
SETOM JOBUPD(S1) ;Say we want an update message
SETZM JOBSTW(S1) ;Say we want reset message
; defaults since no bits set
$CALL DSTATUS ;Tell QUASAR we are done
SETZM J$RACS+S(J) ;Clear status bits
MOVE S1,STREAM ;Get the stream number
SETZM JOBACT(S1) ;No longer active
PJRST MAIN.6 ;Go back to the scheduler
SUBTTL NXTJOB -- 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
SETZM JOBCHK(S1) ;CHECKPOINT FIRST CHANCE WE GET !!!
SETOM JOBUPD(S1) ;Send update also.
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,-PDSIZE ;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)/>)
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
NXTJ.5: PUSHJ P,LPTTXT ;GENERATE "OUTPUT TO ..." TEXT
SKIPL J$LCHN(J) ;KNOW WHERE THE OUTPUT IS GOING?
$TEXT (LOGCHR,<^I/LPDAT/^T/J$LOUT(J)/>) ;STUFF IN THE RUN LOG
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)/)>)
SKIPE S1 ;CHECK AGAIN
$TEXT (<-1,,J$WTOR(J)>,<Invalid account string specified^0>)
GETLIM T1,.EQLIM(J),OLIM ;GET PAGE LIMIT
MOVEM T1,J$RLIM(J) ;SAVE IT
PUSHJ P,ACTBEG ;GO SETUP THE ACCOUNTING PARMS
PUSHJ P,I%NOW ;GET TIME OF DAY
MOVEM S1,J$RTIM(J) ;SAVE IT AWAY
MOVE S1,STREAM ;GET STREAM NUMBER.
$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 DOJOB -- Do the Job
DOJOB: PUSHJ P,FORMS ;GET FORMS MOUNTED
JUMPF ENDREQ ;CANT DO IT,,END THE REQUEST
$CALL CHKALN ;DO AN ALIGNMENT IF NEEDED
PUSHJ P,@J$BJOB(J) ;DO POSSIBLE FONT LOADS
TXNE S,RQB+ABORT ;JOB ABORTED?
JRST ENDJOB ;YES, FINISH UP
LOAD S1,.EQSEQ(J),EQ.IAS ;GET INVALID ACCOUNT STRING BIT
STORE S1,S,ABORT ;SAVE IT AS THE ABORT BIT
TXO S,BANHDR ;LITE 'PRINTING BANNERS' FLAG
PUSHJ P,JOBHDR ;PRINT THE BANNER
TXZ S,BANHDR ;CLEAR 'PRINTING BANNERS' FLAG
LOAD E,.EQLEN(J),EQ.LOH ;GET LENGTH OF HEADER
ADD E,J ;POINT TO FIRST FILE
SETZM J$RNFP(J) ;ZAP THE # OF FILES PRINTED
TXO S,INJOB ;We are in a job now
SKIPN .EQCHK+CKFLG(J) ;IS THIS A RESTARTED JOB?
JRST DOJO.4 ;NO, SKIP ALL THIS STUFF
MOVE T1,.EQCHK+CKFIL(J) ;YES, GET NUMBER OF FILES DONE
MOVEM T1,J$RNFP(J) ;STORE FOR NEXT CHECKPOINT
DOJO.1: SOJL T1,DOJO.2 ;DECREMENT AND JUMP IF SKIPED ENUF
LOAD S1,.FPINF(E),FP.FCY ;GET THE COPIES IN THIS REQUEST
ADDM S1,J$AFXC(J) ;ADD TO THE TOTAL COUNT
PUSHJ P,NXTFIL ;BUMP E TO NEXT SPEC
JUMPF DOJO.7 ;FINISH OFF IF DONE
JRST DOJO.1 ;LOOP SOME MORE
DOJO.2: MOVE S1,.EQCHK+CKCOP(J) ;GET NUMBER OF COPIES PRINTED
MOVEM S1,J$RNCP(J) ;SAVE FOR NEXT CHECKPOINT
ADDM S1,J$AFXC(J) ;ADD TO THE TOTAL FILE COUNT
MOVE S1,.EQCHK+CKTPP(J) ;GET THE TOTAL PAGES PRINTED.
SUBI S1,5 ;MAKE SURE WE DONT SCREW THINGS UP
SKIPGE S1 ;ALSO MAKE SURE WE ARE NOT NEGATIVE
SETZM S1 ;YES, MAKE IT 0
MOVEM S1,J$APRT(J) ;AND SAVE IT
MOVE S1,.EQCHK+CKPAG(J) ;GET CHKPNT'ED PAGE
SUBI S1,5 ;MAKE SURE WE DONT MISS ANYTHING !!
SKIPGE S1 ;ALSO MAKE SURE WE ARE NOT NEGATIVE
SETZM S1 ;YES, MAKE IT 0
TXZE S,BCKFIL ;WERE WE BACKSPACED DURING HEADERS ???
TXZ S,SKPFIL ;YES, CLEAR THE SKIP FILE BIT
SKIPA ;Never use the /START param that follows
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
DOJO.4: LOAD S1,.FPFST(E) ;GET /START PARAMETER
MOVEM S1,J$FPIG(J) ;SAVE FOR FIRST COPY
PUSHJ P,FILE ;NO, PRINT THE FILE
TXNE S,RQB ;HAVE WE BEEN REQUEUED?
JRST ENDJOB ;YES, END NOW!!
AOS J$RNFP(J) ;BUMP THE FILE COUNT BY 1.
MOVE S1,STREAM ;Get the stream number
SETZM JOBCHK(S1) ;Want a checkpoint soon
TXZE S,BCKFIL ;BACKSPACING A FILE?
JRST DOJO.4 ;YES
PUSHJ P,NXTFIL ;BUMP TO NEXT FILE
JUMPT DOJO.4 ;AND LOOP
DOJO.7: SKIPN E,J$RLFS(J) ;GET ADR OF LOG-SPEC
JRST ENDJOB ;NO, FINISH JOB
MOVE S1,J$APRT(J) ;GET NUMBER OF PAGES PRINTED
ADDI S1,LOGPAG ;ADD IN GUARANTEED LOG LIMIT
CAMLE S1,J$RLIM(J) ;DOES HE HAVE AT LEAST THAT MANY?
MOVEM S1,J$RLIM(J) ;NO, GIVE HIM THAT MANY
TXZ S,ABORT ;CLEAR ABORT FLAG
PUSHJ P,FILE ;PRINT THE FILE
JRST ENDJOB ;AND FINISH UP
SUBTTL 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
FILDIS: LOAD E,.EQLEN(J),EQ.LOH ;GET THE HEADER LENGTH.
ADD E,J ;POINT TO FIRST FILE .
LOAD T1,.EQSPC(J),EQ.NUM ;GET THE NUMBER OF FILES.
FILD.1: MOVE T2,.FPINF(E) ;GET THE FILE INFO BITS.
LOAD S2,.FPLEN(E),FP.LEN ;GET THE FILE INFO LENGTH.
ADD E,S2 ;POINT TO FILE SPEC.
MOVEM E,J$XFOB+FOB.FD(J) ;SAVE THE FD ADDRESS IN THE FOB
LOAD S2,.FPLEN(E),FD.LEN ;GET THE FD LENGTH.
ADD E,S2 ;POINT 'E' AT NEXT FILE.
SETZM J$XFOB+FOB.US(J) ;DEFAULT TO NO ACCESS CHECKING
SETZM J$XFOB+FOB.CD(J) ;HERE ALSO
LOAD S1,.EQSEQ(J),EQ.PRV ;GET THE USERS PRIVILGE BITS
JUMPN S1,FILD.2 ;IF SET, AVOID ACCESS CHECK
TXNE T2,FP.SPL ;WAS IT A SPOOLED FILE ???
JRST FILD.2 ;YES, THEN NO ACCESS CHECK
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
FILD.2: MOVEI S1,FOB.SZ ;GET THE FOB LENGTH
MOVEI S2,J$XFOB(J) ;AND THE FOB ADDRESS
TXNE T2,FP.SPL ;Spool file?
JRST FILD.3 ;Yes, delete the file in any case
TXNE S,ABORT ;Is abort set?
JRST FILD.4 ;Yes, skip deleting the file
TXNE T2,FP.DEL ;/delete?
FILD.3: $CALL F%DEL ;Yes, here to delete
FILD.4: SOJG T1,FILD.1 ;GO PROCESS THE NEXT FILE.
$RETT ;RETURN.
SUBTTL FILE -- Print a File
FILE: TXNE S,ABORT ;ARE WE IN TROUBLE ???
$RET ;YES, JUST RETURN.
$CALL LIMCHK ;Are we over limit?
$RETIF ;Yes, just return
PUSHJ P,INPOPN ;OPEN THE INPUT FILE UP
JUMPF .POPJ ;LOSE, RETURN
MOVE S1,J$DFDA(J) ;GET FD ADDRESS
PUSHJ P,STRMNT ;MOUNT THE STR
;**;[2774] Change 1 line at FILE+8L. 26-Oct-83 /LWS
$TEXT(LOGCHR,<^I/LPMSG/Starting File ^F/@J$DFDA(J)/^T/J$GSPL(J)/>) ;[2774]
FILE.1: PUSHJ P,INPREW ;REWIND THE INPUT FILE
JUMPF FILE.2 ;DRIVER SAID NOT TO PROCESS FILE
MOVE S1,STREAM ;Get the stream number
SETZM JOBCHK(S1) ;Want a checkpoint
$CALL DSTATUS ;Do the status
PUSHJ P,SETLST ;SETUP /REPORT CODE IF NECESSARY
TXZ S,FORWRD ;CLEAR FORWARD SPACE BIT
TXO S,BANHDR ;LITE 'PRINTING HEADERS' FLAG
PUSHJ P,HEAD ;PRINT THE HEADER
TXZ S,BANHDR ;CLEAR 'PRINTING HEADERS' FLAG
MOVEI S1,LPTERR ;GET NUMBER OF DEVICE ERRORS ALLOWED
MOVEM S1,J$LERR(J) ;AND SAVE IT
SOSLE J$FPIG(J) ;SUBTRACT 1 PAGE FROM STARTING PAGE #.
JRST [TXO S,FORWRD ;[4005]POSITIVE,,TURN ON FORWARD BIT.
MOVE S1,J$FPIG(J) ;[4005]GET STARTING PAGE
JRST .+1] ;[4005]AND CONTINUE
TXNE S,ABORT!SKPFIL!RQB ;DO WE REALLY WANT TO DO THIS ???
JRST FILE.2 ;NO, CLEAN UP THE MESS.
PUSHJ P,@J$BFIL(J) ;DO BEGINING OF FILE PROCESSING
JUMPF FILE.2 ;ERROR MEANS WE SHOULD ABORT THE FILE
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
PUSHJ P,@J$EFIL(J) ;DO END OF FILE PROCESSING
JUMPF FILE.2 ;DRIVER SAID NO MORE
LOAD S2,.FPINF(E),FP.FCY ;GET TOTAL NUMBER TO PRINT
CAML S1,S2 ;PRINTED ENOUGH?
JRST FILE.2 ;Yes, go finish
$CALL LIMCHK ;Check to see if over limit
JUMPT FILE.1 ;If not, loop
FILE.2: SKIPE S1,J$DIFN(J) ;GET THE IFN
PUSHJ P,F%REL ;RELEASE IT
SETZM J$DIFN(J) ;Clear the IFN
;**;[2774] Changed 1 line at FILE.2+3L. 25-Oct-83 /LWS
$TEXT (LOGCHR,<^I/LPMSG/Finished File ^F/@J$DFDA(J)/^T/J$GSPL(J)/>) ;[2774]
MOVE S1,J$DFDA(J) ;GET FD ADDRESS
PUSHJ P,STRDMO ;DISMOUNT THE STR
TXNE S,SUPFIL ;Are we suppressing forms/file?
SETZM J$XTOP(J) ;Yes, set we are not at top of page.
TXZ S,SKPFIL+SUPFIL ;CLEAR LOTS OF BITS
POPJ P, ;AND RETURN
SUBTTL 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>)
$TEXT (LOGCHR,<^I/LPEND/ ^D5/J$ADRD(J)/ Disk Blocks Read>)
PUSHJ P,@J$EJOB(J) ;DO END OF JOB PROCESSING
PUSHJ P,JOBTRL ;PRINT THE JOB TRAILERS.
PUSHJ P,@J$EOF(J) ;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.6 ;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.
$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
MOVEI S1,0 ;CLEAR FLAGS
TXNE S,ABORT ;ABORTING JOB?
TXO S1,RF.ABO ;YES--TELL QUASAR
MOVEM S1,REL.FL(T1) ;SAVE IN MESSAGE
TXNE S,ABORT ;CHECK AGAIN
$TEXT (<-1,,REL.TX(T1)>,<^T/J$WTOR(J)/^0>) ;ADD OPR TEXT FOR /NOTIFY
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.
SETOM IMESS ;Have a message
SETZM BLKADR ;CLEAR THE IPCF MSG BLK ADDR SAVE AREA
LOAD S2,MDB.SI(S1) ;GET SPECIAL INDEX WORD
TXNN S2,SI.FLG ;IS THERE AN INDEX THERE?
JRST CHKQ.7 ;NO, IGNORE IT
ANDX S2,SI.IDX ;AND OUT THE INDEX
CAIE S2,SP.OPR ;IS IT FROM OPR?
CAIN S2,SP.QSR ;IS IT FROM QUASAR?
SKIPA ;Yes, continue on
JRST CHKQ.7 ;Go to release the message
CHKQ.2: LOAD M,MDB.MS(S1),MD.ADR ;GET THE MESSAGE ADDRESS
MOVEM M,MESSAG ;SAVE IT AWAY
LOAD S2,.MSTYP(M),MS.TYP ;GET THE MESSAGE TYPE
MOVSI S1,-NMSGT ;MAKE AOBJN POINTER FOR MSG TYPES
CHKQ.3: HRRZ T1,MSGTAB(S1) ;GET A MESSAGE TYPE
CAMN S2,T1 ;MATCH?
JRST CHKQ.6 ;YES, WIN
AOBJN S1,CHKQ.3 ;NO, LOOP
PUSH P,P1 ;SAVE P1
MOVE P1,DEVLST ;POINT TO START OF DEVICE DRIVER CHAIN
CHKQ.4: PUSHJ P,@J$IPCF-J$$DEV(P1) ;TRY TO PROCESS THE MESSAGE
JUMPT CHKQ.5 ;JUMP IF PROCESSED OK
SKIPE P1,0(P1) ;POINT TO NEXT DRIVER
JRST CHKQ.4 ;LOOP BACK
CHKQ.5: POP P,P1 ;RESTORE P1
JRST CHKQ.7 ;GO TO RELEASE THE MESSAGE
CHKQ.6: 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.7 ;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 FLAG (DEFAULT TO ALWAYS SAVE)
CHKQ.7: SKIPE IMESS ;Any IPCF messages?
$CALL C%REL ;Yes, release it
SETZM IMESS ;Remember we have released it
POPJ P, ;RETURN TO THE SCHEDULER.
MSGTAB: XWD KILL,.QOABO ;ABORT MESSAGE
XWD DSTATUS,.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 FORFOR,.QOFCH ;FORCE FORMS 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.
CAIE S2,.QOFCH ;Is it forms change message?
CAIL S2,.OMOFF ;IS THIS AN OPR/ORION MSG ??
JRST CHKO.1 ;YES, GO SET UP THE OBJ SEARCH.
XCT MSGOBJ(S1) ;GET THE OBJ BLK ADDRESS.
JRST CHKO.2 ;LETS MEET AT THE PASS.
CHKO.1: PUSHJ P,GETBLK ;GET A MESSAGE BLOCK
JUMPF .RETF ;NO MORE, THATS AN ERROR
CAIE T1,.OROBJ ;IS THIS THE OBJECT BLOCK ???
JRST CHKO.1 ;NO, GET THE NEXT MSG BLOCK
MOVE S1,T3 ;GET THE BLOCK DATA ADDRESS IN S1.
CHKO.2: PUSHJ P,FNDOBJ ;GO FIND THE OBJECT BLOCK.
JUMPF .RETF ;NOT THERE,,THATS AN ERROR.
$RETT ;RETURN.
MSGOBJ: MOVEI S1,ABO.TY(M) ;GET ABORT MSG OBJ ADDRESS.
MOVEI S1,RCK.TY(M) ;GET CHECKPOINT MSG OBJ ADDRESS.
MOVEI S1,.EQROB(M) ;GET NEXTJOB MSG OBJ ADDRESS.
SUBTTL 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 KILL -- 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))
$TEXT (<-1,,J$WTOR(J)>,<Canceled by User ^U/ABO.ID(M)/^0>)
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,@J$FLSH(J) ;FLUSH THE OUTPUT BUFFERS
JUMPF SHUTND ;CANT,,SHUT IT DOWN !!!
$RETT ;RETURN
SUBTTL QSRNWA - ROUTINE TO SHUTDOWN A STREAM 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
SKIPE S1,J$DIFN(J) ;GET THE IFN
PUSHJ P,F%REL ;YES, CLOSE IT
SETZM J$DIFN(J) ;Clear the IFN
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 DSTATUS -- Send status info
COMMENT \
The purpose of this routine is to provide a uniform means
of handling checkpointing within a stream. It decides whether to
send status messages.
There are 2 kinds of messages. UPDATE is an update status message
and is sent every time the actual status of the stream changes.
CHKPNT is a checkpoint message that describes the current state
of the job on the stream.
UPDATE is called based on JOBUPD.
CHKPNT is called based on JOBCHK or elapsed time since last CHKPNT. The
time till next checkpoint is set if called. If JOBCHK is 0, CHKPNT
is always called.
THIS IS THE ONLY ROUTINE THAT SHOULD CALL UPDATE OR CHKPNT!
No parameters are passed.
Always returns $RET. (Cannot fail)
\ ;End of comment
DSTATUS:$SAVE <P1,P2> ;Save 2 perm. registers
MOVE P1,STREAM ;Get the stream number
SKIPE JOBUPD(P1) ;Do we need status update?
$CALL UPDATE ;Do the status update
SETZM JOBUPD(P1) ;Turn flag off
SKIPN JOBACT(P1) ;Nothing to checkpoint if not active!
$RET
$CALL I%NOW ;Find the time
MOVE P2,S1 ;Save the time
SUB S1,JOBCHK(P1) ;current time - time to checkpoint
SKIPGE S1 ;Time to checkpoint yet?
$RET ;No.
TXNE S,INJOB ;Are we in a JOB?
$CALL CHKPNT ;Yes, do the checkpoint
ADDI P2,CKPTIM*3 ;Add number of 1/3s of seconds
; to the current time
MOVEM P2,JOBCHK(P1) ;Save the time to do next chkpoint
$RET
SUBTTL CHKPNT -- Request for Checkpoint
COMMENT \
This routine is to checkpoint the currently active job on the current stream.
It should only be called by DSTATUS since that routine will verify that the
stream is currently active. DSTATUS will also update the time for the next
checkpoint to occur.
\
CHKPNT: MOVEI T1,MSGBLK ;LOAD THE ADDRESS OF THE MESSAGE BLK.
MOVX S1,CH.FST ;REQUEST STATUS UPDATE
SKIPE J$POSF(J) ;DRIVER ALLOW FILE POSITIONING?
TXO S1,CH.FCH ;YES--REQUEST CHECKPOINTING TOO
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)/^A>) ;START STATUS MESSAGE
PUSHJ P,@J$STST(J) ;FINISH STATUS MESSAGE
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
LPTSTS::$TEXT (DEPBP,<, printed ^D/J$APRT(J)/ of ^D/J$RLIM(J)/ pages^0>)
POPJ P, ;RETURN
SUBTTL UPDATE -- ROUTINE TO SEND STATUS UPDATES TO QUASAR
COMMENT \
This routine sends a status update message to QUASAR. It should only
be called by DSTATUS since it depends on DSTATUS to clear the status
request flag and P1 is set by DSTATUS to contain the stream number.
\
UPDATE: MOVE S2,JOBPAG(P1) ;Get the jobpage
MOVE S2,JOBSTW(P1) ;GET THE JOBS STATUS WORD
MOVX S1,%RESET ;DEFAULT TO RESET
SKIPE J$APRG(J) ;ARE WE ALIGNING FORMS ???
MOVX S1,%ALIGN ;YES, SAY SO
TXNE S2,PSF%OR ;ARE WE WAITING FOR OPR RESPONSE ???
MOVX S1,%OREWT ;YES, SAY SO
TXNE S2,PSF%ST ;ARE WE STOPPED ???
MOVX S1,%STOPD ;YES, SAY SO
TXNE S2,PSF%MW ;ARE WE IN MOUNT WAIT?
MOVX S1,%MWAIT ;YES, SAY SO
TXNE S2,PSF%DO ;ARE WE OFFLINE ???
MOVX S1,%OFLNE ;YES, SAY SO
TXNE S2,PSF%OO ;ARE WE WAITING FOR OPERATOR OUTPUT ???
MOVX S1,%OPRWT ;YES, SAY SO
MOVEI T1,MSGBLK ;GET THE MESSAGE BLOCK ADDRESS
MOVEM S1,STU.CD(T1) ;SAVE THE STATUS
HRLZ S1,JOBOBA(P1) ;GET THE OBJECT BLOCK ADDRESS
HRRI S1,STU.RB(T1) ;GET DESTINATION ADDRESS
BLT S1,STU.RB+OBJ.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 TO QUASAR
$RETT ;AND RETURN
SUBTTL SETUP/SHUTDOWN Message processing
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
STOPCD (TMS,HALT,,<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
CAME S1,CNTSTA ;IS IT A LOCAL LPT ???
SETOM J$LREM(J) ;NO--MAYBE ANF REMOTE
MOVSI S1,J$DWDS(J) ;START OF DRIVER DATA
HRRI S1,J$DWDS+1(J) ;MAKE A BLT POINTER
SETZM J$DWDS(J) ;CLEAR FIRST WORD
BLT S1,J$DWDS+DRVWDS-1(J) ;CLEAR ENTIRE BLOCK
;Continued on the next page
;Continued from the previous page
SETOM J$LCHN(J) ;No output channel yet
MOVX S1,SUFLAT ;
TDNN S1,SUP.FL(M) ;Is this a LAT server?
JRST SETU.3 ;No, no need to set up terminal
MOVE S1,M ;Get address of SETUP message
PUSHJ P,LATSUP ;Set up the terminal
JUMPT SETU.3 ;Got it: continue
PUSH P,TF ;No extra attributes
PUSH P,S1 ;
JRST SETU.7 ;Go away
SETU.3: MOVE P1,DEVLST ;POINT TO START OF DEVICE DRIVER CHAIN
SETU.4: PUSHJ P,@J$INIT-J$$DEV(P1) ;INITIALIZE
JUMPT SETU.6 ;ALL SET
JUMPL S1,SETU.5 ;JUMP IF NOT FOR THIS DRIVER
PUSH P,TF ;NO EXTRA ATTRIBUTES
PUSH P,S1 ;SAVE RESPONSE TO SETUP CODE
JRST SETU.7 ;AND GO AWAY
SETU.5: SKIPE P1,(P1) ;POINT TO NEXT DRIVER
JRST SETU.4 ;LOOP BACK
PUSH P,TF ;NO EXTRA ATTRIBUTES
PUSH P,[%RSUNA] ;SAY DEVICE NOT AVAILABLE RIGHT NOW
JRST SETU.7 ;GO CLEAN UP
SETU.6: PUSH P,S2 ;SAVE EXTRA ATRIBUTES IF ANY
PUSHJ P,@J$OPEN(J) ;OPEN CHANNEL FOR OUTPUT
PUSH P,S1 ;SAVE RESPONSE TO SETUP CODE
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.
MOVE S1,(P) ;GET RESPONSE CODE BACK
SETU.7: MOVE S1,(P) ;GET RESPONSE TO SETUP CODE
MOVE S2,-1(P) ;GET EXTRA ATTRIBUTES
PUSHJ P,RSETUP ;TELL QUASAR WHAT'S GOING ON
MOVE S1,STREAM ;GET STREAM NUMBER
POP P,S2 ;AND RESPONSE CODE AGAIN
POP P,(P) ;SYNCH STACK
$WTO (<^T/@SETMSG(S2)/>,,@JOBOBA(S1))
AOS SSETUP ;ASSUME SETUP WAS OK
CAIE S2,%RSUOK ;ALL IS OK?
JRST [$CALL SHUTND ;NO, SHUT IT DOWN
$RETT]
MOVE S1,J$LTYP(J) ;GET PRINTER TYPE
CAMN S1,['DN60 '] ;DN60 PRINTER?
SETZM BYEUDT ;KEEP US FROM LOGGING OUT WHEN IDLE
;LPTSPL HANDLES DN60 REMOTE OPR MSGS
$RETT
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
TDZA T4,T4 ;T4 = 1, SHUTDOWN MSG FROM QUASAR
SHUTND::SETOM T4 ;INDICATE 'OUT OF STREAM' CONTEXT
AOSA T4 ;T4 = 0 'OUT OF STREAM' CONTEXT
SHUTIN::SETOM T4 ;INDICATE 'IN STREAM' CONTEXT
SKIPL J$LCHN(J) ;DO WE HAVE AN OUTPUT CHANNEL ???
PUSHJ P,@J$CLOS(J) ;YES, RELEASE THE OBJECT
SKIPE S1,J$DIFN(J) ;Get the IFN
PUSHJ P,F%REL ;YES, CLOSE IT
SETZM J$DIFN(J) ;Clear the IFN
SKIPGE T4 ;ARE WE IN STREAM CONTEXT ???
MOVE P,[IOWD PDSIZE,PDL] ;YES, GET A NEW STACK POINTER
SKIPE J$SHUT(J) ;Device initialized yet?
PUSHJ P,@J$SHUT(J) ;YES, HANDLE DEVICE SPECIFIC SHUTDOWN
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
MOVX S2,PSF%OR ;GET OPR RESP WAIT BIT
TDNE S2,JOBSTW(S1) ;ARE WE WAITING FOR THE OPERATOR ???
$KWTOR (JOBWAC(S1)) ;YES, KILL THE WTOR
SETZM JOBWAC(S1) ;Clear it just in case
SOS SSETUP ;DECREMENT STREAM SETUP COUNT
JUMPE T4,.RETT ;'OUT OF STREAM',,JUST RETURN
JUMPL T4,MAIN.6 ;'IN STREAM',,RETURN TO THE SCHEDULER
SKIPN BYEUDT ;%STCMD PROCESSOR?
SKIPE SSETUP ;YES, ANY STREAMS LEFT SETUP?
$RETT ;NOT %STCMD OR STREAMS STILL SETUP
PJRST SHTBYE ;%STCMD AND NO MORE STREAMS
SUBTTL RSETUP -- ROUTINE TO SEND A RESPONSE-TO-SETUP MSG TO QUASAR
RSETUP::DMOVE T2,S1 ;SAVE THE SETUP CONDITION CODE & ATTRIB
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
CAXN T2,%RSUOK ;GOOD SETUP?
MOVEM T3,RSU.FL(T1) ;YES STORE POSSIBLE EXTRA ATTRIBS
MOVX S1,%LOWER ;GET LOWER-CASE BIT
SKIPL J$LLCL(J) ;IS PRINT LOWER CASE?
MOVX S1,%UPPER ;NO, LOAD THE UPPER CASE FLAG
STORE S1,RSU.DA(T1),RO.ATR ;STORE THE DEVICE ATRRIBUTES
MOVE S1,J$LTYP(J) ;GET SIXBIT UNIT TYPE
MOVEM S1,RSU.UT(T1) ;SAVE IN MESSAGE
PUSHJ P,SNDQSR ;AND SEND THE MESSAGE
$RETT ;RETURN.
SUBTTL OACRSP -- OPERATOR RESPONSE TO A WTOR PROCESSOR.
OACRSP: SETOM JOBITS ;DON'T UPDATE STATUS BITS
MOVE S2,.MSCOD(M) ;GET WTOR ACK CODE.
MOVSI S1,-NPRINT ;CREATE AOBJN AC.
RESP.1: CAME S2,JOBWAC(S1) ;COMPARE ACK CODES..
JRST [AOBJN S1,RESP.1 ;NOT EQUAL,,CHECK NEXT STREAM.
$RETT ] ;NOT THERE,,FLUSH THE MSG.
MOVX S2,PSF%OR ;GET "OPERATOR-RESPONSE" WAIT BIT
ANDCAM S2,JOBSTW(S1) ;AND CLEAR IT
SETOM JOBUPD(S1) ;Update the stream's status
MOVE J,JOBPAG(S1) ;GET THE STREAM DB ADDRESS.
DMOVE S1,.OHDRS+ARG.DA(M) ;GET THE OPERATORS RESPONSE.
DMOVEM S1,J$RESP(J) ;AND SAVE IT.
$RETT ;AND RETURN
SUBTTL 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
SKIPE S1,J$DIFN(J) ;GET THE FILE IFN.
PUSHJ P,F%REL ;ELSE,,CLOSE IT OUT.
SETZM J$DIFN(J) ;Clear the IFN
MOVEM S,J$RACS+S(J) ;SAVE THE 'S' AC WITH NEW DSKOPN BITS
;**;[3010] Delete 3 lines at OACC.0+14L and 1 line at OACC.0+19L. /LWS
SETZM JOBACT(P1) ;STREAM IS NO LONGER ACTIVE
PUSHJ P,QRELEASE ;RELEASE THE REQUEST
$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
$TEXT (<-1,,J$WTOR(J)>,<Job aborted by the Operator^0>)
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,@J$FLSH(J) ;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.
SETZM JOBCHK(S1) ;SAY WE WANT A CHECKPOINT TAKEN.
SETOM JOBUPD(S1) ;Update the status also.
$RETT ;AND RETURN
SUBTTL OACCON -- Operator CONTINUE request.
OACCON: MOVE S1,STREAM ;GET THE STREAM NUMBER
MOVX S2,PSF%ST!PSF%DO ;LOAD THE BITS
ANDCAM S2,JOBSTW(S1) ;CLEAR IT
$ACK (Continued,,@JOBOBA(S1),.MSCOD(M)) ;TELL THE OPERATOR.
SETOM JOBUPD(S1) ;Do an update
; don't need checkpoint
; did one when we stopped
$RETT ;AND RETURN
SUBTTL 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.
SKIPE J$POSF(J) ;DRIVER ALLOW POSITIONING?
JRST OALI.0 ;YES--CONTINUE
MOVE S1,STREAM ;GET OUR STREAM
$ACK (<ALIGN not valid for ^T/@J$DRIV(J)/ printers>,,@JOBOBA(S1),.MSCOD(M))
$RETT
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 JOBUPD(S1) ;Update the status
$RETT ;RETURN.
OALI.3: MOVE S1,STREAM ;GET STREAM NUMBER
;**;[3000] Insert 1 line and change 1 line at OALI.3+1L. /LWS
SETZM J$APRG(J) ;[3000] AVOID CONFUSION,,CAN'T ALIGN
$WTO (<Alignment Not Scheduled>,<Cannot read ALIGN file ^F/@J$XFOB+FOB.FD(J)/ - ^E/[-1]/>,@JOBOBA(S1)) ;[3000]
$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 Discontinued,,@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.
SETZM JOBCHK(S1) ;SAY WE WANT TO TAKE A CHECKPOINT.
SKIPE J$POSF(J) ;DRIVER ALLOW POSITIONING?
JRST OACF.0 ;YES--CONTINUE
MOVE S1,STREAM ;GET OUR STREAM
$ACK (<FORWARDSPACE not valid for ^T/@J$DRIV(J)/ printers>,,@JOBOBA(S1),.MSCOD(M))
$RETT
OACF.0: PUSHJ P,GETBLK ;GET A MESSAGE BLOCK
JUMPF .RETT ;NO MORE, RETURN
CAIN T1,.SPPAG ;IS THIS FORWARD SPACE PAGES ???
PJRST FSPACE ;YES, DO IT
CAIN T1,.SPCPY ;IS THIS FORWARD SPACE COPIES ???
PJRST FCOPYS ;YES, DO IT
CAIN T1,.SPFIL ;IS THIS FORWARD SPACE 1 FILE ???
PJRST FFILES ;YES, DO IT
JRST OACF.0 ;NONE OF THESE,,TRY NEXT BLOCK
FSPACE: SKIPN J$DIFN(J) ;IS THERE A SPOOL FILE OPEN ???
$RETT ;NO, JUST IGNORE THIS
TXO S,FORWRD ;TURN ON FORWARD SPACE BIT.
MOVE S2,0(T3) ;PICK UP # OF PAGES TO FSPACE.
;**;[4005]INSERT 1 LINE AT FSPACE:+5L 13-MAY-85/CTK
ADDM S2,J$FPIG(J) ;[4005]ADD TO FORWARDSPACE PAGE CNT
MOVE S1,STREAM ;PICK UP THE STREAM NUMBER.
$ACK (<Forward spaced ^D/S2/ Pages>,,@JOBOBA(S1),.MSCOD(M))
;**;[2774] Change 1 line at FSPACE+7L. 25-Oct-83 /LWS
$TEXT (LOGCHR,<^I/LPMSG/File ^F/@J$DFDA(J)/^T/J$GSPL(J)/ Forward spaced ^D/J$FPIG(J)/ Pages>) ;[2774]
$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.
;**;[2774] Changed 1 line at FCOPYS+2L. 25-Oct-83 /LWS
$TEXT (LOGCHR,<^I/LPMSG/File ^F/@J$DFDA(J)/^T/J$GSPL(J)/ Forward spaced ^D/S2/ Copies>) ;[2774]
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))
;**;[2774] Changed 1 line at FFILES+2L. 25-Oct-83 /LWS
$TEXT (LOGCHR,<^I/LPMSG/File ^F/@J$DFDA(J)/^T/J$GSPL(J)/ Skipped by Operator>) ;[2774]
PUSHJ P,INPFEF ;FORCE AN END OF FILE
TXO S,SKPFIL ;TURN ON SKIP FILE FLAG
$RETT ;AND RETURN
SUBTTL OACBKS -- 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.
SETZM JOBCHK(S1) ;SAY WE WANT TO TAKE A CHECKPOINT.
SKIPE J$POSF(J) ;DRIVER ALLOW POSITIONING?
JRST OACB.0 ;YES--CONTINUE
MOVE S1,STREAM ;GET OUR STREAM
$ACK (<BACKSPACE not valid for ^T/@J$DRIV(J)/ printers>,,@JOBOBA(S1),.MSCOD(M))
$RETT
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))
;**;[2774] Changed 1 line at BSPACE+3L. 25-Oct-83 /LWS
$TEXT (LOGCHR,<^I/LPMSG/File ^F/@J$DFDA(J)/^T/J$GSPL(J)/ Backspaced ^D/T1/ Pages>) ;[2774]
SKIPN J$DIFN(J) ;IS THERE A SPOOL FILE OPEN ???
$RETT ;NO, JUST RETURN.
ADDM T1,J$RLIM(J) ;Up the limit to compensate for the
; backspace
TXO S,FCONV ;We will start next on new line
SETOM J$DBCT(J) ;RESET THE INPUT BYTE COUNT
SETZM J$FPIG(J) ;ZERO THE FORWARD SPACE PAGE COUNTER
SETZM J$FCBC(J) ;CLEAR THE CURRENT INPUT BUFFER BYTE CNT
MOVE S1,J$FLIN(J) ;GET LINES PER PAGE
MOVEM S1,J$XPOS(J) ;RESET THE PAGE POSITION TO TOP OF PAGE
MOVX S1,.CHFFD ;GET A FORM FEED
MOVEM S1,J$RACS+C(J) ;CONVERT NXT CHAR TO FORM FEED
MOVE S1,J$RNPP(J) ;GET THE # OF PAGES PRINTED SO FAR.
SUB S1,T1 ;CALC DESTINATION PAGE NUMBER
SKIPGE S1 ;CAN'T BE NEGATIVE
SETZM S1 ;IF SO,,MAKE IT ZERO
JUMPLE S1,BSPA.2 ;MORE THEN WE PRINTED,,JUST REWIND FILE
CAXLE T1,PAGSIZ ;REQUESTING MORE THEN WE'RE TRACKING ??
JRST BSPA.2 ;YES, REWIND THE FILE
MOVE S2,J$FBPT(J) ;GET THE PAGE TABLE ENTRY POINTER
SUBI S2,J$FPAG(J) ;CALC INDEX TO CURRENT PAGE
SUBI S2,1(T1) ;CALC INDEX TO NEW PAGE
JUMPGE S2,BSPA.1 ;IF POSITIVE,,THEN NO PROBLEM
TXNN S,FBPTOV ;ELSE CHECK FOR PAGE TABLE OVERFLOW
JRST BSPA.2 ;NO, HMMMMM,,JUST REWIND THE FILE
ADDI S2,J$FPAG+PAGSIZ(J) ;GET TABLE ENTRY FROM THE TOP
SKIPA ;SKIP NON OVERFLOW PATH
BSPA.1: ADDI S2,J$FPAG(J) ;GET TABLE ENTRY FROM THE BOTTOM
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
MOVEM S1,J$RNPP(J) ;RESET PAGE POINTER FOR THIS FILE
MOVEI S1,1(S2) ;POINT TO NEXT PAGE TBL ENTRY
CAIL S1,J$FPAG+PAGSIZ(J) ;Want to wrap around?
JRST [MOVEI S1,J$FPAG(J) ;Yes, start at the beginning
TXO S,FBPTOV ;Say we overflowed
JRST .+1] ;And continue
MOVEM S1,J$FBPT(J) ;AND MAKE THIS THE CUR TBL ENTRY ADDR
MOVE S2,0(S2) ;PICK UP THE LISTING PAGE ADDRESS
MOVEM S2,J$FTBC(J) ;AND MAKE THIS THE TOTAL BUFR BYTE COUNT
MOVE S1,J$DIFN(J) ;GET THE SPOOL FILE IFN
PUSHJ P,F%POS ;POSITION TO THAT PAGE IN THE FILE
$RETT ;AND RETURN
BSPA.2: PUSH P,S1 ;SAVE THE DESTINATION PAGE #
PUSHJ P,INPREW ;REWIND THE SPOOL FILE
POP P,S1 ;RESTORE DESTINATION PAGE NUMBER
JUMPLE S1,.RETT ;IF NO SLACK DATA,,SKIP FORWARD SPACE
MOVEM S1,J$FPIG(J) ;SAVE THE # OF PAGES TO FORWARD SPACE
TXO S,FORWRD ;LITE FORWARD SPACE BIT
$RETT ;RETURN
SUBTTL BCOPYS -- BACKSPACE 'COPIES'
BCOPYS: MOVE S2,J$RNCP(J) ;PICK UP # OF COPIES ALREADY PRINTED.
MOVE T1,0(S1) ;PICK UP # OF COPIES TO BSPACE.
SUB S2,T1 ;SUBTRACT # OF COPIES TO BSPACE.
MOVEM S2,J$RNCP(J) ;SAVE THE NEW COPIES VALUE.
;**;[2774] Changed 1 line at BCOPYS+4L. 25-Oct-83 /LWS
$TEXT (LOGCHR,<^I/LPMSG/File ^F/@J$DFDA(J)/^T/J$GSPL(J)/ Backspaced ^D/T1/ Copies>) ;[2774]
MOVE S1,STREAM ;PICK UP STREAM NUMBER.
$ACK (<Backspaced ^D/T1/ Copies>,,@JOBOBA(S1),.MSCOD(M))
PUSHJ P,INPFEF ;FORCE END OF FILE.
$RETT ;RETURN.
SUBTTL BFILES -- BACKSPACE 'FILES'
BFILES: PUSHJ P,INPFEF ;FORCE AN END-OF-FILE
TXO S,SKPFIL+BCKFIL ;LITE SKIP FILE AND BACKSPACE'ED BITS
SETOM J$RNFP(J) ;RESET THE FILE COUNTER
MOVE S1,J$RFLN(J) ;GET THE FILE COUNT
LOAD S2,.EQSPC(J),EQ.NUM ;GET THE NUMBER OF FILES
MOVEM S2,J$RFLN(J) ;SAVE IT
SUB S2,S1 ;CALC HOW FAR WE HAVE GONE SO FAR
LOAD E,.EQLEN(J),EQ.LOH ;GET THE HEADER LENGTH
ADD E,J ;POINT TO THE FIRST FP
BFIL.1: SOJLE S2,BFIL.2 ;LOOP THROUGH THE FP/FD'S TILL
PUSHJ P,NXTFIL ;WE GET TO THE CURRENT FILE
AOS J$RNFP(J) ;MINUS ONE
JRST BFIL.1 ;CONTINUE TILL DONE
BFIL.2: MOVE S1,STREAM ;GET OUR STREAM NUMBER
$ACK (<Backspaced 1 File>,,@JOBOBA(S1),.MSCOD(M))
LOAD S1,.FPLEN(E),FP.LEN ;GET THE FP LENGTH
ADD S1,E ;POINT TO THE FD
$TEXT (LOGCHR,<^I/LPMSG/Backspaced to Beginning of ^F/0(S1)/>)
MOVEM E,J$RACS+E(J) ;UPDATE AC 'E' IN STREAM DATA BASE
$RETT
PAGES: 0,,0
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.
SETZM JOBCHK(S1) ;SAY WE WANT TO CHECKPOINT.
SETOM JOBUPD(S1) ; send update message also
$RETT ;AND RETURN
ALIG.3: MOVE S1,J$AIFN(J) ;GET ALIGN IFN.
PUSHJ P,F%IBUF ;GET AN ALIGN BUFFER.
JUMPF ALIG.2 ;IF NO MORE,,SLEEP A WHILE.
MOVEM S1,J$ABYT(J) ;SAVE THE # OF BYTES.
MOVEM S2,J$APTR(J) ;SAVE THE BYTE POINTER.
JRST ALIG.1 ;KEEP ON PROCESSING.
ALIG.4: MOVE S2,STREAM ;PICK UP STREAM NUMBER.
PUSHJ P,I%NOW ;GET CURRENT TIME.
ADD S1,J$ASLP(J) ;ADD /PAUSE VALUE.
MOVEM S1,JOBWKT(S2) ;SAVE WAKE UP TIME FOR STREAM.
$DSCHD (PSF%AL) ;SHOW STREAM BLOCKED FOR ALIGNMENT.
JRST ALIGN ;WHEN RETURN,,CONTINUE.
SUBTTL 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 IDLBYE AND SHTBYE - SAY GOODBYE TO QUASAR
IDLBYE: MOVX T3,IDLMIN ;GET MINUTES OF IDLENESS
SKIPA T2,[EXP IDLTXT] ;GET ITEXT FOR WTO
SHTBYE: MOVEI T2,SHTTXT
MOVEI T1,HELLO ;GET HELLO MSG ADDRESS
MOVEI S1,1
STORE S1,HEL.FL(T1),HEFBYE ;MAKE IT A GOODBYE MSG
PUSHJ P,SNDQSR ;SEND IT OFF
$WTO (<LPTSPL logging out>,<^I/(T2)/>,,$WTFLG(WT.SJI))
$CALL I%KJOB ;THAT'S ALL FOLKS
STOPCD (CNL,HALT,,<Could not logout. Call to I%KJOB failed>)
IDLTXT: ITEXT (<All streams have been idle for ^D/T3/ minutes>)
SHTTXT: ITEXT (<All streams have been shut down>)
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
STOPCD (QSF,HALT,,<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
MOVE S1,STREAM ;Get the stream number
SETOM JOBUPD(S1) ;Say we want a status update
$CALL DSTATUS ;Do it
SETZM 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
$CALL .ZPAGA ; Make sure page is zeroed of residue
JRST LOGB.1] ;AND CONTINUE ON
CAIL P1,^D10 ;NO, WITHIN RANGE?
STOPCD (TML,HALT,,<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 ACTBEG -- ACCOUNTING INITIALIZATION ROUTINE
ACTBEG: LOAD S1,.EQSEQ(J),EQ.SEQ ;GET SEQUENCE NUMBER
STORE S1,J$ASEQ(J) ;STORE IT
LOAD S1,.EQSEQ(J),EQ.PRI ;GET EXTERNAL PRIORITY
STORE S1,J$APRI(J) ;STORE IT
TOPS20< MOVX S1,.FHSLF ;GET FORK HANDLE
RUNTM > ;GET MY RUNTIME
TOPS10<
IFG <NPRINT-1>,< ;If more than one printer
MOVEI S1,0 ;Dont account for runtime
>
IFE <NPRINT-1>,< ;If just one printer
MOVEI S1,0 ;Get runtime for this job
RUNTIM S1, ;from the monitor
>
>;END TOPS10
MOVNM S1,J$ARTM(J) ;REMEMBER IT NEGATED
$RETT ;RETURN
SUBTTL ACTEND -- ACCOUNTING SUMMARY ROUTINE
ACTEND: SKIPN S1,DEBUGW ;SKIP IF DEBUGGING
LOAD S1,.EQSEQ(J),EQ.IAS ;GET THE INVALID ACCT STRING BIT
JUMPN S1,.RETT ;IF LIT,,THEN JUST RETURN
IFN FTACNT,<
TOPS20< MOVX S1,.FHSLF ;LOAD FORK HANDLE
RUNTM ;GET RUNTIME
ADDM S1,J$ARTM(J) ;STORE IT
MOVX S1,.USENT ;WRITE AN ENTRY
MOVEI S2,ACTLST ;POINT TO THE LIST
USAGE ;DO THE JSYS
ERJMP ACTE.1 ;ON AN ERROR,,TELL THE OPERATOR
> ;END TOPS20 ACCOUNTING
TOPS10<
IFG <NPRINT-1>,< ;If more than one printer
SETZM J$ARTM(J) ;Zap the runtime
>
IFE <NPRINT-1>,< ;If just one printer
SETZM S1 ;Get the runtime for this job
RUNTIM S1, ;Ask monitor
ADDM S1,J$ARTM(J) ;Calc run time to process the request
>
PUSHJ P,I%NOW ;GET THE CURRENT TIME
SUB S1,J$RTIM(J) ;GET JIFFIES OF CONNECT TIME
IDIVI S1,3 ;GET NUMBER OF SECONDS
MOVEM S1,LPCON ;SAVE THE CONNECT TIME
MOVE S1,[.NDRNN,,S2] ;GET CONVERT TO NAME FCT CODE
MOVEI S2,2 ;A BLOCK LENGTH OF 2
MOVE T1,.EQROB+.ROBND(J) ;GET THE NODE NUMBER
FACT< HRLZM T1,FACTBL+3 > ;STORE NODE NUMBER NOW
NODE. S1, ;CONVERT IT
SKIPA ;SKIP ON AN ERROR
MOVEM S1,.EQROB+.ROBND(J) ;SAVE THE NODE NAME
MOVE S1,[ACTLEN,,ACTLST] ;GET THE PARM BLOCK LENGTH,,ADDRESS
QUEUE. S1, ;REQUEST ACCOUNTING BE DONE
TRNA ;ERROR, ANALYZE THE CODE
JRST ACTE.A ;GOOD RETURN, CONTINUE
CAIE S1,QUCNR% ;IS ERROR DUE TO COMPONENT NOT RUNNING?
PUSHJ P,ACTE.1 ;NO, FAILED,,TELL OPR
ACTE.A:
FACT< MOVE S1,LPLNO ;GET LINE NUMBER
LDB S2,[POINT 7,LPTRM,6] ;GET TERMINAL DESIGNATOR
CAIN S2,"C" ;ON THE CTY
MOVEI S1,7777 ;YES, CTY DESIGNATOR
CAIN S2,"D" ;DETACHED
MOVEI S1,7776 ;YES, FLAG THAT INSTEAD OF LINE NUMBER
LSH S1,6 ;PUT IN BITS 18-29
HRL S1,LPJOB ;INSERT JOB NUMBER
IOR S1,[251000,,13] ;ADD FACT TYPE AND NUMBER OF WORDS
MOVEM S1,FACTBL+0 ;STORE IN BLOCK
MOVE S1,.EQOID(J) ;GET PPN
MOVEM S1,FACTBL+1 ;STORE
SETZM FACTBL+2 ;DAEMON FILLS IN THE DATE/TIME
MOVE S1,[%CNSER] ;CPU SERIAL NUMBER
GETTAB S1, ;ASK FOR IT
SETZ S1, ;USE 0 IF CAN'T FIND IT
TLO S1,'LP ' ;QUEUE NAME = LPTSPL
IORM S1,FACTBL+3 ;NODE NUMBER ALREADY STORED FROM ABOVE
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
MOVE S1,J$ARTM(J) ;RUN TIME IN MILLISECONDS
MOVEM S1,FACTBL+4 ;STORE
SETZM FACTBL+5 ;*** CORE TIME INTERGRAL
MOVE S1,J$ADRD(J) ;DISK READS
MOVEM S1,FACTBL+6 ;STORE
SETZM FACTBL+7 ;NO DISK WRITES
MOVE S1,J$LDEV(J) ;DEVICE NAME
MOVEM S1,FACTBL+10 ;STORE
MOVE S1,J$ASEQ(J) ;SEQUENCE NUMBER
MOVEM S1,FACTBL+11 ;STORE
MOVE S1,J$APRT(J) ;NUMBER OF PAGES PRINTED
MOVEM S1,FACTBL+12 ;STORE
MOVE S1,[FACSIZ+1,,FACTBL-1] ;DAEMON ARGUMENT
DAEMON S1, ;MAKE THE FACT ENTRY
JRST ACTE.1 ;REPORT THE FAILURE
> ;END FACT ACCOUNTING
> ;END TOPS10 ACCOUNTING
$RETT ;IF OK,,RETURN
ACTE.1: MOVE S1,STREAM ;GET THIS STREAM NUMBER
$WTO (System Accounting Failure,<^R/.EQJBB(J)/>,@JOBOBA(S1))
> ;END IFN FTACNT
$RETT ;RETURN
SUBTTL ACTLST -- SPOOLER ACCOUNTING RECORD
IFN FTACNT,< SEARCH ACTSYM ;SEARCH THE ACCOUNTING UNV
ACTLST: USENT. (.UTOUT,1,1,0)
USTAD. (-1) ;CURRENT DATE/TIME
USPNM. (<SIXBIT/LPTSPL/>,US%IMM) ;PROGRAM NAME
USPVR. (%%.LPT,US%IMM) ;PROGRAM VERSION
USAMV. (-1) ;ACCOUNTING MODULE VERSION
USNOD. (.EQROB+.ROBND(J)) ;NODE NAME
USSRT. (J$ARTM(J)) ;RUN TIME
USSDR. (J$ADRD(J)) ;DISK READS
USSDW. (0,US%IMM) ;DISK WRITES
USJNM. (.EQJOB(J)) ;JOB NAME
USQNM. (<SIXBIT /LPT/>,US%IMM) ;QUEUE NAME
USSDV. (J$LDEV(J)) ;DEVICE NAME
USSSN. (J$ASEQ(J)) ;JOB SEQUENCE NUMBER
USSUN. (J$APRT(J)) ;TOTAL PAGES PRINTED
USSNF. (J$AFXC(J)) ;TOTAL FILES PROCESSED
USCRT. (.EQAFT(J)) ;CREATION DATE/TIME OF REQUEST
USSCD. (J$RTIM(J)) ;SCHEDULED DATE/TIME
USFRM. (J$FORM(J)) ;FORMS TYPE
USDSP. (<SIXBIT/NORMAL/>,US%IMM) ;DISPOSITION
USPRI. (J$APRI(J)) ;JOB PRIORITY
TOPS20< USJNO. (-1) ;JOB NUMBER
USTRM. (-1) ;TERMINAL DESIGNATOR
USLNO. (-1) ;TTY LINE NUMBER
USTXT. (<-1,,[ASCIZ / /]>) ;SYSTEM TEXT
USNM2. (<POINT 7,.EQOWN(J) >) ;USER NAME (TOPS20)
USACT. (<POINT 7,.EQACT(J) >) ;ACCOUNT STRING POINTER
0 ;END OF LIST
> ;END TOPS20 ACCOUNTING
TOPS10< USNM1. (.EQOWN(J)) ;USER NAME 1 (TOPS10)
USNM3. (.EQOWN+1(J)) ;USER NAME 1 (TOPS10)
USORI. (.EQRID(J)) ;USER REQUEST ID
USPPN. (.EQOID(J)) ;USER PPN
USJNO. (LPJOB) ;JOB NUMBER
USTRM. (LPTRM) ;TERMINAL DESIGNATOR
USLNO. (LPLNO) ;TTY LINE NUMBER
USOCN. (LPCON) ;CONNECT TIME
USOAC. (<POINT 7,.EQACT(J) >) ;ACCOUNT STRING POINTER
> ;END TOPS10 ACCOUNTING
ACTLEN==.-ACTLST ;ACCOUNTING BLOCK LENGTH
FACT< FACSIZ==13 ;Size of fact accounting block
EXP .FACT ;DAEMON WRITE FACT FILE FUNCTION
FACTBL: BLOCK FACSIZ > ;FACT BLOCK FILLED IN
> ;END IFN FTACNT
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
SETZM J$XFOB+FOB.US(J) ;DEFAULT TO NO ACCESS CHECKING
SETZM J$XFOB+FOB.CD(J) ;HERE ALSO
LOAD S1,.EQSEQ(J),EQ.PRV ;GET THE USERS PRIVILGE BITS
JUMPN S1,INPO.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
;**;[2774] Insert 7 lines after INPO.1+4L. 25-Oct-83 /LWS
SETZM J$GSPL(J) ;[2774] ASSUME NOT SPOOLED
LOAD S2,.FPINF(E),FP.SPL ;[2774] GET SPOOLED FILE BIT
JUMPE S2,.RETT ;[2774] RETURN IF NOT SPOOLED
MOVX S2,FI.SPL ;[2774] GET ATTRIBUTE WE WANT
$CALL F%INFO ;[2774] ASK FOR SPOOLED FILE NAME
JUMPE S1,.RETT ;[2774] RETURN IF NONE
$TEXT(<-1,,J$GSPL(J)>,< ^W/S1/^0>) ;[2774] SAVE NAME AS ASCIZ STRING
; (WITH LEADING SPACE)
$RETT ;AND RETURN
INPO.2: ZERO .FPINF(E),FP.DEL ;CLEAR THE 'DELETE FILE' BIT
PUSHJ P,@J$FLER(J) ;DO FILE LOOKUP ERROR PROCESSING
$RETF ;RETURN
LPTLER::$TEXT(LOGCHR,<^I/LPERR/Can't access file ^F/@J$DFDA(J)/, ^E/[-1]/>)
$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
TXO S,SKPFIL ;SKIP THE REST OF THE FILE
PUSHJ P,@J$FIER(J) ;DO FILE INPUT ERROR PROCESSING
$RETF ;RETURN
LPTIER::$TEXT(LOGCHR,<^I/LPERR/Error reading input file; ^E/[-1]/>)
$RETF ;AND RETURN
SUBTTL INPFEF -- Force end-of-file on next input
INPFEF::SKIPN S1,J$DIFN(J) ;IS THE SPOOL FILE OPEN ???
$RETT ;NO, JUST RETURN
SETOB S2,J$DBCT(J) ;CLEAR BYTE COUNT AND SET EOF POS
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: TXNE S,ABORT ;ARE WE ABORTING?
$RETF ;YES, END THE REQUEST
TXZ S,FRMSOK ;CLEAR FORMS OK FLAG
GETLIM S1,.EQLIM(J),FORM ;GET THE FORMS TYPE
CAMN S1,J$FORM(J) ;OR ARE FORMS EXACTLY THE SAME?
;**;[3012] Replace one line at FORMS+4L. /LWS
JRST FORM4A ;[3012] YES, GO CHECK RAM AND VFU
HRLZI S2,J$WTOR(J) ;Get the start address of the buffer
HRRI S2,J$WTOR+1(J) ; and +1
SETZM J$WTOR(J) ;Want to zero it all
BLT S2,J$WTOR+^D50-1(J) ;Zap it
MOVE S2,[POINT 7,J$WTOR(J)] ;GET POINTER TO WTOR BUFFER.
MOVEM S2,TEXTBP ;AND SAVE IT FOR DEPBP.
PUSHJ P,RFORM ;READ FORMS MOUNTED ON PRINTER
GETLIM S2,.EQLIM(J),FORM ;GET REQUESTED TYPE
SKIPF ;IF FAILURE, NOTHING TO DO
JUMPN S1,[SETOM J$LVFF(J) ;IF SET, ASSUME NOT 1ST TIME THRU
JRST FORM.0]
SKIPN S1,J$FORM(J) ;GET FORMS TYPE
MOVX S1,FRMNOR ;USE NORMAL IF NULL
FORM.0: XOR S2,S1 ;GET COMMON PART
AND S2,[EXP FRMSK1] ;AND IT WITH THE IMPORTANT PART
GETLIM S1,.EQLIM(J),FORM ;GET FORMS TYPE
EXCH S1,J$FORM(J) ;SAVE IT
MOVEM S1,J$FPFM(J) ;SAVE OLD ONES
JUMPN S2,FORM.1 ;IF DIFFERENT, SET WTOR TEXT
MOVE S1,J$FTAP(J) ;IF FORMS THE SAME, ASSUME
MOVEM S1,J$FLVT(J) ;VFU ALIGNMENT OK
MOVE S1,J$LRAM(J) ;AND RAM OK, TOO
MOVEM S1,J$FLRM(J)
TXOA S,FRMSOK ;FORMS ARE OK
FORM.1: $TEXT (DEPBP,<Please load forms type '^W/J$FORM(J)/'>)
MOVE S1,J$FDRU(J) ;GET THE CURRENT DRUM TYPE
MOVEM S1,J$PDRU(J) ;AND SAVE IT
MOVE S1,J$FRIB(J) ;GET THE CURRENT RIBBON TYPE
MOVEM S1,J$PRIB(J) ;AND SAVE IT
MOVE S1,J$FTAP(J) ;GET THE CURRENT CARRIAGE CONTROL TAPE
MOVEM S1,J$PTAP(J) ;AND SAVE IT
MOVE S1,J$LRAM(J) ;GET THE DEFAULT RAM FILE NAME
MOVEM S1,J$FRAM(J) ;AND MAKE IT THE CURRENT RAM TYPE
HRLZI S1,-F$NSW ;GET NEGATIVE SWITCH TABLE LEN
MOVEI T1,J$FCUR(J) ;POINT TO CURRENT FORMS PARAMS
FORM.2: MOVE S2,FFDEFS(S1) ;GET A DEFAULT
CAME S2,[-1] ;IS THIS SUPPOSED TO BE DEFAULTED ???
MOVEM S2,(T1) ;YES, SAVE IT
ADDI T1,1 ;INCREMENT NEW PARAM STORE CTR
AOBJN S1,FORM.2 ;AND LOOP
GETLIM T1,.EQLIM(J),FORM ;FORMS NAME
MOVEM T1,J$FALI(J) ;SAVE IT AS DEFAULT ALIGN FILE NAME
PUSHJ P,FRMINI ;READ THE LPFORM.INI FILE.
JUMPT FORM.3 ;Skip the message if ok
TXNN S,FRMSOK ;FORMS OK (SET BEFORE)?
SKIPN J$MNTF(J) ;DEVICE SUPPORT MOUNTABLE FORMS?
JRST FORM.3 ;NO--IGNORE NOT FOUND ERROR
FRM.2A: MOVE S1,STREAM ;Get the stream number
GETLIM S2,.EQLIM(J),FORM ;Get forms type
SETZM JOBCHK(S1) ;SAY WE WANT TO TAKE A CHECKPOINT.
SETOM JOBUPD(S1) ; update status also
$WTOR (<Form ^W/S2/ not found, defaults being used>,<^R/.EQJBB(J)/^T/FORMSG/>,@JOBOBA(S1),JOBWAC(S1)) ;Tell the operator
$DSCHD (PSF%OR) ;WAIT FOR OPERATOR RESPONSE
TXNE S,ABORT+RQB ;HAVE WE BEEN CANCELED OR REQUEUED ???
JRST FORM.7 ;YES, IGNORE THE ERROR
MOVEI S1,FRMANS ;POINT TO THE LIMIT ANSWER BLOCK
HRROI S2,J$RESP(J) ;POINT TO THE ANSWER
PUSHJ P,S%TBLK ;DO WE MATCH ???
TXNE S2,TL%NOM+TL%AMB ;DID WE FIND IT OK ???
JRST FRM.2A ;NO, STUPID OPERATOR SO TRY AGAIN
HRRZ S1,0(S1) ;GET THE ROUTINE ADDRESS
JRST 0(S1) ;AND PROCESS THE RESPONSE
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
; Set up the width and length classes
FORM.3: MOVEI S1,3 ;START AT THREE FOR BOTH
MOVEM S1,J$FWCL(J) ;STORE IT
MOVEM S1,J$FLCL(J) ;STORE IT AGAIN
MOVE S1,J$FWID(J) ;GET THE WIDTH
CAIG S1,F$WCL2 ;LE CLASS 2 LIMIT?
SOS J$FWCL(J) ;YES, SOS ONCE
CAIG S1,F$WCL1 ;LE CLASS 1 LIMIT
SOS J$FWCL(J) ;YES, SOS AGAIN
MOVE S1,J$FLIN(J) ;Get the length
CAIG S1,F$LCL2 ;LE class 2 limit?
SOS J$FLCL(J) ;Yes, sos once
CAIG S1,F$LCL1 ;LE class 1 limit?
SOS J$FLCL(J) ;Yes, sos again
SKIPN J$MNTF(J) ;DEVICE SUPPORT MOUNTABLE FORMS?
$RETT ;NO, JUST RETURN NOW !!
MOVE S1,TEXTBP ;GET THE WTOR BYTE POINTER.
TXNE S,FRMSOK ;FORMS OK?
JRST FORM4A ;YES
TXNE S,FRMFND ;Were the forms found?
CAMN S1,[POINT 7,J$WTOR(J)] ;IS THERE A MESSAGE FOR THE OPERATOR ??
JRST FORM4A ;NO, TRY LOADING VFU AND RAM
$TEXT (DEPBP,<^T/ENDRSP/^0>) ;ADD THE RESPONSE TO THE END
FORM.4: MOVE S1,STREAM ;GET STREAM NUMBER
$WTOR (,<^T/J$WTOR(J)/>,@JOBOBA(S1),JOBWAC(S1)) ;SEND THE WTOR.
SETZM JOBCHK(S1) ;SAY WE WANT TO TAKE A CHECKPOINT.
SETOM JOBUPD(S1) ; update status also
$DSCHD (PSF%OR) ;WAIT FOR OPERATOR RESPONSE.
TXNE S,ABORT+RQB ;HAVE WE BEEN CANCELED OR REQUEUED ???
JRST FORM.7 ;Go replace the old forms
MOVEI S1,CONANS ;POINT TO THE CONTINUE ANSWER BLOCK
HRROI S2,J$RESP(J) ;POINT TO THE ANSWER
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
;**;[3012] Add code at FORM.4+12L. /LWS
;Here to check the status of the VFU. If bad, load RAM and VFU.
FORM4A: PUSHJ P,VFUCHK ;CHECK VFU STATUS
JUMPT FORM.5 ;[3014] IF OK, DON'T FORCE LOADS
SETZM J$FLRM(J) ;[3012] LOAD RAM AND VFU TO BE SAFE
SETZM J$FLVT(J) ;[3012]
MOVE S2,STREAM ;[3012] GET CURRENT STREAM
$WTO (VFU error,<Reloading RAM and VFU>,@JOBOBA(S2)) ;[3012]
FORM.5: GETLIM S1,.EQLIM(J),FORM ;FIRST SET FORMS TYPE IF WE CAN
PUSHJ P,SFORM
PUSHJ P,LODVFU ;[4104] GET THE VFU LOADED
TXNE S,ABORT+RQB ;HAVE WE BEEN CANCELED ???
$RETF ;YES, RETURN NOW
PUSHJ P,LODRAM ;[4104] LOAD RAM
TXNE S,ABORT+RQB ;HAVE WE BEEN CANCELED ???
$RETF ;YES, RETURN NOW
$RETT ;NO, HE WINS SO FAR !!!
FORM.6: TXO S,RQB ;Requeue the job
FORM.7: MOVE S1,J$FPFM(J) ;Get old forms
MOVEM S1,J$FORM(J) ;Restore it
$RETF ;And return
ENDRSP: ASCIZ /Type 'RESPOND <number> PROCEED' when ready/
FRMANS: $STAB
KEYTAB (FORM.6,ABORT) ;ABORT
KEYTAB (FORM.3,PROCEED) ;PROCEED
$ETAB
FORMSG: ASCIZ/
Type 'RESPOND <number> ABORT' to terminate the job now
Type 'RESPOND <number> PROCEED' after mounting correct forms, to allow the job to continue printing/
FMFD: $BUILD (FDXSIZ) ;BLOCK LENGTH
$SET (.FDLEN,FD.LEN,FDXSIZ) ;LENGTH OF FILESPEC
$SET (.FDLEN,FD.TYP,.FDNAT) ;NATIVE MODE FILESPEC
$SET (.FDSTR,FWMASK,'SYS ') ;DEVICE NAME
$SET (.FDNAM,FWMASK,'LPFORM') ;FILE NAME
$SET (.FDEXT,LHMASK,'INI') ;EXTENSION
$EOB ;END OF BLOCK
RFORM: TDZA TF,TF ;INDICATE ENTRY
SFORM: SETOM TF
$SAVE <T1,T2,T3,T4> ;GET SOME ACS
MOVE T1,S1 ;SAVE POSSIBLE FORMS TYPE TO SET
MOVE S1,[XWD T2,2] ;ASSUME READING FORMS
MOVEI T2,.DFFRM
MOVE T3,J$LDEV(J) ;GET PRINTER NAME
JUMPE TF,RSFRM ;JUMP IF READING
ADDI S1,1 ;ELSE, NEED ONE MORE ARG
MOVE T4,T1 ;WHICH IS THE FORMS TYPE
ADDI T2,.DFSET ;MAKE SET FUNCTION
RSFRM: MOVSS S1 ;MAKE UUO AC CORRECT
DEVOP. S1, ;READ/SET FORMS TYPE
$RETF
$RETT
FRMINI: TXZ S,FRMFND ;CLEAR THE FORMS FOUND FLAG
SETZM J$APRG(J) ;CLEAR ALIGNMENT NEEDED FLAG
MOVEI S1,FMFD ;FD FOR LPFORM.INI
MOVEI S2,0 ;FOR NOW DON'T DO DATE/TIME CHECKING
PUSHJ P,FH$INI ;INIT FILE PROCESSING
$RETIF ;RETURN ON ERRORS
FRMIN1: PUSHJ P,FH$SIX ;GET THE FORMS NAME
JUMPT FRMI1B ;Found something (No EOF)
TXNE S,FRMFND ;Have we found a match somewhere?
$RETT ;Yes, return good
$RETF ;No, do otherwise
FRMI1B: MOVE T1,S1 ;GET RESULT
GETLIM T2,.EQLIM(J),FORM ;GET FORMS
CAMN T1,T2 ;MATCH??
JRST FRMIN2 ;YES!!
FRMI1A: PUSHJ P,FH$EOL ;NO, FIND NEXT LINE
$RETIF ;EOF without finding the forms
JRST FRMIN1 ;AND LOOP
FRMIN2: TXO S,FRMFND ;Remember we've found it
CAIN C," " ; Break on a space?
PUSHJ P,FH$SKP ; Allow spaces, get non-blank char.
;**;[2777] Insert 2 lines at FRMIN2+2L. /LWS
PUSHJ P,FH$COM ;FLUSH COMMENT
$RETIF ;CHECK FOR ERRORS
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$CVT ;ELSE, GET A CHARACTER
JUMPT FRMIN2 ;AND LOOP IF WE HAVE A CHARACTER
FRMINX: PUSHJ P,FH$XIT ;TERMINATE I/O
SKIPGE J$APRG(J) ;NEED ALIGMENT ???
PUSHJ P,OALI.2 ;YES--DO IT NOW
$RETT ;RETURN
FRMIN3: PUSHJ P,FH$SIX ;GET A LOCATOR
JUMPF FRMINX ;EOF!!
SKIPN T1,S1 ;GET RESULT
JRST FRMI3A ;MAYBE PAREN??
JRST FRMIN4 ;PROCESS THE LOCATOR
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!!
CAMN T1,J$LDEV(J) ;COMPARE TO OUR DEVNAM
JRST FRMIN5 ;MATCH!!
CAIN C,.CHLFD ;BREAK ON EOL?
JRST FRMIN1 ;YES, GET NEXT LINE
CAIE C,"/" ;IS IT A SLASH?
CAIN C,")" ;NO, CLOSE PAREN?
JRST FRMI1A ;YES, GET THE NEXT LINE
CAIN C," " ; Break on space?
JRST FRMI1A ; Yes, get the next line
PUSHJ P,FH$SIX ;ELSE, GET THE NEXT LOCATOR
JUMPF FRMINX ;EOF, FINISH UP
SKIPN T1,S1 ;GET RESULT
JRST FRMIN9 ;BAD FORMAT
JRST FRMIN4 ;AND LOOP AROUND
;GET HERE IF THIS LINE IS FOR US
FRMIN5: PUSHJ P,FH$COM ;FLUSH COMMENT, CHECK LINE CONTINUATION
$RETIF ;CHECK FOR ERRORS
CAIN C,.CHLFD ;WAS THE LAST CHARACTER A LINEFEED?
JRST FRMINX ;YES, FINISH UP
CAIN C,"/" ;ARE WE AT THE BEGINNING OF A SWITCH?
JRST FRMI5A ;YES, DO IT!
PUSHJ P,FH$CVT ;NO, GET A CHARACTER
JUMPF FRMINX ;EOF!!
JRST FRMIN5 ;AND LOOP AROUND
FRMI5A: PUSHJ P,FH$SIX ;GET THE SWITCH
JUMPF FRMINX ;EOF!!
SKIPE T1,S1 ;GET RESULT
JRST FRMIN6 ;JUMP IF WE'VE GOT SOMETHING
CAIN C,.CHLFD ;EOL?
JRST FRMINX ;YES, FINISH UP
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
MOVEI S1,[ITEXT (<Unknown switch ^W/T4/ in line ^D/INILIN/>)]
MOVEI S2,[ITEXT (<Unknown switch ^W/T4/ reading ^F/@INIFOB+FOB.FD/>)]
PJRST FH$ERR ;REPORT ERROR AND RETURN
FRMIN8: HRRZ T3,FFNAMS(T2) ;GET DISPATCH ADDRESS
PUSHJ P,(T3) ;GO!!
JRST FRMIN5 ;AND LOOP
FRMIN9: MOVEI S1,[ITEXT (<File format error encountered in line ^D/INILIN/>)]
MOVEI S2,[ITEXT (<File format error reading ^F/@INIFOB+FOB.FD/>)]
PJRST FH$ERR ;REPORT ERROR AND RETURN
SUBTTL Forms Switch Subroutines
S$BANN: CAIE C,":" ;ARGUMENT FOLLOWING?
SKIPA S1,D$BANN ;GET DEFAULT
PUSHJ P,FH$DEC ;READ IT
$RETIF ;CHECK FOR ERRORS
MOVEM S1,J$FBAN(J) ;STORE IT
$RETT ;AND RETURN
S$TRAI: CAIE C,":" ;ARGUMENT FOLLOWING?
SKIPA S1,D$TRAI ;GET DEFAULT
PUSHJ P,FH$DEC ;READ IT
$RETIF ;CHECK FOR ERRORS
MOVEM S1,J$FTRA(J) ;STORE IT
$RETT ;AND RETURN
S$HEAD: CAIE C,":" ;ARGUMENT FOLLOWING?
SKIPA S1,D$HEAD ;GET DEFAULT
PUSHJ P,FH$DEC ;READ IT
$RETIF ;CHECK FOR ERRORS
MOVEM S1,J$FHEA(J) ;STORE IT
$RETT ;AND RETURN
S$LINE: CAIE C,":" ;ARGUMENT FOLLOWING?
SKIPA S1,D$LINE ;GET DEFAULT
PUSHJ P,FH$DEC ;READ IT
$RETIF ;CHECK FOR ERRORS
MOVEM S1,J$FLIN(J) ;STORE IT
POPJ P, ;AND RETURN
S$WIDT: CAIE C,":" ;ARGUMENT FOLLOWING?
SKIPA S1,D$WIDT ;GET DEFAULT
PUSHJ P,FH$DEC ;READ IT
$RETIF ;CHECK FOR ERRORS
MOVEM S1,J$FWID(J) ;SAVE IT
POPJ P, ;AND RETURN
S$RIBB: PUSHJ P,FH$SIX ;GET SIXBIT ARGUMENT
$RETIF ;CHECK FOR ERRORS
MOVEM S1,J$FRIB(J) ;SAVE IT
CAME S1,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
$RETIF ;CHECK FOR ERRORS
MOVEM S1,J$FDRU(J) ;SAVE IT
CAME S1,J$PDRU(J) ;SKIP IF NOT CHANGED
$TEXT (DEPBP,<Load DRUM (CHAIN) type '^W/J$FDRU(J)/'>)
POPJ P, ;AND RETURN
S$NOTE: SETZM J$FNBK(J) ;INIT STORAGE
PUSHJ P,FH$QST ;GET POSSIBLY QUOTED STRING
JUMPF S$NOT1 ;EOF
SKIPN (S1) ;ANY TEXT RETURNED?
JRST S$NOT1 ;NO
HRLZS S1 ;GET ADDR OF RESULT IN LH
HRRI S1,J$FNBK(J) ;MAKE A BLT POINTER
ADDI S2,J$FNBK(J) ;COMPUTE END OF BLT
BLT S1,-1(S2) ;COPY TEXT
S$NOT1: $TEXT (DEPBP,<Note: ^T/J$FNBK(J)/>) ;ADD THE MSG TO WTOR.
$RETT ;RETURN.
S$ALCN: CAIE C,":" ;ARGUMENT FOLLOWING?
SKIPA S1,D$ALCN ;GET DEFAULT
PUSHJ P,FH$DEC ;READ IT
$RETIF ;CHECK FOR ERRORS
MOVEM S1,J$FALC(J) ;STORE IT
SETOM J$APRG(J) ;FLAG ALIGNMENT NEEDED
$RETT ;AND RETURN
S$ALSL: CAIE C,":" ;ARGUMENT FOLLOWING?
SKIPA S1,D$ALSL ;GET DEFAULT
PUSHJ P,FH$DEC ;READ IT
$RETIF ;CHECK FOR ERRORS
MOVEM S1,J$FALS(J) ;SAVE IT
SETOM J$APRG(J) ;FLAG ALIGNMENT NEEDED
$RETT ;AND RETURN
S$ALIG: PUSHJ P,FH$SIX ;GET THE ALIGN FILENAME ARGUMENT
$RETIF ;CHECK FOR ERRORS
SKIPE S1 ;SKIP IF NOTHING THERE
MOVEM S1,J$FALI(J) ;SAVE THE ALIGN FILENAME
SETOM J$APRG(J) ;FLAG ALIGNMENT NEEDED
POPJ P, ;AND RETURN
S$VFU:
S$TAPE: PUSHJ P,FH$SIX ;GET SIXBIT ARGUMENT
JUMPF .RETT ;EOF
MOVEM S1,J$FTAP(J) ;SAVE IT
CAME S1,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 S1,J$FRAM(J) ;SAVE IT
$RETT ;AND RETURN
SUBTTL RANDOM DEVICE CONTROL -- LATSUP - SET UP A LAT LINE
; ROUTINE TO GET A REVERSE LAT CONNECTION
; CALL: MOVE M,[ADDRESS OF SETUP MESSAGE]
; MOVE J,[JOB DATA PAGE]
; PUSHJ P,LATSUP
LATSUP: STKVAR <<LATOP,.LAPRT+1>> ;
MOVEI S1,LATOP ;
SETZM (S1) ;
MOVS S2,S1 ;SOURCE,,0
HRRI S2,1(S1) ;SOURCE,,DESTINATION
BLT S2,.LAPRT(S1) ;CLEAR THE ENTIRE UUO BLOCK
MOVX S2,.LAPRT+1 ;LENGTH
MOVEM S2,.LAACT(S1) ;
MOVX S2,.LARHC ;FUNCTION
MOVEM S2,.LAFCN(S1) ;
MOVX S2,LA.WAI ;PARAMETERS
MOVEM S2,.LAPRM(S1) ;
MOVEI S2,SUP.LN+00(M) ;GET ADDRESS OF SERVER NAME
SKIPE (S2) ;IS THERE A SERVER NAME?
MOVEM S2,.LASVR(S1) ;YES, SAVE THIS ADDRESS
MOVEI S2,SUP.LN+04(M) ;GET ADDRESS OF SERVICE NAME
SKIPE (S2) ;IS THERE A SERVICE NAME?
MOVEM S2,.LASVC(S1) ;YES, SAVE THIS ADDRESS
MOVEI S2,SUP.LN+10(M) ;GET ADDRESS OF PORT NAME
SKIPE (S2) ;IS THERE A PORT NAME?
MOVEM S2,.LAPRT(S1) ;YES, SAVE THIS ADDRESS
LATOP. S1, ;REQUEST HOST-INITIATED CONNECT
JRST LATSU3 ;ERROR: OBJECT DOES NOT EXIST
MOVEI S1,LATOP ;
MOVE S1,.LAVAL(S1) ;GET STATUS
CAIL S1,.UXTRM+000 ;
CAILE S1,.UXTRM+777 ;DID THE CONNECTION SUCCEED?
JRST LATSU2 ;NO, EVALUATE THE STATUS CODE
; COME HERE AFTER A SUCCESSFUL CONNECTION
MOVEM S1,J$LION(J) ;SAVE THE UDX
TRZ S1,.UXTRM ;GET THE TTY NUMBER
SETZ T1, ;INITIALIZE THE ACCUMULATOR
LATSU1: IDIVI S1,10 ;DIVIDE BY THE RADIX
ADDI S2,'0' ;CONVERT TO SIXBIT
LSHC S2,-6 ;SAVE THE CHARACTER
JUMPN S1,LATSU1 ;CONVERT THE TTY NUMBER TO SIXBIT
MOVSI S1,'TTY' ;ASSEMBLE THE TTY DEVICE NAME
HLR S1,T1 ;
MOVEM S1,SUP.ST(M) ;FIX UP THE SETUP MESSAGE
SETOM J$LLAT(J) ;MARK THIS AS A LAT LINE
MOVEI S1,.RETT ;GET ADDRESS OF NULL ROUTINE
MOVEM S1,J$$DEV(J) ;INITIALIZE FIRST DRIVE ROUTINE
HRLI S1,J$$DEV(J) ;SOURCE,,0
HRRI S1,J$$DEV+1(J) ;SOURCE,,DESTINATION
BLT S1,J$$DND(J) ;INITIALIZE THE DISPATCH TABLE
MOVEI S1,LPTCLS ;COMMON DEVICE CLOSE ROUTINE
MOVEM S1,J$CLOS(J) ;RELEASE THE TERMINAL
$RETT ;
; COME HERE TO LOOK FOR FATAL STATUS CODES
LATSU2: MOVSI S2,-LATERN ;SET UP THE LOOP INDEX
CAME S1,LATERR(S2) ;DO THEY MATCH?
AOBJN S2,.-1 ;NO, KEEP LOOKING
SKIPG S2 ;NOT FOUND: OBJECT NOT AVAILABLE
LATSU3: SKIPA S1,[%RSUDE] ;OBJECT DOES NOT EXIST (EVER)
MOVX S1,%RSUNA ;OBJECT NOT AVAILABLE (TRY LATER)
$RETF ;
LATERR: EXP .LAUNK,.LAISC,.LANSS,.LASDI
EXP .LASNP,.LANSP,.LAIPW,.LAACD
LATERN=.-LATERR
SUBTTL COMMON DEVICE CONTROL -- LPTOPR - ASK FOR OPERATOR ACTION
; ROUTINE TO ASK THE OPERATOR FOR HELP
; CALL: MOVE T1, WTO TYPE TEXT ADDRESS
; MOVE T2, WTO MESSAGE TEXT ADDRESS
; MOVE T3, KEYWORD TABLE ADDRESS
; PUSHJ P,LPTOPR
;
; TRUE RETURN: S1 WILL CONTAIN THE KEYWORD TABLE OFFSET
; FALSE RETURN: STREAM CANCELED OR REQUEUED
LPTOPR::MOVE T4,STREAM ;GET STREAM NUMBER
SETOM JOBCHK(T4) ;FORCE A CHECKPOINT
$WTOR (<^I/(T1)/>,<^I/(T2)/>,@JOBOBA(T4),JOBWAC(T4))
$DSCHD (PSF%OR) ;WAIT FOR OPERATOR RESPONSE
TXNE S,ABORT+RQB ;STREAM CANCELED?
$RETF ;YES
MOVEI S1,(T3) ;POINT TO KEYWORD TABLE
HRROI S2,J$RESP(J) ;AND TO OPERATOR RESPONSE
PUSHJ P,S%TBLK ;SCAN THE TABLE
TXNE S2,TL%NOM!TL%AMB ;NO MATCH OR AMBIGUOUS?
JRST LPTOPR ;GO TRY AGAIN
HRRZ S1,(S1) ;GET KEYWORD DATA FROM TABLE
$RETT ;RETURN WITH ANSWER IN S1
SUBTTL RANDOM DEVICE CONTROL -- LODVFU - LOAD GENERIC VFU
LODVFU: SKIPN J$LDVF(J) ;IS VFU LOADABLE?
$RETT ;NOPE, PRETEND ALL IS WELL
VFU.1: 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))
PUSHJ P,@J$FLSH(J) ;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 VFU.3 ;NO, SKIP THIS
SETOM J$LVFF(J) ;RESET THE FIRST TIME THROUGH FLAG
PUSHJ P,VFUCHK ;CHECK VFU STATUS
JUMPF VFU.2 ;DONT OUTPUT FORM FEED IF BAD
MOVX C,.CHFFD ;GET FORM FEED CODE
PUSHJ P,DEVOUT ;PUT IT OUT
PUSHJ P,OUTDMP ;ALIGN THE FORMS ON THE PRINTER
JRST VFU.3 ;AND GO RELOAD THE VFU
VFU.2: MOVE S1,STREAM ;GET OUR STREAM NUMBER
$WTOR(<Align Forms and Put Online>,<^T/ENDRSP/>,@JOBOBA(S1),JOBWAC(S1))
SETZM JOBCHK(S1) ;TAKE A CHECKPOINT WHEN WE CAN
SETOM JOBUPD(S1) ; update status also
$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 VFU.2 ;NO, STUPID OPERATOR -- TRY AGAIN !!
VFU.3: MOVEI S1,1 ;CODE TO LOAD VFU
PUSHJ P,@J$VFU(J) ;TRY TO LOAD THE VFU
SKIPT ;ANY ERRORS? (DISPATCH IF SO)
JRST @[IFIW HDWVFU ;(0) VFU FILE NOT FOUND, HDW VFU LOADED
IFIW VFUFAI ;(1) LOAD FAILED, OPR ACTION REQUEST
IFIW NODAVF](S1) ;(2) NO DAVFU AFTER ALL
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,@J$FLSH(J) ;FLUSH THE OUTPUT BUFFERS
JUMPF SHUTIN ;CANT,,SHUT IT DOWN
$RETT
SUBTTL RANDOM DEVICE CONTROL -- LODRAM - LOAD GENERIC RAM
LODRAM: MOVE S1,J$FRAM(J) ;GET THE RAM WE WANT
SKIPE J$LDRM(J) ;IF NOT LOADABLE,
CAMN S1,J$FLRM(J) ; OR ALREADY LOADED
$RETT ;YES, RETURN NOW !!!
MOVE S1,STREAM ;GET OUR STREAM NUMBER
$WTO (Loading RAM with '^W/J$FRAM(J)/',,@JOBOBA(S1))
PUSHJ P,@J$RAM(J) ;DO DEVICE DEPENDENT LOAD
SKIPT ;ANY ERRORS? (DISPATCH IF SO)
JRST @[IFIW HDWRAM ;(0) RAM LOAD FAILED, HARDWARE RAM USED
IFIW NORAM ;(1) RAM LOAD FAILED, NEED OPR ACTION
IFIW NOTRAM](S1) ;(2) RAM LOAD FAILED, NOT PRESENT
MOVE S1,J$FRAM(J) ;GET THE RAM TYPE WE JUST LOADED
MOVEM S1,J$FLRM(J) ;SAVE IT AS LOADED RAM TYPE
POPJ P, ;LOAD SUCCEEDED
HDWRAM: MOVE T1,D$RAM ;GET NAME OF NORMAL
MOVEM T1,J$FLVT(J) ;STORE IT
MOVE S1,STREAM ;GET STREAM NUMBER
$WTO (Error loading RAM, Loaded hardware RAM instead.,@JOBOBA(S1))
$RETT
NORAM: MOVE S1,STREAM ;GET OUR STREAM NUMBER
$WTOR (,<^I/RAMI1/^J^M^T/RAMI2/>,@JOBOBA(S1),JOBWAC(S1))
SETZM JOBCHK(S1) ;WE WANT A CHECKPOINT TAKEN
SETOM JOBUPD(S1) ; Update also
$DSCHD (PSF%OR) ;WAIT FOR THE OPERATOR RESPONSE
TXNE S,ABORT+RQB ;CANCELED OR REQUEUED ???
JRST [SETZM J$FORM(J) ;YES, ZAP THE LOADED FORMS TYPE
$RETT ] ;AND RETURN
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/
NOTRAM: SETZM J$LDRM(J) ;NOT LOADABLE AFTER ALL
$RETT
SUBTTL COMMON DEVICE CONTROL -- LPTDVN - GENERATE DEVICE NAME
; ROUTINE TO GENERATE A DEVICE NAME
; CALL: MOVE S1,[SIXBIT /DEV/]
; PUSHJ P,GENDEV
LPTDVN::MOVEM S1,J$LDEV(J) ;SAVE DEVICE
TRNE S1,-1 ;GIVEN FULL NAME?
POPJ P, ;YES--DONE
MOVE T1,STREAM ;PICK UP STREAM NUMBER.
MOVE T1,JOBOBA(T1) ;PICK UP OBJECT BLOCK ADDRESS.
MOVE T2,OBJ.ND(T1) ;PICK UP THE NODE NUMBER.
IDIVI T2,10 ;SPLIT NODE NUMBER IN HALF.
IMULI T2,100 ;SHIFT LEFT 2 DIGITS.
ADD T2,T3 ;ADD SECOND NODE DIGIT.
IMULI T2,100 ;SHIFT LEFT ANOTHER 2 DIGITS.
ADD T2,OBJ.UN(T1) ;ADD THE UNIT NUMBER.
ADDI T2,'000' ;MAKE SIXBIT
IORB T2,J$LDEV(J) ;AND SAVE IT
IONDX. T2,UU.PHY ;GET I/O INDEX
SETZ T2, ;???
MOVEM T2,J$LION(J) ;SAVE IT
POPJ P, ;RETURN
SUBTTL COMMON DEVICE CONTROL -- LPTLIN - GENERATE ANF-10 TTY NAME
; RESOLVE SYSTEM-WIDE TTY NAME TO A SPECIFIC TTY ON A GIVEN
; ANF-10 STATION, CONNECT LINE, AND RUN INITIA
; CALL: MOVE S1, SIXBIT/TTYNNN/
; PUSHJ P,LPTLIN
;
; TRUE RETURN: TTY NAME UPDATED IN J$LDEV, I/O INDEX IN J$LION
; FALSE RETURN: NOT A TTY, NO SUCH TTY, OR CAN'T CONNECT LINE
LPTLIN::MOVE T1,S1 ;COPY TTY NAME
MOVE T4,T1 ;SAVE DEVICE NAME
HLRZ T2,T1 ;GET DEVICE MNEMONIC
CAIN T2,'TTY' ;BETTER BE TTY
TRNN T1,777777 ;AND A UNIT NUMBER
$RETF ;CAN'T HANDLE ANYTHING ELSE
HRRZS T1 ;REMOVE JUNK
MOVSI T3,-3 ;LOOP COUNT
LINE.1: TRNE T1,77 ;DIGIT PRESENT?
JRST LINE.2 ;YES--GO ENTER LOOP
LSH T1,-6 ;RIGHT JUSTIFY
TRO T3,-1 ;INCASE WE JUMP OUT NEXT TIME
AOBJN T3,LINE.1 ;AND CHECK AGAIN
LINE.2: SUBI T1,'0' ;CONVERT TO OCTAL
LSHC T1,-3 ;SAVE DIGIT
LSH T1,-3 ;REMOVE JUNK
AOBJN T3,LINE.2 ;LOOP
LSHC T1,3 ;SHIFT IN A DIGIT
SOJG T3,.-1 ;DO THEM ALL
MOVE T2,STREAM ;GET STREAM NUMBER
MOVE T2,JOBOBA(T2) ;AND THE OBJECT BLOCK
MOVE T2,OBJ.ND(T2) ;GET STATION NUMBER
HRL T1,T2 ;MAKE IT NODE,,LINE
MOVE T3,T1 ;COPY FOR NODE. UUO
CAMN T2,CNTSTA ;LOCAL?
JRST LINE.3 ;YES
MOVE T1,[.NDTCN,,T2] ;SET UP UUO AC
MOVEI T2,2 ;TWO WORDS
NODE. T1, ;TRY TO CONNECT THE LINE
SKIPA ;FAILED
JRST LINE.4 ;LINE CONNECTED
CAMN T1,T2 ;AC UNCHANGED (NO NETWORK SUPPORT)?
$RETF ;NO SUCH LINE
LINE.3: SKIPA T1,T4 ;USE ORIGINAL TTY NAME
LINE.4: MOVE T4,T1 ;PRESERVE TTY NAME WE HAVE NOW
DEVCHR T1,UU.PHY ;GET INTERESTING BITS
TXNN T1,DV.TTY ;REALLY A TTY?
$RETF ;NOPE
MOVEM T4,J$LDEV(J) ;SAVE AS DEVICE NAME
IONDX. T4,UU.PHY ;TRANSLATE TO I/O INDEX
$RETF ;CAN'T
MOVEM T4,J$LION(J) ;SAVE
MOVE T2,[2,,T3] ;SET UP UUO AC
MOVX T3,.TOAPC ;FUNCTION
TRMOP. T2, ;GET ASYNCH. PORT CHAR.
MOVX T2,.TOUNK ;ERROR: CAN'T TELL
CAIN T2,.TOLAT ;LAT APPLICATION TERMINAL?
JRST LINE.5 ;YES, RUN INITIA
MOVE T1,STREAM ;GET STREAM NUMBER
MOVE T1,JOBOBA(T1) ;AND THE OBJECT BLOCK
MOVE T1,OBJ.ND(T1) ;GET STATION NUMBER
CAMN T1,CNTSTA ;CENTRAL?
$RETT ;YES--NO NEED TO RUN INITIA
LINE.5: MOVE T2,[2,,T3] ;SET UP UUO AC
MOVE T3,['INITIA'] ;FORCED COMMAND NAME
FRCUUO T2, ;RUN INITIA SO TTY PARAMETERS GET SET
JFCL ;HOPE FOR THE BEST
MOVEI T1,^D30 ;WAIT UP TO 30 SECONDS
LINE.6: MOVEI T2,1 ;GET SLEEP TIME
SLEEP T2, ;WAIT FOR INITIA TO FINISH RUNNING
MOVE T2,J$LDEV(J) ;GET DEVICE NAME
DEVCHR T2,UU.PHY ;AND ITS CHARACTERISTICS
TXNN T2,DV.ASP ;ASSIGNED TO SOME OTHER JOB?
TXNN T2,DV.AVL ;NO--AVAILABLE TO OUR JOB?
SOJG T1,LINE.6 ;MUST TRY AGAIN
JUMPLE T1,.RETF ;IF TIMED OUT, THEN SAY NOT AVAILABLE
$RETT ;ELSE RETURN
SUBTTL COMMON DEVICE CONTROL -- LPTOPN - OPEN DEVICE
; SET UP FOR I/O
; THIS ROUTINE WILL INIT A CHANNEL AND BUILD BUFFERS
LPTOPN::MOVE S1,J$LDEV(J) ;GET DEVICE NAME
DEVCHR S1, ;GET CHARACTERISTICS
MOVEM S1,J$DCHR(J) ;SAVE FOR LATER
TXNN S1,DV.ASP ;ASSIGNED TO SOME OTHER JOB?
TXNN S1,DV.AVL ;NO--AVAILABLE TO OUR JOB?
$RETF ;NOT RIGHT NOW, RESTORE OPEN BITS
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
TXO T1,UU.AIO ;ASYNCH I/O
MOVE T2,J$LDEV(J) ;OUTPUT DEVICE NAME
MOVSI T3,J$LBRH(J) ;BUFFER HEADER
XCT S1 ;AND EXECUTE IT
$RETF ;FAILED
OPEN.1: SETZM J$LIOS(J) ;[4071] CLEAR STATUS WORDS
SETZM J$XIOS(J) ;[4071]
SKIPGE J$LREM(J) ;IS THIS A REMOTE PRINTER
SKIPGE J$LLAT(J) ; AND NOT A LAT PRINTER?
TRNA ;NO, IT IS A LOCAL DEVICE
JRST OPEN.4 ;YES, SETUP BUFFERS FOR REMOTE
MOVE T1,J$LBUF(J) ;GET ADDRESS OF BUFFER PAGE
SUBI T1,BUFSIZ ;BACK UP ONE BUFFER
SETZ T2, ;CLEAR A COUNTER
OPEN.2: 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,OPEN.2 ;NO, LOOP AROUND
OPEN.3: 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
$RETT ;RETURN
OPEN.4: 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 1] ;MAKE AN INSTRUCTION
XCT S2 ;AND EXECUTE IT
MOVEM S1,.JBFF ;RESTORE JOBFF
$RETT ;RETURN
SUBTTL COMMON DEVICE CONTROL -- LPTCLS - CLOSE DEVICE
LPTCLS::TXZE S,INTRPT ;ARE WE CONNECTED TO INTRPT SYSTEM?
PUSHJ P,INTDCL ;YES, RELEASE THE INTERRUPTS
SKIPN J$LLAT(J) ;IS THIS A LAT LINE?
JRST CLOS.0 ;NO, FINISH UP
PUSHJ P,CLOS.0 ;RELEASE THE DEVICE
PJRST LATCLS ;DISCONNECT THE LAT LINE
CLOS.0: MOVE S1,J$LCHN(J) ;GET THE CHANNEL
SKIPE J$LREM(J) ;NO, ARE WE USING A REMOTE PRINTER?
JRST CLOS.1 ;YES TO EITHER, ISSUE A CLOSE/RELEASE
RESDV. S1, ;RESET THE CHANNEL
JFCL ;IGNORE ANY ERRORS
$RETT ;AND RETURN
CLOS.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
; COME HERE TO DISCONNECT THE LAT LINE
LATCLS: SKIPN T2,J$LION(J) ;IS THERE A UDX?
$RETT ;NO, FINISHED
MOVEI T1,.TOSOP ;FUNCTION
MOVEI S2,^D30 ;MAXIMUM TIME TO WAIT
LATCL1: MOVE S1,[2,,T1] ;LENGTH,,ADDRESS
TRMOP. S1, ;SKIP IF OUTPUT IS IN PROGRESS
JRST LATCL2 ;NO IN PROGRESS: HANG UP
MOVEI S1,1 ;
SLEEP S1, ;ZZZZZZ
SOJG S2,LATCL1 ;REPEAT
LATCL2: MOVEI T1,.TODSF ;FUNCTION
MOVE S1,[2,,T1] ;LENGTH,,ADDRESS
TRMOP. S1, ;DISCONNECT DATASET FUNCTION
JFCL ;
MOVEI T1,.TODNT ;DISCONNECT NETWORK TERMINAL
MOVE S1,[2,,T1] ;LENGTH,,ADDRESS
TRMOP. S1, ;DISCONNECT DATASET FUNCTION
JFCL ;
$RETT ;
SUBTTL COMMON DEVICE CONTROL -- LPTHDW - SETUP HARDWARE CHARACTERISTICS
LPTHDW::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
SETZ T1, ;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 CONTROLLER TYPE
MOVEM S1,J$LCLS(J) ;SAVE IT FOR LATER
CAIN S1,.DFS20 ;LP20 CLASS DEVICE?
SETOM J$LDRM(J) ;YES, ASSUME LOADABLE RAM
SKIPE J$LREM(J) ;OR IF THIS IS A REMOTE LPT
SETZM J$LDRM(J) ;IT ISN'T LOADABLE AFTER ALL
SETZM J$LDVF(J) ;DON'T LOAD VFU (FOR NOW)
LDB T1,[POINTR(T1,DF.VFT)] ;GET VFU TYPE
CAIN T1,.DFVTD ;IS IT A DAVFU?
SETOM J$LDVF(J) ;YES, SET THE FLAG
$RETT ;RETURN
SUBTTL COMMON DEVICE CONTROL -- LPTVFU - LOAD/CHECK VFU
VFUCHK: SKIPN J$LDVF(J) ;[3012] IS THERE A VFU TO LOAD?
$RETT ;[3012] NOTHING TO DO
MOVEI S1,0 ;CHECK STATUS FUNCTION
JRST @J$VFU(J) ;TRY IT
SUBTTL HARDWARE VFU LOADED INSTEAD OF REQUESTED VFU
HDWVFU: 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
VFUFAI: MOVE S1,STREAM ;GET STREAM NUMBER
$WTOR (,<^I/VFUI1/^J^M^T/VFUI2/>,@JOBOBA(S1),JOBWAC(S1))
SETZM JOBCHK(S1) ;SAY WE WANT TO TAKE A CHECKPOINT.
SETOM JOBUPD(S1) ; update status also
$DSCHD (PSF%OR) ;WAIT FOR THE REPLY.
TXNE S,ABORT+RQB ;HAVE WE BEEN CANCELED OR REQUEUED ??
JRST [SETZM J$FORM(J) ;YES, ZAP THE LOADED FORMS TYPE
TXZ S,VFULOD ;CLEAR THE VFU LOAD FLAG
$RETT ] ;AND RETURN
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 VFU.1 ;TRY LOADING AGAIN.
VFUI1: ITEXT (<VFU Error, can't load VFU '^W/J$FTAP(J)/'>)
VFUI2: ASCIZ /Respond with VFU type to continue/
SUBTTL COMMON DEVICE CONTROL -- LPTFLS - FLUSH A JOB
LPTFLS::SKIPE J$LREM(J) ;SKIP IF LOCAL
$RETT ;DO NOTHING SINCE ONLY 1 BUFFER
PUSHJ P,INTDCL ;DISCONNECT PRINTER INTERRUPTS
MOVE S1,J$LCHN(J) ;LOAD THE CHANNEL NUMBER
RESDV. S1, ;RESET THE CHANNEL
JFCL ;??
PUSHJ P,@J$OPEN(J) ;RE-INIT THE DEVICE
CAIN S1,%RSUOK ;ARE WE ALL RIGHT ???
$RETT ;YES, JUST RETURN
PUSHJ P,RSETUP ;NO, SEND RESPONSE TO SETUP MSG
$RETF ;AND RETURN
SUBTTL COMMON DEVICE CONTROL - LPTOUT - OUTPUT A BUFFER
; 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.
LPTOUT::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$LIOS(J) ;GET I/O STATUS BITS
MOVE S2,J$XIOS(J) ;[4071] AND POSSIBLE EXTENDED STATUS
TXNE S1,IO.ERR ;[4071] ANY ERROR BITS?
JRST OUT.3 ;[4071] YES--MUST BE PSEUDO DEVICE NONSENSE
ANDCAM S1,J$LIOS(J) ;CLEAR I/O STATUS
SETZM J$XIOS(J) ;HERE TOO
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
MOVX S2,PSF%OB ;GET THE 'OUTPUT-BLOCKED' BIT
ANDCAM S2,JOBSTW(S1) ; AND CLEAR THE OUTPUT BLOCKED BITS
$RETT ] ; NOW WE CAN RETURN
OUT.1: 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 I/O STATUS BITS
TRC S1,IO.ERR ;MUST SEE IF
TRCE S1,IO.ERR ;[4071] EXTENDED STATUS NEEDED TOO
JRST OUT.2 ;NO
MOVE TF,[2,,S1] ;PREPARE FOR DEVOP. UUO
MOVEI S1,.DFRES ;READ EXTENDED ERROR STATUS
MOVE S2,J$LCHN(J) ;GET CHANNEL NUMBER
DEVOP. TF,
SETZ TF, ;???
MOVEM TF,J$XIOS(J) ;SAVE FOR POSTERITY
MOVE S1,J$LIOS(J) ;[4071] GET I/O STATUS
SKIPA S2,J$XIOS(J) ;[4071] GET EXTENDED STATUS
OUT.2: SETZB S2,J$XIOS(J) ;[4071] NO EXTENDED STATUS
OUT.3: PUSHJ P,@J$OUTE(J) ;[4071] DO DEVICE SPECIFIC ERROR PROCESSING
JUMPF LPTOEX ;JUMP IF UNRECOVERABLE ERROR
$DSCHD(0) ;BLOCK FOR OUTPUT DONE (See Above)
PJRST @J$OUTP(J) ;AND TRY AGAIN
SUBTTL COMMON DEVICE CONTROL -- LPTOER - OUTPUT ERROR PROCESSING
LPTOER::MOVE S1,J$LIOS(J) ;GET I/O STATUS
TRNE S1,IO.ERR ;ANY ERROR BITS ON?
JRST OUTE.1 ;YES--MUST INVESTIGATE
$RETT ;Return good, (Output blocked)
OUTE.1: PUSHJ P,.SAVET ;SAVE ALL THE 'T' ACS
MOVE T4,STREAM ;GET THE STREAM NUMBER
MOVX S1,PSF%OB ;GET OUTPUT BLOCKED BIT
ANDCAM S1,JOBSTW(T4) ;CLEAR STATE
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.2 ;AND THEY ARE NOT
MOVE T1,J$XIOS(J) ;GET EXTENDED STATUS
CAIN T1,IOVFE% ;IS THE ERROR BAD VFU ?
JRST VFUOER ;YES, DO SOME SPECIAL PROCESSING
CAIN T1,IOPAR% ;RAM PARITY ERROR?
JRST RAMOER ;YES
CAIN T1,IOUNC% ;UNDEFINED CHARACTER INTERRUPT?
JRST UNCOER ;YES
OUTE.2: HRRZ S1,J$LIOS(J) ;GET I/O STATUS
MOVEI S2,[ITEXT (<>)] ;ASSUME NO EXTENDED STATUS
SKIPE J$XIOS(J) ;IS THERE ONE?
MOVEI S2,[ITEXT (<Extended error status ^O/J$XIOS(J)/>)]
$WTO (<I/O error ^O6R0/S1/>,<^I/(S2)/>,@JOBOBA(T4))
PJRST LPTOEX ;GO FINISH UP
; OUTPUT ERROR -- UNDEFINED CHARACTER TRANSLATION
UNCOER: $WTO (<Undefined character interrupt>,<Requeueing job>,@JOBOBA(T4))
SETZM J$LERR(J) ;NO MORE ERRORS ALLOWED
TXO S,ABORT+RQB ;DONE WITH THIS JOB
MOVE S1,J$FRAM(J) ;GET RAM NAME
CAME S1,['LP64 '] ;NORMAL?
CAMN S1,['LP96 '] ;...
PJRST LPTDIE ;GO CROAK STREAM
$RETT ;RETURN
; OUTPUT ERROR -- RAM PARITY
RAMOER: $WTO (RAM Parity Error,,@JOBOBA(T4)) ;YES, TELL OPERATOR
PUSHJ P,LPTOEX ;PERFORM SOME PRELIMINARY PROCESSING
SETZM J$FLRM(J) ;FORCE A RAM RELOAD
PUSHJ P,LODRAM ;DO A RELOAD
SETZM J$FLVT(J) ;[3012] LOAD THE VFU TOO, TO BE SAFE
PUSHJ P,LODVFU ;LOAD VFU
$RETT ;AND RETURN
; OUTPUT ERROR -- VFU
VFUOER: TXZN S,VFULOD ;ARE WE ALREADY LOADING VFU?
JRST VFUOE1 ;NO...
$WTO (VFU error while loading VFU,,@JOBOBA(T4)) ;YES
MOVEI S1,2 ;ERROR, DISABLE LOAD
PUSHJ P,@J$VFU(J) ;DEVICE DEPENDENTLY
PUSHJ P,@J$FLSH(J) ;GO RESET THE DEVICE
SETZM J$FORM(J) ;SAY FORMS NOT LOADED
MOVX S1,%RSUNA ;GET "DEVICE NOT AVAILABLE"
PUSHJ P,RSETUP ;TELL QUASAR TO FORGET US FOR NOW
PJRST SHUTIN ;SHUTDOWN THE STREAM
VFUOE1: $WTOR (VFU error,<Re-align forms and put on-line^M^J^T/ENDRSP/>,@JOBOBA(T4),JOBWAC(T4))
SETZM JOBCHK(T4) ;SAY WE WANT A CHECKPOINT TAKEN
SETOM JOBUPD(T4) ; update the status also
$DSCHD(PSF%OR) ;WAIT FOR THE OPERATOR RESPONSE
TXNE S,ABORT+RQB ;HAVE WE BEEN CANCELED OR REQUEUED ???
$RETT ;YES, JUST RETURN
MOVEI S1,CONANS ;POINT TO THE CONTINUE ANSWER BLOCK
HRROI S2,J$RESP(J) ;POINT TO THE ANSWER
PUSHJ P,S%TBLK ;DO WE MATCH ???
TXNE S2,TL%NOM+TL%AMB ;DID WE FIND IT OK ???
JRST VFUOER ;NO, STUPID OPERATOR SO TRY AGAIN
PUSHJ P,LPTOEX ;GO PERFORM SOME PRELIMINARY PROCESSING
SETZM J$FLRM(J) ;LOAD THE RAM FIRST, ESPECIALLY
PUSHJ P,LODRAM ;RELOAD THE RAM
SETZM J$FLVT(J) ;FORCE A VFU RELOAD
PUSHJ P,LODVFU ;LOAD THE VFU
$RETT ;AND RETURN
CONANS: $STAB
KEYTAB (0,PROCEED)
$ETAB
SUBTTL COMMON DEVICE CONTROL -- LPTOEX - OUTPUT ERROR EXIT
LPTOEX: PUSHJ P,LPTDIE ;SEE IF TOO MANY ERRORS
PUSHJ P,@J$FLSH(J) ;RESET THE OUTPUT CHANNEL
JUMPT OEX.1 ;GO FINISH UP
MOVX S1,%RSUNA ;GET 'DEVICE NOT AVAILABLE' ERROR
PUSHJ P,RSETUP ;TELL QUASAR TO RESET THE OBJECT
PJRST SHUTIN ;SHUT DOWN THE DEVICE
OEX.1: TXNN S,VFULOD+BANHDR ;IF LOADING VFU OR PRINTING HDRS
SKIPN J$DIFN(J) ; OR IF WE ARE NOT IN A FILE?
$RETT ;THEN JUST RETURN
MOVE S1,J$RNCP(J) ;GET NUMBER OF COPIES PRINTED
AOS S1 ;MAKE INTO CURRENCT COPY NUMBER
$TEXT (LOGCHR,<^I/LPERR/I/O Error occurred during ^F/@J$DFDA(J)/^T/J$GSPL(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
SUBTTL COMMON DEVICE CONTROL -- LPTRES - RESET OUTPUT BUFFERS
LPTRES::MOVEI S1,BUFCHR ;GET CHARACTERS PER BUFFER
MOVEM S1,J$LBCT(J) ;SAVE AS BUFFER BYTE COUNT
MOVEM S1,J$LIBC(J) ;HERE ALSO
MOVE S1,J$LBUF(J) ;GET THE BUFFER ADDRESS
ADD S1,J$LBTZ(J) ;ADD THE BYTE PTR (LEFT HALF)
MOVEM S1,J$LBPT(J) ;SAVE AS BUFFER BYTE POINTER
MOVEM S1,J$LIBP(J) ;HERE ALSO
$RETT ;AND RETURN
SUBTTL COMMON DEVICE CONTROL - LPTDIE - STOP ON TOO MANY I/O ERRORS
LPTDIE::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 COMMON DEVICE CONTROL -- LPTANF - CHECK ANF-10 STATION
; ROUTINE TO CHECK ANF-10 STATION
; CALL: MOVE S1, STATION NUMBER/NAME
; PUSHJ P,LPTANF
LPTANF::MOVE T1,[.NDRNN,,T2] ;SET UP UUO AC
MOVEI T2,2 ;TWO WORDS FOLLOWING
MOVE T3,S1 ;ARGUMENT
NODE. T1, ;CHECK FOR ANF-10
CAMN T1,[.NDRNN,,T2] ;MAYBE NO NETWORK SUPPORT?
$RETT ;RETURN
$RETF ;NOT ANF-10
SUBTTL COMMON DEVICE CONTROL -- LPTDCN - CHECK DECNET NODE
; ROUTINE TO CHECK DECNET NODE
; CALL: MOVE S1, NODE NAME
; MOVE S2, KNOWN/REACHABLE/EXECUTOR FLAGS
; PUSHJ P,LPTDCN
LPTDCN::TDNN S1,[-1,,777600] ;NODE NAME?
$RETF ;NO
MOVEI T1,T2 ;SET UP UUO AC
MOVE T2,[.DNNDI,,2] ;FUNCTION,,LENGTH
IOR T2,S2 ;INCLUDE INTERESTING FLAGS
MOVE T3,S1 ;ARGUMENT
DNET. T1, ;CHECK STATUS
$RETF ;NO SUCH NODE OF NODE DOWN
$RETT ;RETURN
$RETF ;NOT DECNET
SUBTTL COMMON DEVICE CONTROL -- LPTRUL - PRINT A RULER
LPTRUL::$SAVE <P1,P2,P3> ;SAVE SOME ACS
MOVSI P1,-3 ;GET COUNTER
RULER1: MOVE P2,STARS(P1) ;GET ADDRESS OF TEXT STRING
MOVE P3,J$FWID(J) ;GET THE WIDTH
CAILE P3,^D132 ;IS IT REASONABLE?
MOVEI P3,^D132 ;NOW IT IS
RULER2: ILDB C,P2 ;GET A CHARACTER
PUSHJ P,DEVOUT ;PUT A CHARACTER
SOJG P3,RULER2 ;LOOP
PUSHJ P,CR23 ;SEND LF OR DC3
AOBJN P1,RULER1 ;LOOP FOR ALL RULER LINES
POPJ P, ;AND RETURN
SUBTTL COMMON DEVICE CONTROL -- LPTLOG - PRINT LPTSPL RUN LOG
LPTLOG::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
RLOG.1: MOVE S1,J$GBUF(T2) ;GET ADR OF BUFFER
PUSHJ P,STGOUT ;AND DUMP IT OUT
MOVE S1,J$GBUF(T2) ;GET THE PAGE ADDRESS
CAME T2,J ;SKIP IF THIS IS THE PRE-ALLOCATED PAGE
PUSHJ P,M%RPAG ;AND RELEASE IT
SOSLE T3 ;DECREMENT COUNT
AOJA T2,RLOG.1 ;AND LOOP IF NOT DONE
PUSHJ P,CRLF ;PRINT 1 CRLF
PUSHJ P,CRLF ;AND ANOTHER
PUSHJ P,CRLF ;AND ANOTHER
MOVE T1,J$GNLN(J) ;GET NUMBER OF LOG LINES
ADDI T1,5 ;ADD IN THE OVERHEAD
ADD T1,J$XPOS(J) ;AND ACCUMULATE VERTICAL POSITION
IDIV T1,J$FLIN(J) ;DID WE OVERFLW A PAGE?
MOVEM T2,J$XPOS(J) ;SAVE CURRENT POSITION
SETZM J$GNLN(J) ;AND DON'T PRINT IT AGAIN
SUB P3,T1 ;REDUCE PAGES TO PRINT
POPJ P, ;AND RETURN
SUBTTL COMMON DEVICE CONTROL -- LPTTXT - GENERATE "OUTPUT TO ..." TEXT
LPTTXT::SETZM J$LOUT(J) ;INIT NODE/DEVICE/UNIT TEXT
MOVE S1,STREAM ;GET STREAM NUMBER
MOVE S1,JOBOBA(S1) ;PICK UP OBJECT BLOCK ADDRESS.
MOVE S1,OBJ.ND(S1) ;GET NODE NAME/NUMBER
MOVEI T1,[ITEXT (<node ^N/S1/ >)]
SKIPN S1 ;HAVE A NODE?
MOVEI T1,[ITEXT (<>)] ;NO
MOVEI T2,[ITEXT (<device ^W/T4/ >)]
SKIPL T4,J$LCHN(J) ;GET CHANNEL IN USE
DEVNAM T4, ;CONVERT TO PHYSICAL DEVICE NAME
MOVE T4,J$LDEV(J) ;USE WHAT'S THERE
SKIPN T4 ;HAVE A DEVICE NAME?
MOVEI T2,[ITEXT (<>)] ;NO
MOVEI T3,[ITEXT (<unit type ^W/J$LTYP(J)/ >)]
SKIPN J$LTYP(J) ;HAVE A UNIT TYPE?
MOVEI T3,[ITEXT (<>)] ;NO
MOVE S2,S1 ;GET NODE NAME/NUMBER
IOR S2,T4 ; PLUS DEVICE
IOR S2,J$LTYP(J) ; PLUS UNIT TYPE
JUMPE S2,.RETT ;CHECK FOR NOTHING
$TEXT (<-1,,J$LOUT(J)>,<Output to ^I/(T1)/^I/(T2)/^I/(T3)/^0>)
$RETT ;RETURN
SUBTTL INIT FILE ROUTINES -- FH$ANY/FH$CHR/FH$CVT - READ A CHARACTER
; READ A CHARACTER FROM THE INITIALIZATION FILE
; CALL: PUSHJ P,FH$ANY/FH$CHR/FH$CVT
;
; TRUE RETURN: C CONTAINS CHARACTER. LOWER CASE AND TAB CONVERSIONS
; ARE PERFORMED IF CALLED AT THE FH$CVT ENTRY POINT.
; FALSE RETURN: EOF, IFN RELEASED.
FH$ANY::MOVNI S1,1 ;ACCEPT ANY CHARACTER
JRST CHR.1 ;ENTER COMMON CODE
FH$CHR::TDZA S1,S1 ;NO CONVERSION
FH$CVT::MOVEI S1,1 ;CONVERT
CHR.1: PUSH P,S1 ;SAVE FLAG
SKIPGE C,INISAV ;GET SAVED CHARACTER (IF ANY)
JRST CHR.2 ;THERE ISN'T ONE
SETOM INISAV ;SAVED CHARACTER INVALID NOW
JRST CHR.3 ;ENTER COMMON CODE
CHR.2: MOVE S1,INIIFN ;IFN
PUSHJ P,F%IBYT ;READ A CHARACTER
JUMPF CHR.5 ;CHECK FOR ERRORS
CHR.3: SKIPGE (P) ;ACCEPT ANY CHARACTER?
JRST CHR.4 ;YES
MOVEI C,(S2) ;COPY CHARACTER
CAIN C,.CHCRT ;CARRIAGE RETURN?
JRST CHR.2 ;IGNORE IT
CAIE C,.CHFFD ;CONVERT FORM FEEDS
CAIN C,.CHVTB ;AND VERTICAL TABS
MOVEI C,.CHLFD ;INTO LINEFEED
CHR.4: SKIPE INILIN ;COUNTING LINES?
CAIE C,.CHLFD ;AND AT EOL?
SKIPA ;NO TO EITHER
AOS INILIN ;COUNT THE LINE
POP P,S1 ;GET CONVERION FLAG BACK
JUMPLE S1,.RETT ;RETURN IF NO CONVERSION WANTED
CAIN C,.CHTAB ;TAB?
MOVEI C," " ;MAKE IT A SPACE
CAIL C,"a" ;LOWER
CAILE C,"z" ; CASE?
SKIPA ;NO
SUBI C," " ;MAKE UPPER CASE
$RETT ;RETURN
CHR.5: MOVEM S1,(P) ;SAVE ERROR CODE
CAIN S1,EREOF$ ;EOF?
JRST CHR.6 ;YES
MOVEI S1,CHRION ;ASSUME NON-LINE ORIENTED FILE
SKIPLE INILIN ;LINE NUMBERED?
MOVEI S1,CHRIOL ;YES
MOVEI S2,CHRRTX ;RUN LOG/REASON TEXT
PJRST FH$ERR ;REPORT ERROR AND RETURN TO CALLER
CHR.6: PUSHJ P,FH$XIT ;TERMINATE I/O
POP P,S1 ;GET ERROR CODE BACK
$RETF ;RETURN EOF
CHRION: ITEXT (<I/O error reading ^F/@INIFOB+FOB.FD/
Error: ^E/[-1]/>)
CHRIOL: ITEXT (<I/O error reading line ^D/INILIN/
File: ^F/@INIFOB+FOB.FD/
Error: ^E/[-1]/>)
CHRRTX: ITEXT (<I/O error reading ^F/@INIFOB+FOB.FD/>)
SUBTTL INIT FILE ROUTINES -- FH$BKP - BACKUP ONE CHARACTER
; BACKUP (REEAT) ONE CHARACTER
; CALL: MOVE C, CHARACTER
; PUSHJ P,FH$BKP
;
; TRUE RETURN: ALWAYS
; FALSE RETURN: NEVER
FH$BKP::MOVEM C,INISAV ;SAVE THE CHARACTER
$RETT ;RETURN
SUBTTL INIT FILE ROUTINES -- FH$COM - COMMENT PROCESSING
; CHECK FOR A COMMENT AND FLUSH REMAINDER OF LINE IF NECESSARY
; CALL: PUSHJ P,FH$COM
;
; TRUE RETURN: COMMENT FLUSHED (IF ANY)
; FALSE RETURN: EOF
FH$COM::CAIE C,.CHTAB ;TAB?
CAIN C," " ;SPACE?
PUSHJ P,FH$SKP ;SKIP THEM
$RETIF ;CHECK FOR ERRORS
PUSHJ P,FH$CON ;LINE CONTINUATION?
$RETIF ;CHECK FOR ERRORS
CAIE C,";" ;COMMENT?
CAIN C,"!" ;NEW-STYLE?
PJRST FH$EOL ;YES--FLUSH REMAINDER OF LINE
$RETT ;ELSE JUST RETURN
SUBTTL INIT FILE ROUTINES -- FH$CON - LINE CONTINUATION PROCESSING
; HANDLE LINE CONTINUATION
; CALL: PUSHJ P,FH$CON
;
; TRUE RETURN: NOT LINE CONTINUATION OR POSITIONED FOR I/O
; AT THE START OF THE NEXT LINE FOR INPUT
; FALSE RETURN: EOF
FH$CON::CAIE C,"-" ;SITTING ON A DASH?
$RETT ;NO--CAN'T BE LINE CONTINUATION
MOVE S1,INIIFN ;IFN
PUSHJ P,F%CHKP ;CHECKPOINT POSITION
JUMPF CON.2 ;CHECK FOR ERRORS
PUSH P,S1 ;REMEMBER POSITION FOR LATER
PUSH P,INILIN ;SAVE LINE NUMBER
PUSHJ P,CONSKP ;SKIP TABS AND SPACES
JUMPF CON.1 ;CAN'T BE CONTINUATION IF EOF
CAIE C,";" ;COMMENT?
CAIN C,"!" ;NEW-STYLE?
PUSHJ P,CONEOL ;FLUSH REMAINDER OF LINE
$RETIF ;CHECK FOR ERRORS
CAIE C,.CHLFD ;EOL?
JRST CON.1 ;NOT LINE CONTINUATION
ADJSP P,-2 ;PHASE STACK
PUSHJ P,CONSKP ;SKIP SPACES AT START OF NEXT LINE
$RETIF ;CHECK FOR ERRORS
JRST FH$CON ;SEE IF MULTIPLE CONTINATION LINES
CON.1: MOVE S1,INIIFN ;IFN
POP P,INILIN ;RESTORE ORIGINAL LINE NUMBER
POP P,S2 ;GET ORIGINAL POSITION BACK
PUSHJ P,F%POS ;REPOSITION FOR I/O
JUMPF CON.3 ;CHECK FOR ERRORS
MOVEI C,"-" ;GET BACK ORIGINAL CHARACTER
$RETT ;AND RETURN
CON.2: SKIPA S2,[CONCPE] ;CHECKPOINT ERROR
CON.3: MOVEI S2,CONPSE ;POSITIONING ERROR
PUSH P,S1 ;SAVE ERROR CODE
MOVE S1,S2 ;GET MESSAGE TEXT ADDRESS
MOVEI S2,CONRTX ;RUN LOG/REASON TEXT
PJRST FH$ERR ;REPORT ERROR AND RETURN TO CALLER
CONEOL: PUSHJ P,FH$CHR ;READ A CHARACTER
$RETIF ;CHECK FOR ERRORS
CAIE C,.CHLFD ;EOL?
JRST FH$EOL ;TRY AGAIN
$RETT ;RETURN
CONSKP: PUSHJ P,FH$CVT ;READ A CHARACTER
$RETIF ;CHECK FOR ERRORS
CAIN C," " ;SPACE?
JRST FH$SKP ;KEEP SEARCHING
$RETT ;RETURN
CONCPE: ITEXT (<Checkpoint failed
File: ^F/@INIFOB+FOB.FD/
Error: ^E/[-1]/>)
CONPSE: ITEXT (<Positioning failed
File: ^F/@INIFOB+FOB.FD/
Error: ^E/[-1]/>)
CONRTX: ITEXT (<Checkpoint/positioning error on ^F/@INIFOB+FOB.FD/>)
SUBTTL INIT FILE ROUTINES -- FH$EOL - READ UNTIL EOL
; READ UNTIL END OF LINE ENCOUNTERED
; CALL: PUSHJ P,FH$EOL
;
; TRUE RETURN: EOL FOUND
; FALSE RETURN: EOF
FH$EOL::PUSHJ P,FH$CHR ;READ A CHARACTER
$RETIF ;CHECK FOR ERRORS
CAIN C,"-" ;POSSIBLE LINE CONTINUATION?
PUSHJ P,FH$CON ;YES
$RETIF ;CHECK FOR ERRORS
CAIE C,.CHLFD ;EOL?
JRST FH$EOL ;TRY AGAIN
$RETT ;RETURN
SUBTTL INIT FILE ROUTINES -- FH$ERR - ERROR REPORTING
; REPORT INIT FILE ERROR AND DO ALL APPROPRIATE ERROR LOGGING
; CALL: PUSH P, ERROR CODE TO RETURN TO CALLER (FH$ERR ONLY)
; MOVE S1, ADDRESS OF ITEXT BLOCK FOR WTO MESSAGE
; MOVE S2, ADDRESS OF ITEXT BLOCK FOR RUN LOG AND REASON TEXT
; PUSHJ P,FH$ERR/FH$RPT
;
; TRUE RETURN: NEVER
; FALSE RETURN: ONLY IF CALLED AT FH$RPT ENTRY POINT. S1 WILL CONTAIN
; THE ERROR CODE PASSED AND THE STACK WILL BE PHASED
; CORRECTLY FOR FUTURE POPJS.
FH$ERR::TDZA TF,TF ;REPORT ERROR AND UNWIND
FH$RPT::MOVNI TF,1 ;REPORT ERROR ONLY
MOVEM S1,INITMP ;SAVE S1
MOVE S1,STREAM ;GET STREAM NUMBER
ADDI S1,JOBOBA ;OFFSET TO OBJECT BLOCK
EXCH S1,INITMP ;SAVE ADDRESS AND RESTORE S1
HLLM TF,INITMP ;SAVE FLAG
$WTO (<Initialization file error>,<^I/(S1)/>,@INITMP)
$TEXT (LOGCHR,<^I/LPERR/^I/(S2)/>) ;MAKE RUN LOG ENTRY
$TEXT (<-1,,J$WTOR(J)>,<^I/(S2)/^0>) ;SET REASON TEXT FOR NOTIFY
PUSHJ P,FH$XIT ;TERMINATE I/O
SKIPGE INITMP ;CALLER WANT CONTROL?
$RETF ;YES--RETURN
POP P,S1 ;GET ERROR CODE BACK
MOVE P,INIPDP ;GET SAVED PDL POINTER
PUSH P,INIEPC ;SET RETURN PC
$RETF ;RETURN TO CALLER
SUBTTL INIT FILE ROUTINES -- FH$INI - INITIALIZE I/O
; INITIALIZE I/O
; CALL: MOVE S1, FD ADDRESS
; MOVE S2, ADDRESS OF DATE/TIME WORD FOR COMPARRISON
; PUSHJ P,FH$INI
;
; TRUE RETURN: S1 CONTAINS A POSITIVE GALAXY IFN IF THE FILE NEEDS
; TO BE RE-READ. REGARDLESS OF THE CONTENTS OF S1, S2
; WILL CONTAIN THE ADDRESS OF AN UPDATED FD BLOCK FOR THE
; FILE JUST OPENED. ALSO, A COPY OF THE PDL POINTER
; IS SAVED FOR FATAL I/O ERROR RECOVERY. WHEN AN I/O
; ERROR IS DETECTED, ALL THE APPROPRIATE ERROR LOGGING
; WILL HAPPEN, THE IFN WILL BE RELEASED, AND CONTROL
; RETURNED TO THE FH$INI CALL +1. THIS SHOULD BE SOME
; SORT OF GALAXY ERROR CHECKING INSTRUCTION (JUMPF, SKIPF,
; ETC.). AT THIS TIME, S1 WILL CONTAIN THE SPECIFIC GALAXY
; ERROR CODE.
; FALSE RETURN: ERROR REPORTED TO OPERATOR, IFN RELEASED.
FH$INI::MOVE TF,P ;COPY PDL POINTER
POP TF,INIEPC ;SAVE RETURN PC FOR ERROR RECOVERY
MOVEM TF,INIPDP ;SAVE PDL POINTER FOR SAME
PUSH P,S2 ;SAVE DATE/TIME WORD ADDRESS
PUSH P,S1 ;SAVE FD ADDRESS
MOVE S1,[PFOB,,INIFOB] ;SET UP BLT
BLT S1,INIFOB+FOB.SZ-1 ;COPY PROTOTYPE BLOCK
POP P,S1 ;GET FD ADDRESS BACK
HRLZS S1 ;PUT IN LH
HRRI S1,INIFD ;MAKE A BLT POINTER
BLT S1,INIFD+FDXSIZ-1 ;COPY PROTOTYPE FILE DESCRIPTOR
SETOM INIIFN ;INDICATE FILE NOT OPENED YET
SETOM INISAV ;SAVED CHARACTER IS INVALID
SETZM INILIN ;THEREFORE NO LINE NUMBER EITHER
MOVEI S1,FOB.SZ ;FOB LENGTH
MOVEI S2,INIFOB ;FOB ADDRESS
PUSHJ P,F%IOPN ;OPEN FILE FOR INPUT
JUMPF INI.2 ;CHECK FOR ERRORS
MOVEM S1,INIIFN ;SAVE IFN
MOVNI S2,1 ;-1 FOR ACTUAL FILESPEC
PUSHJ P,F%FD ;GET FILESPEC
JUMPF INI.2 ;CHECK FOR ERRORS
LOAD S2,.FDLEN(S1),FD.LEN ;GET RETURNED FD LENGTH
HRLZS S1 ;POINT FD IN LH
HRRI S1,INIFD ;AND TO OUR STORAGE
ADDI S2,INIFD ;COMPUTE END OF BLT
BLT S1,-1(S2) ;COPY RETURNED FD
MOVE S1,INIIFN ;IFN FOR INPUT
MOVEI S2,FI.CRE ;FUNCTION CODE
PUSHJ P,F%INFO ;READ FILE CREATION DATE/TIME
JUMPF INI.2 ;CHECK FOR ERRORS
MOVE S2,S1 ;GET CREATION DATE/TIME
EXCH S2,(P) ;SWAP WITH STORAGE ADDRESS
XOR S1,(S2) ;COMPARE NEW DATE/TIME WITH OLD
CAIN S2,0 ;WAS AN ADDRESS REALLY SUPPLIED?
MOVEI S2,S1 ;INSURE S1 IS NON-ZERO TO FORCE RE-READ
POP P,(S2) ;UPDATE DATE/TIME FOR CALLER
JUMPN S1,INI.1 ;JUMP IF FILE HAS CHANGED
PUSHJ P,FH$XIT ;TERMINATE I/O
SETZ S1, ;INDICATE FILE HAS NOT CHANGED
MOVEI S1,INIFD ;POINT TO FILESPEC
$RETT ;RETURN
INI.1: AOS INILIN ;LINE
MOVE S1,INIIFN ;CALLER MIGHT WANT THE IFN
MOVEI S2,INIFD ;AND MAYBE THE REAL FILESPEC TOO
$RETT ;RETURN
INI.2: SKIPA S2,[INI.4] ;OPEN ERROR
INI.3: MOVEI S2,INI.5 ;CAN'T READ PARAMETERS
MOVEM S1,(P) ;SAVE ERROR CODE
MOVE S1,S2 ;GET MESSAGE TEXT ADDRESS
MOVEI S2,INI.6 ;RUN LOG/REASON TEXT
PJRST FH$ERR ;REPORT ERROR AND RETURN TO CALLER
INI.4: ITEXT (<Open failed for ^F/@INIFOB+FOB.FD/
Error: ^E/[-1]/>)
INI.5: ITEXT (<Cannot read file parameters
File: ^F/@INIFOB+FOB.FD/
Error: ^E/[-1]/>)
INI.6: ITEXT (<Initialization failed for ^F/@INIFOB+FOB.FD/>)
; PROTOTYPE FILE OPEN BLOCK
PFOB: $BUILD (FOB.SZ) ;BLOCK LENGTH
$SET (FOB.FD,FWMASK,INIFD) ;FD POINTER
$SET (FOB.CW,FB.PHY,1) ;PHYSICAL OPEN
$SET (FOB.CW,FB.LSN,1) ;STRIP OFF LINE SEQUENCE NUMBERS
$SET (FOB.CW,FB.BSZ,7) ;7-BIT BYTES
$EOB ;END OF BLOCK
SUBTTL INIT FILE ROUTINES -- FH$KEY - READ A POSSIBLY QUOTED STRING
; READ A KEYWORD INTO THE ATOM BUFFER AND COMPARE AGAINST A TABLE OF KEYWORDS
; CALL: MOVE S1, KEYWORD TABLE ADDRESS OR ZERO
; PUSHJ P,FH$KEY
;
; TRUE RETURN: S1 CONTAINS ADDRESS OF KEYWORD, S2 CONTAINS DATA FROM
; KEYWORD TABLE, AND C CONTAINS TERMINATING CHARACTER
; FALSE RETURN: S1 CONTAINS -1 IF NO INPUT OR ILLEGAL KEYWORD, OR EOF
; S2 IS INDETERMINATE
;
; *** NOTE *** KEYWORD TEXT MAY NOT BEGIN OR END WITH A DASH
FH$KEY::PUSHJ P,.SAVE3 ;SAVE SOME ACS
MOVE P3,S1 ;SAVE KEYWORD TABLE ADDRESS
MOVE S1,[INIATM,,INIATM+1] ;SET UP BLT
SETZM INIATM ;CLEAR FIRST WORD
BLT S1,INIATM+INIWDS-1 ;CLEAR ATOM BUFFER
MOVE P1,[POINT 7,INIATM] ;BYTE POINTER TO STORAGE
MOVEI P2,0 ;CLEAR COUNT
KEY.1: PUSHJ P,FH$CVT ;READ A CHARACTER
$RETIF ;CHECK FOR ERRORS
PUSHJ P,FH$CON ;LINE CONTINUATION?
$RETIF ;CHECK FOR ERRORS
CAIN C,"-" ;DASH IN MIDDLE OF KEYWORD?
JRST KEY.3 ;YES--WASN'T LINE CONTINUATION
KEY.2: CAIL C,"0" ;NUMERIC
CAILE C,"9" ; CHARACTER?
CAIL C,"A" ;UPPER
CAILE C,"Z" ; CASE?
CAIL C,"A"+40 ;LOWER
CAILE C,"Z"+40 ; CASE?
JRST KEY.4 ;NO GOOD
KEY.3: CAIGE P2,INISIZ ;BUFFER OVERFLOW?
IDPB C,P1 ;STORE CHARACTER
AOJA P2,KEY.1 ;LOOP BACK
KEY.4: SKIPN S1,P2 ;GET CHARACTER COUNT
SOJA S1,.RETF ;RETURN IF NO INPUT
SKIPE S1,P3 ;GET TABLE ADDRESS
JRST KEY.5 ;GOT ONE
MOVEI S1,INIATM ;ELSE JUST POINT TO PARSED TEXT
$RETT ;AND RETURN
KEY.5: HRROI S2,INIATM ;POINT TO ATOM BUFFER
PUSHJ P,S%TBLK ;SCAN THE TABLE FOR A MATCH
MOVE TF,S2 ;COPY RESULTING FLAGS
MOVE S2,S1 ;COPY TABLE ADDRESS (IF ANY)
MOVEI S1,INIATM ;POINT CALLER AT KEYWORD TEXT
TXNN TF,TL%EXM ;MUST HAVE AN EXACT MATCH
$RETF ;OR IT'S NO GOOD
HRRZ S2,(S2) ;GET DATA ASSOCIATED WITH KEYWORD
$RETT ;RETURN
SUBTTL INIT FILE ROUTINES -- FH$NUM/FH$DEC/FH$OCT - READ NUMBERS
; READ A NUMBER
; CALL: MOVE S1, RADIX
; PUSHJ P,FH$NUM
;
; TRUE RETURN: S1 CONTAINS NUMBER, C CONTAINS TERMINATING CHARACTER
; FALSE RETURN: EOF
FH$OCT::SKIPA S1,[EXP 10] ;RADIX 8
FH$DEC::MOVEI S1,12 ;RADIX 10
FH$NUM::PUSHJ P,.SAVE4 ;SAVE SOME ACS
MOVEI P1,(S1) ;SAVE RADIX
SETZB P2,P3 ;CLEAR RESULT, CHARACTER COUNT
MOVNI P4,1 ;ASSUME NEGATIVE
PUSHJ P,FH$CVT ;READ A CHARACTER
$RETIF ;CHECK FOR ERRORS
PUSHJ P,FH$CON ;LINE CONTINATION?
$RETIF ;CHECK FOR ERRORS
CAIE C,"-" ;NEGATIVE?
TDZA P4,P4 ;NO
NUM.1: PUSHJ P,FH$CVT ;READ A CHARACTER
$RETIF ;CHECK FOR ERRORS
PUSHJ P,FH$CON ;LINE CONTINUATION?
$RETIF ;CHECK FOR ERRORS
CAIL C,"0" ;RANGE
CAILE C,"0"(P1) ; CHECK
JRST NUM.2 ;NO GOOD
IMULI P2,(P1) ;SHIFT RESULT
ADDI P2,-"0"(C) ;ADD DIGIT
AOJA P3,NUM.1 ;LOOP BACK
NUM.2: CAIE P1,12 ;RADIX 10?
JRST NUM.3 ;NO
CAIN C,"." ;TRAILING DECIMAL POINT?
PUSHJ P,FH$CVT ;YES--READ NEXT CHARACTER
$RETIF ;CHECK FOR ERRORS
PUSHJ P,FH$CON ;LINE CONTINUATION?
$RETIF ;CHECK FOR ERRORS
NUM.3: CAIE P1,10 ;OCTAL?
CAIN P1,12 ;DECIMAL?
TDZA S1,S1 ;INIT MULTIPLIER SEARCH
$RETT ;ELSE JUST RETURN NOW
MOVE TF,MULPTR ;GET BYTE POINTER TO MULTIPLIERS
NUM.4: ILDB S2,TF ;GET A CHARACTER
JUMPE S2,NUM.5 ;DONE?
CAIE S2,(C) ;MATCH?
AOJA S1,NUM.4 ;NO
MOVEI S2,MUL8 ;ASSUME OCTAL
CAIN P1,12 ;DECIMAL?
MOVEI S2,MUL10 ;YES
ADDI S2,(S1) ;INDEX
IMUL P2,(S2) ;SHIFT RESULT
PUSHJ P,FH$CVT ;GET NEXT CHARACTER
$RETIF ;CHECK FOR ERRORS
PUSHJ P,FH$CON ;LINE CONTINUATION?
$RETIF ;CHECK FOR ERRORS
NUM.5: SKIPGE P4 ;NEGATIVE QUANTITY?
MOVNS P2 ;YES
MOVE S1,P2 ;GET RESULT
$RETT ;AND RETURN
MULSUF: ASCIZ /KMG/ ;MULTIPLIER SUFFIX CHARACTERS
MULPTR: POINT 7,MULSUF ;BYTE POINTER TO SUFFIX CHARACTERS
MUL8: OCT 1K, 1M, 1G ;OCTAL MULTIPLIERS
MUL10: DEC 1K, 1M, 1G ;DECIMAL MULTIPLIERS
SUBTTL INIT FILE ROUTINES -- FH$QST - READ A POSSIBLY QUOTED STRING
; READ A POSSIBLY QUOTED STRING INTO THE ATOM BUFFER
; CALL: PUSHJ P,FH$QST
;
; TRUE RETURN: S1 CONTAINS ADDRESS OF STRING, S2 CONTAINS THE LENGTH IN WORDS
; C CONTAINS TERMINATING CHARACTER
; FALSE RETURN: S1 CONTAINS -1 IF NO INPUT OR EOF, S2 IS INDETERMINATE
FH$QST::PUSHJ P,.SAVE3 ;SAVE SOME ACS
MOVE S1,[INIATM,,INIATM+1] ;SET UP BLT
SETZM INIATM ;CLEAR FIRST WORD
BLT S1,INIATM+INIWDS-1 ;CLEAR ATOM BUFFER
MOVE P1,[POINT 7,INIATM] ;BYTE POINTER TO STORAGE
SETZB P2,P3 ;CLEAR COUNT, QUOTE FLAG
PUSHJ P,FH$CHR ;READ A CHARACTER
$RETIF ;CHECK FOR ERRORS
PUSHJ P,FH$CON ;LINE CONTINUATION?
$RETIF ;CHECK FOR ERRORS
CAIE C,"'" ;SINGLE QUOTES?
CAIN C,"""" ;DOUBLE QUOTES?
SKIPA P3,C ;YES--REMEMBER FOR LATER
JRST QST.2 ;ENTER LOOP
QST.1: PUSHJ P,FH$CHR ;READ A CHARACTER
$RETIF ;CHECK FOR ERRORS
QST.2: JUMPE P3,QST.3 ;QUOTED STRING?
CAIE C,(P3) ;CLOSING QUOTE?
JRST QST.4 ;NO--GO STORE
PUSHJ P,FH$CHR ;READ NEXT CHARACTER
$RETIF ;CHECK FOR ERRORS
PUSHJ P,FH$CON ;LINE CONTINUATION?
$RETIF ;CHECK FOR ERRORS
JRST QST.5 ;GO RETURN TO CALLER
QST.3: PUSHJ P,FH$CON ;LINE CONTINUATION?
$RETIF ;CHECK FOR ERRORS
CAIN C,"-" ;DASH?
JRST QST.4 ;GO STORE
CAIL C,"0" ;NUMERIC
CAILE C,"9" ; CHARACTER?
CAIL C,"A" ;UPPER
CAILE C,"Z" ; CASE?
CAIL C,"A"+40 ;LOWER
CAILE C,"Z"+40 ; CASE?
JRST QST.5 ;NO GOOD
QST.4: CAIGE P2,INISIZ ;BUFFER OVERFLOW?
IDPB C,P1 ;STORE CHARACTER
AOJA P2,QST.1 ;LOOP BACK
QST.5: MOVE S1,P2 ;GET CHARACTER COUNT
ADDI S1,5 ;ROUND UP
IDIVI S1,5 ;COMPUTE WORDS
MOVEI S2,(S1) ;GET COUNT
MOVEI S1,INIATM ;GET BUFFER ADDRESS
$RETT ;ELSE RETURN GOODNESS
SUBTTL INIT FILE ROUTINES -- FH$SIX - READ A SIXBIT WORD
; READ A SIXBIT QUANTITY
; CALL: PUSHJ P,FH$SIX
;
; TRUE RETURN: S1 CONTAINS RESULT AND C CONTAINS TERMINATING CHARACTER
; FALSE RETURN: EOF
FH$SIX::PUSHJ P,.SAVE2 ;SAVE P1 AND P2
MOVE P1,[POINT 6,P2] ;BYTE POINTER TO RESULT
SETZ P2, ;INIT RESULT
SIX.1: PUSHJ P,FH$CVT ;READ A CHARACTER
$RETIF ;CHECK FOR ERRORS
PUSHJ P,FH$CON ;LINE CONTINUATION?
$RETIF ;CHECK FOR ERRORS
CAIL C,"0" ;RANGE
CAILE C,"9" ; CHECK
CAIL C,"A" ; THE
CAILE C,"Z" ; CHARACTER
JRST SIX.3 ;NO GOOD--FINISH UP
SIX.2: TRNE P2,77 ;OVERFLOW?
JRST SIX.1 ;YES--IGNORE THE REST
SUBI C," " ;CONVERT ASCII TO SIXBIT
IDPB C,P1 ;STORE CHARACTER
JRST SIX.1 ;LOOP FOR MORE
SIX.3: MOVE S1,P2 ;GET RESULT
$RETT ;ELSE RETURN GOODNESS
SUBTTL INIT FILE ROUTINES -- FH$SKP - SKIP TABS AND SPACES
; SKIP TABS AND SPACES
; CALL: PUSHJ P,FH$SKP
;
; TRUE RETURN: C CONTAINS THE FIRST NON-TAB/SPACE CHARACTER
; FALSE RETURN: EOF
FH$SKP::PUSHJ P,FH$CVT ;READ A CHARACTER
$RETIF ;CHECK FOR ERRORS
PUSHJ P,FH$CON ;LINE CONTINUATION?
$RETIF ;CHECK FOR ERRORS
CAIN C," " ;SPACE?
JRST FH$SKP ;KEEP SEARCHING
$RETT ;RETURN
SUBTTL INIT FILE ROUTINES -- FH$XIT - EXIT FILE PROCESSING
; THIS ROUTINE IS CALLED TO PREMATURELY (BEFORE EOF) TERMINATE
; FILE PROCESSING.
; CALL: PUSHJ P,FH$XIT
;
; TRUE RETURN: ALWAYS
; FALSE RETURN: NEVER
FH$XIT::SKIPLE S1,INIIFN ;GET IFN
PUSHJ P,F%RREL ;RELEASE IT
$RETT ;RETURN
SUBTTL OUTGET Exit Subroutines
OUTDDE: MOVX S1,%RSUDE ;NEVER AVAILABLE
$RETF ;RETURN
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
;**;[3007] Change code at OUTWON+2L
PUSH P,P1 ;[3007] SAVE P1 TOO
MOVSI P1,-NPRINT ;[3007] MAKE AOBJN POINTER
OUTW.1: MOVE S1,JOBSTW(P1) ;[3007] GET STREAM STATUS
TXNE S1,PSF%DO ;[3007] PRINTER OFFLINE?
$WTO (<^T/BELL/>,,@JOBOBA(P1)) ;[3007] YES, TELL THE OPERATOR.
AOBJN P1,OUTW.1 ;[3007] CHECK ALL PRINTERS
POP P,P1 ;[3007] RESTORE P1
POP P,S2 ;[3007] RESTORE S2
POP P,S1 ;[3007] RESTORE S1
$DSCHD(0) ;[3007] BLOCK THE PROCESS
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 OUTDMP -- Dump out buffers and wait
OUTDMP::
REPEAT BUFNUM+1,<
PUSHJ P,@J$OUTP(J) ;DUMP THE BUFFER
> ;END REPEAT BUFNUM
POPJ P, ;AND RETURN
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>B17+DOFRAC ;(13) THIS SKIPS 1/3 PAGE (VERT TAB)
EXP SUPRCH+NCLRFF+EOLCHR+DOFORM ;(14) THIS IS A FORM-FEED
EXP NCLRFF+EOLCHR+DEVOUT ;(15) CARRIAGE RETURN
EXP CHKARO ;(16) CONTROL-N
EXP CHKARO ;(17) CONTROL-O
EXP SUPRCH+EOLCHR+<2>B17+DOFRAC ;(20) THIS SKIPS 1/2 PAGE
EXP SUPRCH+EOLCHR+DODC1 ;(21) THIS SKIPS 2 LINES (DC1)
EXP SUPRCH+EOLCHR+DODC2 ;(22) THIS SKIPS 3 LINES (DC2)
EXP SUPRCH+EOLCHR+DODC3 ;(23) DC3 SKIPS 1 LINE
EXP SUPRCH+EOLCHR+<6>B17+DOFRAC ;(24) THIS SKIPS 1/6 OF A PAGE (DC4)
EXP CHKARO ;(25) CONTROL-U
EXP CHKARO ;(26) CONTROL-OL-V
EXP CHKARO ;(27) CONTROL-W
EXP CHKARO ;(30) CONTROL-X
EXP CHKARO ;(31) CONTROL-Y
EXP CHKARO ;(32) CONTROL-Z
EXP CHKARO ;(33) ESCAPE
EXP CHKARO ;(34) CONTROL-\
EXP CHKARO ;(35) CONTROL-]
EXP CHKARO ;(36) CONTROL-^
EXP CHKARO ;(37) CONTROL-
;FORTRAN CONTROL CHARACTOR TRANSLATION TABLE
DEFINE FORCHR(CHR,TRANS,N),<
EXP <CHR>B17+<N>B26+TRANS
> ;END DEFINE FORCHR
FORTAB: FORCHR " ",.CHLFD,1
FORCHR "0",.CHLFD,2
FORCHR "1",.CHFFD,1
FORCHR "2",20,1
FORCHR "3",13,1
FORCHR "/",24,1
FORCHR "*",23,1
FORCHR "+",.CHCRT,1
FORCHR 54,21,1
FORCHR "-",.CHLFD,3
FORCHR ".",22,1
NFORCH==.-FORTAB
SUBTTL 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
MOVEM T1,J$FTYP(J) ;STORE IT
PUSHJ P,FILCHR ;AND GO PROCESS THE FILE
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 FILCHR -- INTERPRET ALL CHARACTERS IN A FILE
; This routine will parse the file character by character until
;calling the appropriate routines depending on wether the character is
;a special break character that is device dependent, and will call the
;file type dependent routine.
FILCHR: SKIPN J$FASC(J) ;ASCII FILE?
JRST @J$FTYP(J) ;Yes, special handling
FILCH1: PUSHJ P,INPBYT ;GET A BYTE FROM THE FILE
JUMPF .RETT ;ALL DONE
FILCH2: SKIPL J$FASC(J) ;Allowing special interpretations?
SKIPN T3,J$DBRK(J) ;YES, GET THE ADDRESS OF THE BREAK MASK
JRST FILCH3 ;No, just process as normal
MOVEI T1,(C) ;COPY IT
IDIVI T1,^D32 ;CALCULATE WETHER IT IS A BREAK CHAR
ADDI T3,(T1) ;AND ADD THE WORD OFFSET TO IT
MOVEI T1,1 ;GET A BIT
MOVNS T2 ;MAKE CHARACTER NEGATIVE
LSH T1,^D35(T2) ;SHIFT IT OVER BY THE MOD(CHR,32) VALUE
TDNN T1,(T3) ;IS THIS CHARACTER A BREAK?
JRST FILCH3 ;NO CONTINUE TO PROCESS THIS FILE
PUSHJ P,@J$BKPR(J) ;ELSE CALL THE HANDLER
JUMPF .RETT ;ERROR RETURNS NOW (Fatal errors given)
JRST FILCH1 ;LOOP FOR THE WHOLE FILE
FILCH3: PUSHJ P,@J$FTYP(J) ;CALL THE FILE CHARACTER PROCESSOR
JRST FILCH1 ;AND LOOP FOR THE WHOLE FILE
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: SETZM J$XCOD(J) ;CLEAR EXISTING REPORT CODE
MOVEI T2,J$XCOD-1(J) ;SET UP PDP TO COMPILED CODE
SKIPN .FPFR1(E) ;WAS /REPORT SPECIFIED?
$RETT ;NO, JUST RETURN
STLST1: MOVE T3,[POINT 6,.FPFR1(E)] ;POINTER TO LIST
MOVEI T4,^D12 ;ABSOLUTE LIMIT
STLST2: ILDB T1,T3 ;GET A CHAR
JUMPE T1,STLSC ;JUMP IF DONE
ADDI T1,"A"-'A' ;CONVERT TO ASCII
CAIN T4,^D12 ;1ST TIME THRU, WE'VE GOT A CHARACTER
JRST STLST4 ;YES--CHAR ALRADY IN C
PUSH T2,SETLSA ;COMPILE A PUSHJ
PUSH T2,SETLSB ;WE HAVE AN ERROR RETURN THEN
STLST4: HLL T1,SETLSC ;PLACE CHAR IN CAIE
PUSH T2,T1 ;COMPILE THE CAIE
PUSH T2,SETLSD ;COMPILE THE JRST TO FLUSH7
SOJG T4,STLST2 ;LOOP FOR WHOLE STRING
STLSC: PUSH T2,[POPJ P,] ;AND PROCESS THE CHARACTER
POPJ P, ;RETURN
;THE INSTRUCTIONS WHICH ARE GENERATED:
SETLSA: PUSHJ P,INPBYT
SETLSB: JUMPF .RETT
SETLSC: CAIE C,0
SETLSD: JRST FLUSH7
SUBTTL 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
JUMPN S1,SETPFB ;USER SPECIFIED, IGNORE RIB ATTRIBUTES
MOVE S1,J$DIFN(J) ;GET THE IFN OF THE OUTPUT FILE
MOVEI S2,FI.DCC ;WE WANT THE DATA CARRIAGE CONTROL CODE
$CALL F%INFO ;TRY TO GET IT
JUMPF SETPFC ;RIB BITS NOT VALID,,EVALUATE EXTENSION
CAXN S1,.RBCFO ;FORTRAN CARRIAGE CONTROL?
JRST SETFFO ;YES, GO SET FILE FORTRAN
SETPFC: MOVE S1,J$XFOB+FOB.FD(J) ;GET ADDRESS OF OUTPUT FILE DESCRIPTOR
HLRZ S1,.FDEXT(S1) ;GET THE EXTENSION OF THE FILE
CAIN S1,'DAT' ;DATA FILE?
JRST SETFFO ;YES, GO SET FORTRAN
MOVE S1,J$DIFN(J) ;GET BACK THE FILE IFN
MOVX S2,FI.MCY ;SEE IF IT IS A MACY11 FILE
$CALL F%INFO ;GET THE INFO
JUMPE S1,SETPFA ;NOT, GO EVALUATE SWITCHES
MOVX S1,.FPF11 ;GET MACY11 VALUE
JRST SETPFB ;AND GO TO COMMON CODE
SETFFO: SKIPA S1,[EXP .FPFFO] ;MAKE LIKE /FILE:FORTRA
JRST SETPFB ;AND ACT LIKE THE USER TYPED IT
SETPFA: LOAD S1,.FPINF(E),FP.FFF ;GET /FILE
SETPFB: LOAD S2,.FPINF(E),FP.FPF ;GET /PRINT
TXZ S,ARROW ;CLEAR SOME INITIAL FLAGS
TXO S,NEWLIN!FCONV ;AND SET SOME OTHERS
SETZM J$FASC(J) ;ASSUME NON-ASCII FILE
MOVEI T1,LPTOCT ;ASSUME /PRINT:OCTAL
CAIN S2,%FPLOC ;IS IT?
POPJ P, ;YES, RETURN
MOVEI T1,LPTCOB ;NO, ASSUME /FILE:COBOL
CAIN S1,.FPFCO ;IS IT?
POPJ P, ;YES, RETURN
CAIN S2,%FPLAR ;/PRINT:ARROW?
TXO S,ARROW ;YES, LIGHT A FLAG
CAIN S2,%FPLSU ;/PRINT:SUPPRESS?
TXO S,SUPFIL!ARROW ;YES, LIGHT A BIT, (for arrow mode too)
MOVEI T1,LPTFOR ;ASSUME /FILE:FORTRAN
CAIN S1,.FPFFO ;IS IT?
JRST SETASC ;ALLOW ASCII PROCESSING FOR FONT FILES
MOVEI T1,LPTELV ;ASSUME /FILE:ELEVEN
CAIN S1,.FPF11 ;IS IT?
POPJ P, ;YES, RETURN
MOVEI T1,LPTRPT ;USE REPORT ROUTINE
SKIPE .FPFR1(E) ;UNLESS /REPORT WAS NOT SPECIFIED
POPJ P,
MOVEI T1,LPTASC ;ASSUME STANDARD ASCII
SETASC: SETOM J$FASC(J) ;Flag ascii file type
CAIN S2,%FPGRF ;ALLOW GRAPHICS SUPPORT?
MOVNS J$FASC(J) ; YES, ALLOW FONT SPECS
POPJ P, ;AND RETURN
SUBTTL LPTASC -- Print Regular ASCII on LPT
LPTASC: CAIGE C,40 ;PRINTABLE ASCII?
JRST LPTA.1 ;NO, GO HANDLE SPECIAL CHARS
TXNE S,FORWRD ;ARE WE FORWARD SPACING ???
$RET ;YES, RETURN NOW
SETZM J$XTOP(J) ;CLEAR TOF FLAG
JRST DEVOUT ;Output the character
LPTA.1: PUSHJ P,CHKSP ;GO HANDLE SPECIAL CHARS
$RET
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,@J$OUTP(J) ;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: JUMPE C,.POPJ ;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
JRST LPTCHR ;OTHERWISE PRINT IT
$RET
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
JRST LPTCHR ; A LINEFEED, SEND IT
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,LPTCHR ;SEND THE CHARACTER
SOSLE J$XFRC(J) ;COUNT DOWN THE REPEAT COUNTER
JRST FORC.3 ;AND LOOP
$RET
SUBTTL LPTRPT -- Process REPORT files
LPTRPT: PUSHJ P,INPBYT ;GET A BYTE FROM THE FILE
JUMPF .RETT ;AND RETURN WHEN DONE
PUSHJ P,LPTCHR ;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,LPTCHR
; RETURN HERE (EOF SET IF OVER LIMIT)
LPTCHR: CAIGE C,40 ;VISABLE ASCII
JRST CHKSP ;NO--SEE IF SPACE
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
TXNE S,SUPFIL!SUPJOB ;IN SUPPRESS MODE?
TXNN S1,SUPRCH ;YES, IS THIS CHARACTER SUPPRESSABLE?
SKIPA ;Skip the suppress stuff
JRST DOSUP ;SUPPRESS THE CHARACTER
TXNN S1,NCLRFF ;CLEAR FORMFEED FLAG?
SETZM J$XTOP(J) ;YES
JRST (S1) ;Dispatch the character
;HERE TO THROW AWAY A LINE
FLUSH7: PUSHJ P,INPBYT ;GET A BYTE
JUMPF .RETT ;RETURN ON EOF
PUSHJ P,ISEOL ;END OF LINE?
JUMPF FLUSH7 ;NO--LOOP FOR REST OF LINE
FLUSH8: PUSHJ P,INPBYT ;GET A BYTE
JUMPF .RETT ;RETURN ON EOF
PUSHJ P,ISEOL ;GOT EOL CHARACTER?
JUMPF LPTCHR ;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!SUPJOB ;ARROW MODE (From OPR SUPPRESS comd
JRST DEVOUT ;NO--JUST PRINT
DOARO: PUSH P,C ;SAVE C
MOVEI C,"^" ;LOAD A ^
PUSHJ P,DEVOUT ;PRINT THE ^
POP P,C ;RESTORE C
MOVEI C,100(C) ;MAKE INTO REAL LETTER
PJRST DEVOUT ;PRINT
;HERE ON A DC1
DODC1: MOVNI S1,2 ;DC1 SKIPS 2 LINES
JRST CNTDWN ;AND COUNT DOWN
;HERE ON A DC2
DODC2: MOVNI S1,3 ;DC2 SKIPS 3 LINES
JRST CNTDWN ;AND COUNT DOWN
;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.
;**;[4005]ADD 6 LINES AT CNTDW1:+3L 13-MAY-85/CTK
JRST [TXZ S,FORWRD ;[4005]TURN OFF FORWARD SPACE BIT
SKIPE J$FPIG(J) ;[4005]JUST FINISH FORWARDSPACE
JRST .+1 ;[4005]NEVER DID
PUSHJ P,SENDFF ;[4005]YES, SEND A FORM FEED
SETZM C ;[4005]ZAP THE CHARACTER
JRST .+1] ;[4005]CONTINUE
AOS J$RNPP(J) ;ADD 1 TO PAGES PER COPY COUNTER
TXNE S,FORWRD ;FORWARD SPACING ???
JRST [ ;Yes
TOPS10< MOVE S1,J$RNPP(J) ;Get pages printed per copy
IDIVI S1,FRWSKP ;Divide by DSCHD factor
SKIPE S2 ;Are we on an evenly divisible page?
JRST CNTDW2 ;No, skip this
SETZM SLEEPT ;No sleeptime wanted
$DSCHD(0) ;Let the other streams try
> ; End of TOPS10
JRST CNTDW2] ;Continue on
AOS J$APRT(J) ;NO, ADD 1 TO TOTAL PAGES COUNTER
;Here we keep track of where we are for backspaceing
CNTDW2: MOVE S1,J$FCBC(J) ;GET NUMBER OF BYTES IN THIS BUFFER
SUB S1,J$DBCT(J) ;CALC BYT POS OF THIS PAGE IN THIS BUFR
ADD S1,J$FTBC(J) ;CALC BYT POS OF THIS PAGE IN THIS FILE
MOVEM S1,@J$FBPT(J) ;SAVE THE PAGE ADDRESS IN THE PAGE TABLE
AOS S1,J$FBPT(J) ;BUMP TO NEXT PAGE TABLE ENTRY
CAIG S1,J$FPAG+PAGSIZ-1(J) ;ARE WE AT THE END OF THE PAGE TABLE ???
JRST CNTDW3 ;NO, CONTINUE ON
TXO S,FBPTOV ;YES, LITE PAGE TABLE OVERFLOW FLAG
MOVEI S1,J$FPAG(J) ;AND WRAP THE
MOVEM S1,J$FBPT(J) ; PAGE TABLE AROUND ITSELF
CNTDW3: PUSH P,C ;SAVE THE CURRENT CHAR
PUSHJ P,CHKALN ;CHECK FOR ALIGNMENT
POP P,C ;RESTORE THE OLD CHARACTER
MOVEI S1,3 ;LOAD A 3
CAIN C,23 ;GET HERE VIA DC3?
ADDM S1,J$XPOS(J) ;YES, GIVE HIM 3 XTRA LINES
CAIE C,23 ;WAS IT A DC3
;**;[4005]REVAMP CODE AT CNTDW3:+8L 13-MAY-85/CTK
JRST [SKIPG J$FPIG(J) ;[4005]ARE WE FORWARD SPACING
SETOM J$XTOP(J) ;[4005]NO, SET TOP OF FORM
JRST .+1] ;[4005]CONTINUE
$CALL LIMCHK ;Go check the limit
JUMPT DEVOUT ;Output character and return (not here)
$CALL INPFEF ;Error -- force an EOF
$RET
SUBTTL LIMCHK -- Check on page limits
Comment\
The purpose of this routine is to check and see if the current page limit
for the job has been exceeded. If so, then check with the operator to see
if the job should proceed. If ignore then set the bit and return. If the
jobe is to be aborted, then set that bit. In any case, if the job can be
continued, return true.
\
LIMCHK: MOVE S1,J$RLIM(J) ;GET LIMIT
SUB S1,J$APRT(J) ;GET AMOUNT PRINTED
;**;[4005]ADD 2 LINES AT LIMCHK:+2L 13-MAY-85/CTK
SKIPGE J$FPIG(J) ;[4005]ZERO FORWRD SPACE PAGES?
SETZM J$FPIG(J) ;[4005]YES, SET IT
TXNN S,ABORT+GOODBY ;ARE WE ON OUR WAY OUT OR
SKIPL S1 ; STILL UNDER QUOTA ???
JRST LIMC.5 ;Yes, return true
GETLIM S1,.EQLIM(J),FLEA ;GET FORMS-LIMIT-EXCEED ACTION
CAIN S1,.STCAN ;SEE IF CANCEL
JRST LIMC.4 ;IT WAS, DO IT
CAIN S1,.STIGN ;SEE IF IGNORE
JRST LIMC.5 ;Yes, return true
;DEFAULT TO ASK IF NOT IGNORE OR CANCEL
LIMC.1: MOVE S1,STREAM ;GET THE STREAM NUMBER
SETZM JOBCHK(S1) ;SAY WE WANT TO TAKE A CHECKPOINT
SETOM JOBUPD(S1) ; update the status also
$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 LIMC.2 ;YES, IGNORE THE ERROR
MOVEI S1,LIMANS ;POINT TO THE LIMIT ANSWER BLOCK
HRROI S2,J$RESP(J) ;POINT TO THE ANSWER
PUSHJ P,S%TBLK ;DO WE MATCH ???
TXNE S2,TL%NOM+TL%AMB ;DID WE FIND IT OK ???
JRST LIMC.1 ;NO, STUPID OPERATOR SO TRY AGAIN
HRRZ S1,0(S1) ;GET THE ROUTINE ADDRESS
JRST 0(S1) ;AND PROCESS THE RESPONSE
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;IF ANSWER WAS 'PROCEED' COME HERE
LIMC.2: MOVX S1,.STIGN ;YES, GET THE IGNORE BITS
STOLIM S1,.EQLIM(J),FLEA ;SAVE IT AS NEW LIMIT EX ACTION
JRST LIMC.5 ;Return true
;IF ANSWER WAS 'ABORT' COME HERE
LIMC.3: MOVE S1,STREAM ;GET THE STREAM NUMBER
$WTO (Aborting,<^R/.EQJBB(J)/>,@JOBOBA(S1)) ;TELL THE OPERATOR
LIMC.4: $TEXT(LOGCHR,<^I/LPERR/Page Limit Exceeded>)
SETZM J$XTOP(J) ;CLEAR TOP-OF-FORM FLAG
PUSHJ P,SENDFF ;SEND A FORM FEED
TXO S,ABORT ;LIGHT THE ABORT BIT
$TEXT (<-1,,J$WTOR(J)>,<Page limit exceeded^0>)
$RETF ;Limit exceeded, don't continue
LIMC.5: $RETT ;OK to proceed
LIMANS: $STAB
KEYTAB (LIMC.3,ABORT) ;ABORT
KEYTAB (LIMC.2,PROCEED) ;PROCEED
$ETAB
SUBTTL DEVOUT - Subroutine to output one char on selected device
;Call DEVOUT with a character to be output on the virtual device.
;Call PHSOUT only from a device driver which is bypassing its own
;character translation RAM or VFU simulations.
; Call:
; C/ Character to output
; PUSHJ P,DEVOUT
; Return here (HALTs if error)
;
DEVOUT::TXNE S,FORWRD ;ARE WE FORWRD SPACING ???
POPJ P, ;YES, RETURN.
PUSHJ P,@J$CHRO(J) ;SEE IF DRIVER NEEDS TO TRANSLATE
$RETIF ;IF DRIVER CHOOSES NOT TO, DON'T
PHSOUT::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,@J$OUTP(J) ;DUMP THE BUFFER
POP P,S1 ;RESTORE S1
JRST PHSOUT ;AND TRY AGAIN
;SENDFF - ROUTINE TO SEND A FF IF J$XTOP IS OFF
;
SENDFF::SKIPN J$FFDF(J) ;DRIVER HANDLE FORM FEEDS?
POPJ P, ;NO
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) ;YES, 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>)
PUSHJ P,@J$HDRW(J) ;SET UP HEADER WIDTHS FOR THIS PRINTER
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
SKIPN .EQUSR(J) ;USER NAME GIVEN?
JRST BANN.0 ;NO
MOVEI S1,.EQUSR(J) ;POINT TO NAME
HRLI S1,(POINT 8,) ;8-BIT ASCIZ
$TEXT (<-1,,J$PUSR(J)>,<^Q/S1/^0>)
JRST BANN.1 ;ONWARD
BANN.0:
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: SKIPN J$ALNF(J) ;PRINTER NEEDS FORMFEEDS?
PUSHJ P,SENDFF ;SEND A FORM FEED
PUSHJ P,@J$BNRI(J) ;INIT BANNER PAGES (POSSIBLE FONTS)
JUMPF .RETT ;THAT'S ALL IF NO BANNERS DESIRED
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
BANN.3: SKIPN .EQBOX(J) ;DISTRIBUTION BOX SPECIFIED?
JRST BANN.4 ;NO
MOVEI S1,.EQBOX(J) ;POINT TO STRING
HRLI S1,(POINT 8,) ;8-BIT ASCIZ
$TEXT (<-1,,J$PDST(J)>,<^Q/S1/^0>)
MOVEI S1,1 ;GET THE BLOCKSIZE
MOVEI S2,J$PDST(J) ;GET THE ADDRESS
PUSHJ P,PICTUR ;AND SEND IT OUT
MOVEI S1,^D11 ;ACCOUNT FOR LINES
ADDM S1,J$XPOS(J) ; JUST WRITTEN
BANN.4: PUSHJ P,PLPBUF ;PRINT A LINE
PUSHJ P,PLPBUF ;AND ANOTHER
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
TXNE S,SUPFIL!SUPJOB ;Are we suppressing forms?
SETZM J$XTOP(J) ;Don't believe we are at top of forms.
PUSHJ P,SENDFF ;SEND A FORMFEED
JUMPE P3,OUTDMP ;RETURN IF ZERO
JRST TRAI.2 ;SKIP FORMFEED SEND,,ALREADY DID IT
TRAI.1: SKIPN J$ALNF(J) ;PRINTER NEEDS FORM-FEEDS?
PUSHJ P,SENDFF ;SEND A FORMFEED
TRAI.2: PUSHJ P,@J$BNRI(J) ;GO SET UP FOR BANNER PAGES
SETZM J$XPOS(J) ;CLEAR THE VERTICAL POSITION
JUMPF .RETT ;THAT'S ALL IF NO BANNERS DESIRED
PUSHJ P,LPTLOG ;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
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: PUSHJ P,@J$RULR(J) ;DRAW A RULER IF APPROPRIATE
POPJ P,
;**;[3004] Change code at CR23. /LWS
CR23: SKIPE J$DC3F(J) ;SKIP IF DC3 NOT SUPPORTED
SKIPA S1,[[BYTE (7) 15,23,0,0,0]] ;[3004] PRINT OUT CR23
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
TXNE S,SUPFIL!SUPJOB ;Are we suppressing forms?
SETZM J$XTOP(J) ;Don't believe we are at top of forms.
;**;[4005]ADD AND REVAMP CODE AT HEAD:+3L 13-MAY-85/CTK
LOAD P1,.FPINF(E),FP.NFH ;[4005]GET THE NO HEADER BIT
SKIPE P1 ;[4005]SKIP IF WE WANT HEADERS
JRST [MOVE S1,J$FPIG(J) ;[4005]GET PAGE TO FORWARD SPACE
CAIG S1,1 ;[4005]FORWARD SPACING ???
PUSHJ P,SENDFF ;[4005]NO, SEND FORM FEED
PJRST OUTDMP] ;[4005]DUMP BUFFERS AND RETURN
PUSHJ P,SENDFF ;[4005]SEND A FORM FEED
SKIPN P3,J$FHEA(J) ;GET NUMBER OF PICTURE PAGES
PJRST OUTDMP ;DUMP BUFFERS AND RETURN
PUSHJ P,@J$HDRW(J) ;Set up the widths for the headers
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: PUSHJ P,@J$HDRI(J) ;SET POSSIBLE HEADER FONTS
JUMPF .RETT ;THAT'S ALL IF NO BANNERS DESIRED
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
$TEXT(TBFCHR,<^M^JFile ^F/@J$DFDA(J)/^T/J$GSPL(J)/, ^A>)
MOVEI S2,[ASCIZ / /] ;GET A STRING
CAIE P1,3 ;WIDTH CLASS 3?
MOVEI S2,[BYTE (7) .CHCRT,.CHLFD,.CHTAB,0]
MOVE P1,S2 ;Remember for short or long lines
TOPS10 <
MOVE S1,J$DIFN(J) ;GET THE IFN
MOVX S2,FI.GEN ;WANT THE FILE VERSION NUMBER
PUSHJ P,F%INFO ;GET IT
JUMPE S1,HED.NV ;NONE
$TEXT(TBFCHR,<version: ^V/S1/,^T/(P1)/^A>)
MOVE S1,J$DIFN(J) ;GET THE IFN
MOVX S2,FI.CRE ;WANT CREATION TIME
PUSHJ P,F%INFO ;GET IT
$TEXT(TBFCHR,<created: ^H/S1/, printed: ^H/[-1]/>) ;[2774]
JRST HED.VE ;DONE WITH THIS LINE
>
HED.NV: MOVE S1,J$DIFN(J) ;GET THE IFN
MOVX S2,FI.CRE ;WANT CREATION TIME
PUSHJ P,F%INFO ;GET IT
$TEXT(TBFCHR,<created: ^H/S1/,^T/(P1)/printed: ^H/[-1]/>) ;[2774]
HED.VE: PUSHJ P,TBFDMP ;AND DUMP THE BUFFER
MOVEI S1,J$LOUT(J) ;POINT TO NODE/DEVICE/UNIT TEXT
SKIPN (S1) ;HAVE SOMETHING?
JRST HEAD.2 ;NO
$TEXT (TBFCHR,<^T/(S1)/>) ;COPY TEXT
PUSHJ P,TBFDMP ;AND DUMP THE BUFFER
HEAD.2: GETLIM S1,.EQLIM(J),FORM ;GET FORMS NAME
$TEXT(TBFCHR,<Job parameters: Request created:^H/.EQAFT(J)/ Page limit:^D/J$RLIM(J)/^T/(P1)/ Forms:^W/S1/ Account:^T/.EQACT(J)/^A>)
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,<^T/(P1)/ File format:^W/FFMTAB-1(S2)/ Print mode:^W/FMTAB-1(S1)/^A>)
LOAD S1,.FPINF(E),FP.DEL ;GET /DELETE BIT
SKIPE S1 ;IS IT SET?
$TEXT(TBFCHR,< /DELETE^A>) ;YES, SAY SO
TOPS10 <
LOAD S1,.FPINF(E),FP.REN ;GET /DISPOSE:RENAME BIT
SKIPE S1 ;IS IT SET?
$TEXT(TBFCHR,< /DISPOSE:RENAME^A>) ;YES, SAY SO
>;END TOPS10
PUSHJ P,CRLF ;END THE LINE
MOVE S1,J$FPIG(J) ;GET STARTING PAGE
CAILE S1,1 ;SKIP IF 0 OR 1
;**;[4005]ADD 4 LINES AT HEAD.1:+58L 13-MAY-85/CTK
JRST [$TEXT(TBFCHR,<^M^JPrinting will start at page ^D/J$FPIG(J)/>)
CAIN P3,1 ;[4005]LAST HEADER ???
PJRST TBFDMP ;[4005]YES, DUMP THE BUFFER
JRST .+1] ;[4005]NO, CONTINUE
PUSHJ P,TBFDMP ;DUMP THE BUFFER
SKIPN J$ALNF(J) ;PRINTER NEED A FORMFEED
PJRST SENDFF ;SEND A FORM FEED
$RETT ;NO, RETURN NOW
FMTAB: SIXBIT /ARROW/
SIXBIT /ASCII/
SIXBIT /OCTAL/
SIXBIT /SUPRES/
SIXBIT /GRAPHI/
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
TOPS10 <
TXNE S1,FP.REN ;IS IT /DISPOSE:RENAME?
JRST SETH.4 ;YES, PROCESS THAT
>;END TOPS10
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
SETH.4: $TEXT(<-1,,J$PFL1(J)>,<^W/.FPONM(E)/^0>) ;OUTPUT ORIGINAL NAME
$TEXT(<-1,,J$PFL2(J)>,<^W3/.FPOXT(E)/^0>) ;AND EXTENSION
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
CAMLE S1,J$FLCL(J) ;Compare with the length class
MOVE S1,J$FLCL(J) ;Use the min. of the two.
MOVE S2,J$PFL1+1(J) ;GET 2ND WORD OF LINE 1
IOR S2,J$PFL2+1(J) ;OR IN SECOND WORD OF LINE 2
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
MOVE T3,P2 ;COPY POINTER TO TEXT
ILDB T3,T3 ;GET FOLLOWING CHARACTER
SKIPN T3 ;IF AT END OF STRING,
SKIPA T3,[5] ; DON'T NEED THE 2 SPACES
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
MOVSI S1,.STSPL ;ISSUE 'SETUUO' TO
SETUUO S1, ; CLEAR SPOOLING BITS
JFCL ;IGNORE THE ERROR
PJOB S1, ;GET OUR JOB NUMBER
MOVEM S1,LPJOB ;SAVE IT
MOVE S1,[ASCII/D/] ;DEFAULT TO DETACHED
MOVEM S1,LPTRM ;SAVE THE DESIGNATOR
GETLIN S1, ;GET OUR TTY NUMBER
TLNN S1,-1 ;ARE WE DEATCHED ???
JRST OPDI.1 ;YES, SKIP THIS
GTNTN. S1, ;GET OUR LINE NUMBER
JRST OPDI.1 ;FAILED,,WE ARE DETACHED
SETOM S2 ;GET A -1
TRMNO. S2, ;GET OUR TTY NUMBER
JRST OPDI.1 ;FAILED,,WE ARE DETACHED !!!
GETLCH S2 ;GET OUR LINE CHARACTERISTICS
MOVE TF,[ASCII/T/] ;DEFAULT TO A TTY
TXNE S2,GL.ITY ;ARE WE A PTY ???
MOVE TF,[ASCII/P/] ;YES, MAKE US 'PTY'
TXNE S2,GL.CTY ;ARE WE THE CTY ???
MOVE TF,[ASCII/C/] ;YES, MAKE US 'CTY'
MOVEM TF,LPTRM ;SAVE THE TERMINAL DESIGNATOR
HRRZM S1,LPLNO ;SAVE THE LINE NUMBER
JRST OPDI.1 ;CONTINUE
> ;END TOPS10 CONDITIONAL
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
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
OPDI.1: SETZ M, ;CLEAR MESSAGE ADDRESS
MOVE P1,DEVLST ;POINT TO START OF DEVICE DRIVER CHAIN
OPDI.2: PUSHJ P,@J$INIT-J$$DEV(P1) ;INITIALIZE
SKIPE P1,(P1) ;POINT TO NEXT DRIVER
JRST OPDI.2 ;LOOP BACK
SETZM FMOPN ;CLEAR FORMS.INI OPEN FLAG
$RETT ;AND RETURN
SUBTTL Mount and dismount structures -- Entry point
; Here to mount and dismount structures for each file being processed.
; Call: MOVE S1, FD address
; PUSHJ P,STRMNT ;TO MOUNT
; PUSHJ P,STRDMO ;TO DISMOUNT
;
; Note: Under TOPS-10, the number of structures that may be mounted is
; limited to the size of a search list. It is conceivable that we
; could be driving up to 15 devices. When a structure can't be
; mounted, the operator will be notified.
;
STRMNT: TDZA TF,TF ;REMEMBER MOUNT ENTRY POINT
STRDMO: MOVEI TF,1 ;REMEMBER DISMOUNT ENTRY POINT
TOPS20 <POPJ P,>
TOPS10<
$SAVE <P1,P2> ;SAVE SOME ACS
MOVE P1,TF ;SAVE MOUNT/DISMOUNT FLAG
PUSHJ P,STRXTR ;EXTRACT THE STRUCTURE NAME
MOVE P2,S1 ;SAVE FOR LATER
MOVE S1,[-STRLEN,,STRTAB] ;GET AOBJN POINTER TO STRUCTURE TABLE
SETZ S2, ;CLEAR EMPTY SLOT POINTER
STR.1: CAMN P2,0(S1) ;FOUND THE STR?
JRST @STRDSP(P1) ;DISPATCH
SKIPN 0(S1) ;THIS ENTRY IN USE?
SKIPE S2 ;NO - FOUND AN EMPTY SLOT YET?
SKIPA ;DO NOTHING
MOVE S2,S1 ;REMEMBER THE EMPTY SLOT
ADD S1,[1,,1] ;ACCOUNT FOR TWO WORD ENTRIES
AOBJN S1,STR.1 ;LOOP THROUGH STRUCTURE TABLE
JRST @STRDSP(P1) ;DISPATCH
STRDSP: EXP STRADD ;DISPATCH FOR MOUNT
EXP STRREM ;DISPATCH FOR DISMOUNT
SUBTTL Mount and dismount structures -- Add and remove structures
; Add a structure to our search list
;
STRADD: SKIPGE S1 ;AOBJN POINTER RUN OUT?
CAME P2,0(S1) ;ALREADY HAVE THIS STR MOUNTED?
JRST STRA.1 ;NEED TO MAKE A NEW ENTRY
AOS 1(S1) ;INCREMENT USE COUNT
POPJ P, ;AND RETURN CUZ IT'S ALREADY MOUNTED
STRA.1: JUMPE S2,STRERR ;CHECK FOR NO ROOM IN STRUCTURE TABLE
MOVE S1,S2 ;GET ADDRESS OF EMPTY SLOT IN TABLE
MOVEM P2,0(S1) ;STASH STR NAME
AOS 1(S1) ;GIVE IT A USE COUNT OF ONE
PUSHJ P,STRCHK ;CHECK EXISTANCE OF ALL STRS
PJRST STRJSL ;SET NEW JOB SEARCH LIST AND RETURN
; Remove a structure from our search list
;
STRREM: SKIPGE S1 ;AOBJN POINTER RUN OUT?
SOSE 1(S1) ;DECREMENT USE COUNT
POPJ P, ;STR STILL IN USE
SETZM 0(S1) ;ZAP STR NAME
PUSHJ P,STRCHK ;CHECK EXISTANCE OF STRS
PJRST STRJSL ;SET NEW JOB SEARCH LIST AND RETURN
>
SUBTTL Mount and dismount structures -- Extract structre from FD
; Extract a structure name from an FD
; Call: MOVE S1, FD address
; PUSHJ P,STRXTR
;
; On return, S1:= sixbit structure name
;
STRXTR:
TOPS10 <
MOVE S1,.FDSTR(S1) ;GET STRUCTURE NAME
MOVEM S1,DCHBLK+.DCNAM ;PUT IN DSKCHR BLOCK
MOVE S1,[.DCSNM+1,,DCHBLK] ;SET UP UUO
DSKCHR S1, ;GET THE DISK CHARACTERISTICS
SKIPA S1,.FDSTR(S1) ;CAN'T - ASSUME IT'S OK
MOVE S1,DCHBLK+.DCSNM ;GET STRUCTURE NAME
POPJ P, ;AND RETURN
> ;END TOPS-10 CONDITIONAL
REPEAT 0,<
TOPS20 <
HRROI S1,.FDSTG(S1) ;MAKE IT -1,,ADDR
$CALL S%SIXB ;CONVERT ASCII TO SIXBIT
MOVE S1,S2 ;GET THE NAME
POPJ P, ;RETURN
> ;END TOPS-20 CONDITIONAL
>
SUBTTL Mount and dismount structures -- Check structure existance
; Check the existance of all structures in the structure table. This
; turns out to e cheaper and easier than reading our existing search list
; and then modifying it to accomodate our needs.
; Call: PUSHJ P,STRCHK
;
STRCHK:
TOPS10 <
MOVE S1,[-STRLEN,,STRTAB] ;GTE AOBJN POINTER
STRC.1: HRRZ S2,S1 ;POINT TO STR NAME
SKIPE (S1) ;AVOID A UUO IF NO STR
DSKCHR S2, ;MAKE SURE IT'S STILL THERE
SKIPA ;LOSE
JRST STRC.2 ;ONWARD
SETZM 0(S1) ;ZAP STR NAME
SETZM 1(S1) ;AND THE USE COUNT
STRC.2: ADD S1,[1,,1] ;ACCOUNT FOR TWO WORD ENTRIES
AOBJN S1,STRC.1 ;LOOP THROUGH TABLE
POPJ P, ;RETURN
> ; END TOPS-10 CONDITIONAL
TOPS20 <POPJ P,> ;NO-OP FOR THE -20
SUBTTL Mount and dismount structures -- Change job search list
; Here to build a new job search list
; Call: PUSHJ P,STRJSL
;
STRJSL:
TOPS10 <
MOVEI S1,.FSDSL ;GET FUNCTION CODE
MOVEM S1,STRBLK+.FSFCN ;SAVE IT
SETOM STRBLK+.FSDJN ;SET JOB NUMBER TO -1 (US)
SETOM STRBLK+.FSDPP ;SET PPN TO -1 (US)
MOVEI S1,DF.SRM ;GET A BIT
MOVEM S1,STRBLK+.FSDFL ;REMOVE STRS NOT IN NEW S/L
MOVE S1,[-STRLEN,,STRTAB] ;GTE AOBJN POINTER
MOVEI S2,STRBLK+.FSDSO ;POINT TO FIRST FREE WORD
STRJ.1: MOVE TF,0(S1) ;GET A STR NAME
JUMPE TF,STRJ.2 ;SKIP EMPTY SLOTS
MOVEM TF,.DFJNM(S2) ;SAVE IT
SETZM .DFJDR(S2) ;CLEAR DIRECTORY
SETZM .DFJST(S2) ;NO SPECIAL STATUS BITS
ADDI S2,.DFJBL ;POINT TO NEXT FREE ENTRY
STRJ.2: ADD S1,[1,,1] ;ACCOUNT FOR TWO WORD ENTRIES
AOBJN S1,STRJ.1 ;LOOP
SETOM .DFJNM(S2) ;MARK THE FENCE
SUBI S2,STRBLK ;COMPUTE LENGTH OF S/L BLOCK
HRLI S2,STRBLK ;POINT TO S/L BLOCK
MOVSS S2 ;MAKE IT -LEN,,ADDR
STRUUO S2, ;DEFINE OUR NEW S/L
JRST STRERR ;CAN'T
POPJ P, ;RETURN
> ;END OF TOPS-10 CONDITIONAL
REPEAT 0,<
TOPS20 <
MOVEM P2,STRBLK ;SAVE STR NAME
SETZM STRBLK+1 ;TERMINATE IT
MOVE S1,[POINT 6,STRBLK] ;BYTE POINTER TO SIXBIT STR NAME
HRROI S2,STRBLK+3 ;GET -1,,ADDRESS
MOVEM S2,STRBLK+2 ;SAVE IT
MOVE S2,[POINT 7,STRBLK+3] ;BYTE POINTER TO ASCIZ STR NAME
STRJ.1: ILDB TF,S1 ;GET A CHARACTER
SKIPE TF ;END?
ADDI TF," " ;CONVERT SIXBIT TO ASCII
IDPB TF,S2 ;PUT A CHARACTR
JUMPN TF,STRJ.1 ;LOOP
MOVE S1,[1,,.MSIMC ;MOUNT FUNCTION
1,,.MSDMC](P1) ;DISMOUNT FUNCTION
MOVEI S2,STRBLK+2 ;POINT TO ASCIZ STR NAME
MSTR ;CHANGE THE MOUNT COUNT
ERJMP STRERR ;CAN'T
POPJ P, ;RETURN
> ;END OF TOPS-20 CONDITIONAL
>
; Here on all STRUUO errors
; We'll try to correct our database so we don't get out of
; synch with the real world. If we ever get here, there's
; a good chance the monitor is F@#$%ed up anyway, so maybe
; it's not so important...
;
STRERR: MOVE S1,[[ASCIZ |mount|] ;ASSUME MOUNTING
[ASCIZ |dismount|]](P1) ;GET CORRECT TEXT
$WTO (<LPTSPL error>,<Cannot ^T/(S1)/ structure ^W/P2/>,,$WTFLG(WT.SJI))
JUMPN P1,.POPJ ;RETURN IF A DISMOUNT
MOVE S1,[-STRLEN,,STRTAB] ;GET AOBJN POINTER TO STRUCTURE TABLE
STRE.1: CAME P2,0(S1) ;[3003] FOUND THE STR?
JRST STRE.2 ;NOPE
SOSN 1(S1) ;DECREMENT USE COUNT
SETZM 0(S1) ;ZAP STR NAME IF COUNT = ZERO
POPJ P, ;RETURN
STRE.2: ADD S1,[1,,1] ;ACCOUNT FOR TWO WORD ENTRIES
AOBJN S1,STRE.1 ;LOOP THROUGH TABLE
POPJ P, ;REALLY SICK
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
ZZ==0
REPEAT NPRINT,<
MOVEI S1,INTDEV+<LPHDSZ*ZZ> ;GET ADDRESS OF LPT HEADER
MOVEM S1,VECDEV+<4*ZZ>+.PSVNP ;STORE IN THE VECTOR
ZZ==ZZ+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+PS.RDH ;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: ZZ==0
REPEAT NPRINT,<
LPINHD(ZZ)
ZZ==ZZ+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 ???
JRST [SETZM JOBCHK(S1) ;YES, SAY WE WANT A CHECKPOINT
SETOM JOBUPD(S1) ; update the status also
JRST LPIN.1] ;Go continue
LPIN.1: TXNE T1,PS.RDH ;DEVICE HUNG?
JRST LPIN.3 ;YES
TXNE T1,PS.ROL ;IS IT ON-LINE?
;**;[3007] Change code at LPIN.1+3L
JRST [MOVX T2,PSF%DO+PSF%OB ;YES, CLEAR ON-LINE & OUTPUT-BLOCKED
SETZM J$LBCT(J) ;[3007] MAKE SURE WE DON'T USE BUFFER
JRST .+1] ;[3007] CONTINUE
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.
MOVE T2,.PSVIS(S2) ;[3005] GET THE FILE STATUS BITS
TXC T2,IO.ERR ;[3005] CHECK TO SEE IF ALL ERROR BITS ARE LIT
TXNN T2,IO.ERR ;[3005] ARE THEY ???
SKIPL J$LREM(J) ;YES, IS THIS A REMOTE LPT ???
SKIPA ;NOT ALL BITS LIT OR NOT REMOTE,,SKIP
$DEBRK ;ELSE REMOTE WENT DOWN,,RETURN NOW !!!
TXC T1,PS.RIE!PS.ROE!PS.RDO ;[3005] JUST THE ONES WE WANT
TXNN T1,PS.RIE!PS.ROE!PS.RDO ;[3005] CPU CROAK OR JUST LPT OFF-LINE?
JRST LPIN.2 ;DEAD CPU
MOVEI T1,OUTWON ;LPT OFFLINE,,LOAD RESTART ADDR
EXCH T1,.PSVOP(S2) ;STORE FOR DEBRK AND GET OLD ADRESS
;**;[3013] Insert 2 lines and change 1 line after LPIN.1+25L. /LWS
MOVE T2,STREAM ;[3013] GET ACTIVE STREAM
MOVE T2,JOBPAG(T2) ;[3013] GET JOB PAGE ADDR OF ACTIVE STREAM
MOVEM T1,J$LIOA(T2) ;[3013] STORE OLD-ADDRESS FOR DEVICE ON AGAIN
$DEBRK ;DISMISS THE INTERRUPT
;**;[3001] Rework CPU failure and hung device interrupt code. /LWS
LPIN.2: SKIPA T2,[CPUFAI] ;[3001] GET ROUTINE ADDR FOR CPU FAILURE
LPIN.3: MOVEI T2,HNGDEV ;[3001] GET ROUTINE ADDR FOR HUNG DEVICE
;**;[2776] Change 1 line at LPTIN.3+0L. 21-Dec-83 /LWS
SETZM JOBSTW(S1) ;MAKE JOB RUNABLE
MOVE T1,J$RACS+P(J) ;GET STREAM STACK
PUSH T1,T2 ;[3001] AVOID RACES,,T2 HAS ROUTINE ADDR
MOVEM T1,J$RACS+P(J) ;REPLACE PDL POINTER
CAMN S1,STREAM ;HUNG DEVICE IN STREAM CONTEXT?
MOVEM T2,.PSVOP(S2) ;[3001] SET RETURN ADDRESS
$DEBRK ;DISMISS THE INTERRUPT
> ;END TOPS10 CONDITIONAL
SUBTTL CPU failure and Hung device code
TOPS10 <
CPUFAI: TDZA P2,P2 ;INDICATE CPU FAILURE
HNGDEV: MOVEI P2,1 ;INDICATE HUNG DEVICE
MOVE P1,STREAM ;GET THE STREAM NUMBER
MOVE J,JOBPAG(P1) ;SET UP JOB DATA BASE RELOCATION
MOVE S,J$RACS+S(J) ;GET THE STREAM STATUS BITS.
TXO S,GOODBY!RQB!ABORT ;ON OUR WAY OUT
MOVEM S,J$RACS+S(J) ;UPDATE FLAGS
MOVE S1,[[ASCIZ |CPU failure|]
[ASCIZ |Hung device|]](P2) ;GET TEXT
$WTO (<^T/(S1)/; job requeued>,<^R/.EQJBB(J)/>,@JOBOBA(P1))
HNGD.1: 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
HNGD.2: SKIPE S1,J$DIFN(J) ;GET IFN
PUSHJ P,F%REL ;CLOSE FILE
SETZM J$DIFN(J) ;CLEAR IT
MOVEM S,J$RACS+S(J) ;SAVE UPDATED AC 'S'
SETZM JOBACT(P1) ;MAKE JOB RUNABLE
PUSHJ P,QRELEASE ;RELEASE THE REQUEST
MOVX S1,%RSUDE ;GET NON-EXISTANT DEVICE CODE
PUSHJ P,RSETUP ;TELL QUASAR WE'RE DONE
PJRST SHUTIN ;SHUT DOWN AND RETURN TO SCHEDULER
> ;END TOPS10 CONDITIONAL
SUBTTL STARS - Job definition/separation line definitions
STARS:: POINT 7,STARS1 ;LINE 1
POINT 7,STARS2 ;LINE 2
POINT 7,STARS3 ;LINE 3
;**;[2770]CHANGE 3 LINES AFTER STARS1: 15-FEB-83/CTK
STARS1: ASCII /000000000000000000000000000000000000000000000000000000000000/
ASCII /000000000000000000000000000000000000000111111111111111111111/
ASCII /111111111111/ ;[2770]
STARS2: ASCII /000000000111111111122222222223333333333444444444455555555556/
ASCII /666666666777777777788888888889999999999000000000011111111112/
ASCII /222222222333/ ;[2770]
STARS3: ASCII /123456789012345678901234567890123456789012345678901234567890/
ASCII /123456789012345678901234567890123456789012345678901234567890/
ASCII /123456789012/ ;[2770]
LPTEND::PRGEND LPTSPL
TITLE LPTVFU - LP20 VFU and RAM Simulator for LPTSPL-10
SUBTTL T. Litt/TL 30-Dec-85
;
;
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984,1985,1986,1987.
; ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
; AND WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS
; SOFTWARE OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
; OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON. NO TITLE TO
; AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE
; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
; BY DIGITAL EQUIPMENT CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
; OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY
; DIGITAL.
;
SEARCH GLXMAC ;SEARCH GALAXY PARAMETERS
SEARCH QSRMAC ;SEARCH QUASAR PARAMETERS
SEARCH ORNMAC ;SEARCH ORION/OPR PARAMETERS
SEARCH LPTMAC ;SEARCH LPTSPL PARAMETERS
PROLOG (LPTVFU)
IF2,<PRINTX Assembling GALAXY-10 LPTVFU>
SALL ;FOR CLEAN LISTINGS
.DIRECT FLBLST ;FOR CLEANER LISTINGS
LPTVFU: ENTRY LPTVFU ;LOAD IF LIBRARY SEARCH
SUBTTL VFUINX - VFU Simulator Initialization
; Device initialization. This routine is called by the
; Device driver's initialization routine (xxxINX). Ordinarily,
; the driver can PJRST here instead of returning %RSUOK.
;
; Call: MOVE J, job data base address
; MOVE M, Page containing SETUP message or 0 if LPTSPL startup
; PUSHJ P,VFUINX
;
; TRUE return: Initialization complete
; FALSE return: Never
ENTRY VFUINX
VFUINX::JUMPE M,.RETT ;RETURN IF LPTSPL INITIALIZATION
SETOM J$FFDF(J) ;VFU Simulator DOES FORM FEEDS
SETOM J$DC3F(J) ;VFU Simulator DOES DC3S
SETOM J$MNTF(J) ;VFU Simulator SUPPORTS MOUNTABLE FORMS
MOVEI S1,%RSUOK ;LOAD THE CODE
$RETT ;RETURN
SUBTTL VFUOPX - OPEN device
; This routine will setup device specific information for an OPEN.
; This routine is called by the Device Driver's xxxOPX routine to
; setup the VFU database for an OPEN.
;
; Call: MOVE J, job data base address
; PUSHJ P,VFUOPX
;
; TRUE return: Always
; FALSE return: Never
ENTRY VFUOPX
VFUOPX::MOVE S1,[SIXBIT /LP64/] ;DEFAULT THE RAM TO 64 CHARACTERS
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.
SETOM J$LDVF(J) ;OUR VFU IS ALWAYS LOADABLE
SETOM J$LDRM(J) ;AND SO IS OUR RAM
$RETT
SUBTTL VFUFVU - Load VFU
; This routine is called to load the VFU for a printer.
;
; This routine is called by the Device Driver's xxxVFU routine.
; Ordinarily, the device driver routine consists only of a PJRST.
;
; Call: MOVE J, job data base address
; MOVEI S1,function
; PUSHJ P,VFUVFU
;
; TRUE return: VFU loaded or no VFU needed, C/ LP20 START CODE OF LOADED VFU
; FALSE return: VFU load failed, error code in S1
ENTRY VFUVFU
VFUVFU::JRST @[IFIW CHKVFU ;(0) CHECK VFU STATUS
IFIW LODVFU ;(1) LOAD VFU
IFIW .RETT](S1) ;(2) OUTPUT ERROR DURING LOAD
LODVFU: HLLZS J$VLIN(J) ;RELOADING VFU SETS IT TO LINE 0
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 HDWVF0 ;FILE NOT FOUND, TRY HARDWARE VFU
MOVEM S1,J$FVIF(J) ;ELSE,,SAVE THE IFN
MOVEI S1,V$$LEN ;SIZE OF A VFU
SKIPE S2,J$VVFU(J) ;ADDRESS
$CALL M%RMEM ;GET RID OF IT
SETZM J$VVFU(J)
MOVE S1,J$FVIF(J) ;GET THE IFN
MOVX S2,FI.SIZ ;FILE SIZE
$CALL F%INFO
CAILE S1,<V$$LEN-V$DATA>*5 ;BETTER FIT
JRST HDWVFU ;OOPS.
MOVX S1,V$$LEN ;ALLOCATE FOR THE MAX
$CALL M%GMEM ;ALLOCATE SPACE FOR THE VFU
MOVEM S2,J$VVFU(J) ;REMEMBER IT
MOVE S1,STDVFU+V$PTR ;GET A STANDARD POINTER
ADDI S1,-<STDVFU>(S2) ;RELOCATE ADDRESS
MOVEM S1,V$PTR(S2) ;SAVE BYTE POINTER TO VFU
PUSH P,S1 ;HM
VFU.4: SOSGE J$FBYT(J) ;CHECK AND SEE IF DATA IS IN BUFFER.
JRST VFU.6 ;IF NOT, GET NEXT BUFFER.
ILDB C,J$FPTR(J) ;PICK UP A BYTE.
DPB C,(P) ;SAVE A BYTE
IBP (P)
JRST VFU.4 ;GO GET ANOTHER.
VFU.6: MOVE S1,J$FVIF(J) ;GET VFU IFN.
PUSHJ P,F%IBUF ;GET ANOTHER BUFFER.
JUMPF VFU.5 ;IF NO MORE,,RETURN
MOVEM S1,J$FBYT(J) ;SAVE THE BYTE COUNT
MOVEM S2,J$FPTR(J) ;SAVE THE BYTE POINTER.
JRST VFU.4 ;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
;HERE IF VFU FILE IS NOT AROUND, TRY TO RECOVER BY LOADING THE
;HARDWARE VFU
HDWVFU: MOVE S1,J$FVIF(J) ;GET IFN OF VFU FILE
PUSHJ P,F%REL ;RELEASE FILE
HDWVF0: MOVEI S1,V$$LEN ;SIZE OF A VFU
SKIPE S2,J$VVFU(J) ;ADDRESS
$CALL M%RMEM ;GET RID OF IT
SETZM J$VVFU(J)
MOVE T1,J$FTAP(J) ;TYPE WE TRIED TO LOAD
CAMN T1,D$TAPE## ;IS IT THE DEFAULT
VFUHVL: TDZA S1,S1 ;HARDWARE VFU LOADED INSTEAD
VFUFAI: MOVEI S1,1 ;VFU LOAD FAILED
$RETF
VFU.5: ADJSP P,-1 ;BYE (TE) POINTER
;CHECK FOR VALID STOP CODE AND LENGTH??
MOVE T1,J$VVFU(J) ;GET ADDRESS OF OUR NEW VFU
LDB C,V$PTR(T1) ;FETCH THE FIRST BYTE
CAIN C,25 ;IF SIMPLE START
MOVEI C,356 ;CONVERT TO LP20 SIMPLE START
CAIN C,356 ;IF SIMPLE START
JRST VFU.5A ;IT'S VALID
CAIN C,26 ;6-LPI START?
MOVEI C,354 ;YES, MAKE LP20
CAIN C,27 ;8-LPI START?
MOVEI C,355 ;YES, MAKE LP20
CAIE C,354 ;6-LPI?
CAIN C,355 ;8-LPI?
CAIA ;VALID START CODE
PJRST HDWVFU ;INVALID START CODE
VFU.5A: MOVE S1,J$FVIF(J) ;GET VFU'S IFN
$CALL F%REL ;RELEASE THE FILE
$RETT ;OK,,JUST RETURN
CHKVFU: SKIPN J$VVFU(J) ;IS VFU LOADED?
$RETF ;NO
$RETT ;YES
SUBTTL VFURAM - Load RAM
; This routine is called to load the character translation
; RAM for a printer. This routine is called from the
; Device driver's xxxRAM routine, which ordinarily consists only
; of a PJRST.
;
; Call: MOVE J, job data base address
; PUSHJ P,VFURAM
;
; TRUE return: RAM loaded or no RAM needed
; FALSE return: RAM load failed
ENTRY VFURAM
VFURAM::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
SETO T2, ;FLAG FOR RAM.2 SAYING "FAILED"
LOOKUP 17,RLKUP ;FIND THE FILE WE WANT
JRST RAM.2 ;NOT THERE,,TRY SOMETHING ELSE
MOVEI S1,R$$LEN ;SIZE OF A RAM
SKIPE S2,J$VRAM(J) ;ADDRESS
$CALL M%RMEM ;GET RID OF IT
SETZM J$VRAM(J)
HLRO T3,RLKUP+3 ;GET -FILE LENGTH
MOVMS T3 ;WANT POSITIVE LENGTH
SETOM T1, ;IF FAIL, WE NEED OPR ACTION
CAILE T3,R$$LEN ;BETTER FIT
JRST RAM.2 ;OOPS.
MOVEI S1,R$$LEN ;ALLOCATE FOR THE MAX
$CALL M%GMEM ;ALLOCATE SPACE FOR THE RAM
MOVEM S2,J$VRAM(J) ;REMEMBER IT
MOVE S1,LP64RM+R$PTR ;GET A STANDARD POINTER
ADDI S1,-<LP64RM>(S2) ;RELOCATE ADDRESS
MOVEM S1,R$PTR(S2) ;SETUP POINTER
MOVEI T1,R$DATA-1(S2) ;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
TDZA S2,S2 ;CONTINUE ON SUCCESSFUL RETURN
RAM.1: SETOM S2 ;INDICATE RAM LOAD ERROR
MOVE T1,S2 ;SAVE THE RAM LOAD FLAG
JUMPE S2,RAM.2 ;JUMP IF LOADED OK
MOVEI S1,R$$LEN ;SIZE OF BUFFER
SETZ S2, ;IT'S (TO BE) GONE
EXCH S2,J$VRAM(J) ;BYE
$CALL M%RMEM ;DEALLOCATE BUFFER
SETZM J$VRAM(J)
PUSHJ P,RAM.2 ;DEASSIGN THE STUFF
SETZ S1, ;RAM LOAD FAILED, HDW RAM LOADED
$RETF
RAM.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
$RETT ;AND RETURN
NORAM: MOVEI S1,1 ;RAM LOAD FAILED, OPR ACTION
$RETF
RAMFOB: .IODMP ;DUMP MODE I/O
SIXBIT/SYS/ ;FILE ON SYS:
0,,0 ;DUMP MODE (NO BUFFERS)
RLKUP: BLOCK 4 ;LOOKUP BLOCK
SUBTTL VFUOER - Output error processing
; This routine provides for driver or device-specific I/O error
; processing. This routine is called by a device driver's xxxOER entry,
; which may consist solely of a PJRST.
;
; Call: MOVE S1,J$LIOS(J) ;Justed updated with physical GETSTS
; MOVE S2,J$XIOS(J) ;Just updated with physical DEVOP.
; PUSHJ P,VFUOER
;
ENTRY VFUOER
VFUOER::MOVX S1,VF.UDC ;UNDEFINED CHARACTER PENDING?
TDNN S1,J$VFLG(J) ; ...
JRST VFUOE1 ;NO - PROCEED NORMALLY
ANDCAM S1,J$VFLG(J) ;WELL, WE ARE HANDLING IT NOW
PUSHJ P,SETUDC ;SETUP FOR ERROR
JRST VFUOE2 ;ONLY HANDLE ONE AT A TIME
VFUOE1: MOVX S1,VF.PCZ ;PAGE COUNTER INTERRUPT?
TDNN S1,J$VFLG(J) ; ...
JRST VFUOE2 ;NO - PROCEED NORMALLY
ANDCAM S1,J$VFLG(J) ;HANDLING IT NOW
PUSHJ P,SETPLE ;SETUP FOR ERROR
VFUOE2: MOVE S1,J$LIOS(J) ;GET THE NEW IOS FOR CALLER
MOVE S2,J$XIOS(J) ;AND THE XIOS
PJRST LPTOER## ;[4071] GO TO GENERIC ERROR ROUTINE
SETUDC: SKIPA S1,[IOUNC%] ;THE DEVOP. ERROR
SETPLE: MOVX S1,IOPLE% ;THE DEVOP. ERROR
SETDVP: MOVEM S1,J$XIOS(J) ;A PSEUDO-DEVOP. ERROR
MOVX S1,IO.ERR ;SET ALL THE ERROR BITS
IORM S1,J$LIOS(J) ;FOR LPFOOL TO SEE LATER
POPJ P,
SUBTTL VFUSHT - Stream shutdown
; This routine is called when a stream is shutdown, just
; prior to releasing the job data page. This routine is called by device
; driver's xxxSHT entry point.
;
; Call: MOVE J, job data base address
; PUSHJ P,VFUSHT
;
; TRUE return: Always
; FALSE return: Never
ENTRY VFUSHT
VFUSHT::MOVEI S1,V$$LEN ;SIZE OF A VFU
SKIPE S2,J$VVFU(J) ;ADDRESS
$CALL M%RMEM ;GET RID OF IT
SETZM J$VVFU(J)
MOVEI S1,R$$LEN ;SIZE OF A RAM
SKIPE S2,J$VRAM(J) ;ADDRESS
$CALL M%RMEM ;GET RID OF IT
SETZM J$VRAM(J)
$RETT ;RETURN
SUBTTL VFUCHO - Character translator
; This routine will handle character translation. Called when a character
; is about to be sent to what everyone else thinks is the physical device.
; It simulates a hardware translation RAM, activating the imaginary VFU
; as necessary. Called by the device driver's xxxCHO routine, which may
; simply PJRST here.
;
; Call: MOVE J, job data base address
; MOVE C, intercepted character
; PUSHJ P,VFUCHO
; TRUE return: Character translated if necessary, caller to output
; FALSE return: Character processed here, nothing to output
ENTRY VFUCHO
VFUCHO::PUSHJ P,.SAVET ;SAFER THAN SORRY
SKIPN T2,J$VRAM(J) ;GET ADDRESS OF SIMULATED RAM
MOVEI T2,LP64RM ;NONE, USE LP64.RAM
MOVE T1,C ;GET THE CHARACTER TO BE OUTPUT
ADJBP T1,R$PTR(T2) ;INDEX INTO THE RAM
LDB T1,T1 ;GET THE RAM ENTRY FOR THIS CHAR
;HERE, DEAL WITH THE "DELIMITER" AND "DELIMITER HOLD" STUFF
MOVE S1,J$VFLG(J) ;GET SIMULATION FLAGS
TXZE S1,VF.DLH ;IS DELIMITER/HOLD SET FROM LAST CHAR?
TXO T1,RD.DLH ;YES, FORCE TRANSLATE WITH FAKE BIT
TXNE T1,RD.DEL ;IS DELIMITER SET FOR THIS CHAR?
TXO S1,VF.DLH ;YES, SET DELIMITER/HOLD FOR NEXT CHAR
MOVEM S1,J$VFLG(J) ;SAVE SIMULATION FLAGS
;NEXT, TRY TO DEAL SIMPLY WITH ORDINARY DATA
TXNE T1,RD.INT!RD.PMC ;SPECIAL CONDITION?
JRST VFUCH2 ;YES, HANDLE SLOWLY
TXNE T1,RD.XLT!RD.DEL!RD.DLH ;NO, TRANSLATE ?
VFUR2P: LDB C,[POINTR T1,RD.DAT] ; SIMPLE TRANSLATION, DO SO
$RETT ;RETURN
;HERE WITH AN UNUSUAL RAM CONDITION
VFUCH2: TXNN T1,RD.INT ;INTERRUPT?
JRST VFUCH3 ;NO
;INTERRUPT IF NO TRANSLATE, OR (TRANSLATE AND DELIM/HOLD)
TXNE T1,RD.XLT ;IS TRANSLATE SET?
TXNE T1,RD.DLH ;YES, INTERRUPT ONLY IF DELIM/HOLD
JRST VFUCHI ;GENERATE INTERRUPT
TXNE T1,RD.DEL ;IF DELIMITER IS SET
JRST VFUCHI ; GENERATE INTERRUPT
;INTERRUPT BIT IS SET, BUT WE DON'T INTERRUPT. PRINT OR MOVE.
TXNE T1,RD.PMC ;PAPER MOTION?
JRST VFUVFC ;YES, DATA GOES TO VFU
JRST VFUR2P ;RAM (XLATED CHAR) TO PRINTER
;HERE TO GENERATE AN INTERRUPT
VFUCHI: LDB S1,[POINTR T1,RD.DAT] ;GET TRANSLATION OF CHARACTER
HRL C,S1 ;SAVE THAT FOR INTERRUPT ROUTINE
CAIE S1,^O136 ;IS IT THE MAGIC CODE -20F DOES?
JRST [PUSHJ P,SETUDC ; MAKE STATUS "UNDEFINED CHAR"
MOVX S1,VF.UDC ; REMEMBER UDC ERROR PENDING
IORM S1,J$VFLG(J) ; FOR ERROR HANDLING
$RETF] ; DON'T OUTPUT ANYTHING
PUSH P,C ;SAVE THE ACTUAL CHARACTER
MOVEI C,"^" ;GET AN UP-ARROW
PUSHJ P,DEVOUT## ;PRINT THAT
POP P,C ;RESTORE ORIGINAL CHAR
TRO C,100 ;MAKE IT A PRINTING CHARACTER
ANDI C,177 ;GET RID OF ANY GARBAGE BITS
$RETT ;LET DRIVER OUTPUT IT
;INTERRUPT IS NOT SET
VFUCH3:
; TXNN T1,RD.PMC ;PAPER MOTION COMMAND?
; HALT . ;???
TXNE T1,RD.DEL!RD.XLT!RD.DLH ;PAPER MOTION ONLY IF TRANSLATE
JRST VFUVFC ;PAPER MOTION COMMAND, GIVE TO DAVFU
$RETT ;NO TRANSLATE, JUST PRINT IT
;HERE TO PASS DATA TO THE VFU
VFUVFC: MOVEI C,.CHCRT ;ALL COMMANDS MUST FLUSH BUFFER
PUSHJ P,PHSOUT## ;AND RESET COLUMN COUNTER...
LDB C,[POINTR T1,RD.DAT] ;GET TRANSLATION OF CHAR
TXNN C,RD.SKP ;SKIP OR SLEW?
JRST VFUCHS ;CHANNEL SKIP
ANDI C,RD.SKC ;SLEW, GET NUMBER OF LINES
PUSH P,C ;SAVE THAT
VFUSL1: SOSGE (P) ;SKIP IF MORE TO SLEW
JRST VFUSL2 ;DONE, CHARACTER PROCESSED
MOVEI C,.CHLFD ;CHARACTER TO SLEW WITH
PUSHJ P,PHSOUT## ;PRINT THAT
PUSHJ P,VFULIN ;ADVANCE VFU AND TEST PAGE COUNTER
JRST VFUSL1 ;CONTINUE
VFUSL2: ADJSP P,-1 ;TOSS CONTROL COUNT
$RETF ;SLEW COMPLETE - NO CALLER OUTPUT
;HERE TO PERFORM A CHANNEL SKIP
VFUCHS: ANDI C,RD.SKC ;GET CHANNEL NUMBER TO SKIP TO
CAILE C,^D12-1 ;MAKE SURE IT'S LEGAL
MOVEI C,^D8-1 ;CHANNEL GT TAPE CHN 12, USE CHANNEL 8
MOVE C,VFUBIT(C) ;CONVERT TO VFU BIT
PUSH P,C ;SAVE BIT FOR DESTINATION CHANNEL
VFUSK1: MOVEI C,.CHLFD ;CHARACTER TO SKIP WITH
PUSHJ P,PHSOUT## ;ADVANCE ONE LINE
PUSHJ P,VFULIN ;ADVANCE AND GET VFU DATA FOR NEW LINE
TDNN T1,(P) ;SEE IF DESIRED HOLE IS PUNCHED
JRST VFUSK1 ;IT IS NOT, SKIP ANOTHER LINE
ADJSP P,-1 ;TOSS DESTINATION CHANNEL
$RETF ;CHANNEL SKIP COMPLETE - NO CALLER OUTPUT
SUBTTL VFULIN - ADVANCE VFU AND RETURN DATA
;SUBROUTINE TO ADVANCE A LINE AND RETURN VFU DATA FOR NEW LINE
;ACCOUNTS FOR PAGE COUNTER
;TRASHES T1, T2, RETURNS VFU DATA IN T1
VFULIN: AOS T1,J$VLIN(J) ;ADVANCE TO NEXT LINE
TLZ T1,-1 ;REMOVE PAGE COUNTER
ASH T1,1 ;THERE ARE 2 NIBBLES/VFU LINE
SKIPN T2,J$VVFU(J) ;GET ADDRESS OF SIMULATED VFU
MOVEI T2,STDVFU ;NONE, USE STANDARD VFU
ADJBP T1,V$PTR(T2) ;POINT TO THE FIRST
VFULN2: ILDB S1,T1 ;GET THE FIRST NIBBLE
CAIN S1,126 ;AN OLD STOP BYTE?
MOVEI S1,357 ;YES, CONVERT TO LP20 FORMAT
CAIN S1,357 ;NOW SEE IF LP20 STOP BYTE
JRST [HLLZS J$VLIN(J) ;YES - BACK TO LINE ZERO
MOVE T1,V$PTR(T2) ;RESET VFU DATA POINTER
JRST VFULN2] ;AND TRY AGAIN
ILDB T1,T1 ;GET THE SECOND
LSH T1,^D8 ;THE SECOND NIBBLE HAS THE HIGH 6 CHNS
IOR T1,S1 ;THE FIRST HAD THE LOW 6 CHANNELS
SKIPGE S1,J$VLIN(J) ;PAGE COUNTER ENABLED?
TDNN T1,VFUBIT+^D1-1 ;IF HIT TOP OF FORM (CHANNEL 1)
POPJ P, ;NOT ENABLED OR NOT TOF, RETURN
LDB S1,[POINT 17,S1,17] ;AT TOF, GET PAGE COUNTER VALUE
; ANDI S1,7777 ;LP20 IS 12 BIT COUNTER, MONITOR IS 36
SOS S1 ;DECREMENT THE PAGE COUNTER
DPB S1,[POINT 17,J$VLIN(J),17] ;STORE NEW VALUE
SKIPE S1 ;PAGE COUNTER = ZERO?
POPJ P, ;NO, MORE TO GO
MOVX S1,VF.PCZ ;YES, PAGE COUNTER IS ZERO
IORM S1,J$VFLG(J) ;REMEMBER THE ERROR
PJRST SETPLE ;SET PAGE LIMIT EXCEEDED AND RETURN
SUBTTL LP64.RAM
;RAM Data is 12 bits wide. Courtesy of the strange behavior
;of PDP-11s, DTEs, and such, the .RAM file has 12 bits / 1/2 word.
;Each data byte corresponds to one character code:
RD.DLH==10000 ;DELIM/HOLD (FAKE BIT)
RD.INT==4000 ;INTERRUPT
RD.DEL==2000 ;DELIMITER
RD.XLT==1000 ;TRANSLATE
RD.PMC==0400 ;PAPER MOTION COMMAND
RD.DAT==0377 ;CHARACTER DATA
RD.SKP==20 ;;VFU - SKIP 0-15 LINES
RD.SKC==17 ;;VFU - SKIP COUNT OR CHANNEL #
LP64RM: PHASE 0
R$PTR:! POINT 18,LP64RM+R$DATA,17 ;BYTE POINTER TO RAM DATA
R$DATA:! ;DATA FOR LP64.RAM
XLIST ;YOU REALLY DON'T WANT TO KNOW...
OCT 001000004136 ;CHARACTER CODES 0 & 1
OCT 004136004136 ;CHARACTER CODES 2 & 3
OCT 004136004136 ;CHARACTER CODES 4 & 5
OCT 004136004136 ;CHARACTER CODES 6 & 7
OCT 004136001011 ;CHARACTER CODES 10 & 11
OCT 001407001406 ;CHARACTER CODES 12 & 13
OCT 001400001420 ;CHARACTER CODES 14 & 15
OCT 004136004136 ;CHARACTER CODES 16 & 17
OCT 001401001402 ;CHARACTER CODES 20 & 21
OCT 001403001404 ;CHARACTER CODES 22 & 23
OCT 001405004136 ;CHARACTER CODES 24 & 25
OCT 004136004136 ;CHARACTER CODES 26 & 27
OCT 004136004136 ;CHARACTER CODES 30 & 31
OCT 004136001044 ;CHARACTER CODES 32 & 33
OCT 004136004136 ;CHARACTER CODES 34 & 35
OCT 004136004136 ;CHARACTER CODES 36 & 37
OCT 001040001041 ;CHARACTER CODES 40 & 41
OCT 001042001043 ;CHARACTER CODES 42 & 43
OCT 001044001045 ;CHARACTER CODES 44 & 45
OCT 001046001047 ;CHARACTER CODES 46 & 47
OCT 001050001051 ;CHARACTER CODES 50 & 51
OCT 001052001053 ;CHARACTER CODES 52 & 53
OCT 001054001055 ;CHARACTER CODES 54 & 55
OCT 001056001057 ;CHARACTER CODES 56 & 57
OCT 001060001061 ;CHARACTER CODES 60 & 61
OCT 001062001063 ;CHARACTER CODES 62 & 63
OCT 001064001065 ;CHARACTER CODES 64 & 65
OCT 001066001067 ;CHARACTER CODES 66 & 67
OCT 001070001071 ;CHARACTER CODES 70 & 71
OCT 001072001073 ;CHARACTER CODES 72 & 73
OCT 001074001075 ;CHARACTER CODES 74 & 75
OCT 001076001077 ;CHARACTER CODES 76 & 77
OCT 001100001101 ;CHARACTER CODES 100 & 101
OCT 001102001103 ;CHARACTER CODES 102 & 103
OCT 001104001105 ;CHARACTER CODES 104 & 105
OCT 001106001107 ;CHARACTER CODES 106 & 107
OCT 001110001111 ;CHARACTER CODES 110 & 111
OCT 001112001113 ;CHARACTER CODES 112 & 113
OCT 001114001115 ;CHARACTER CODES 114 & 115
OCT 001116001117 ;CHARACTER CODES 116 & 117
OCT 001120001121 ;CHARACTER CODES 120 & 121
OCT 001122001123 ;CHARACTER CODES 122 & 123
OCT 001124001125 ;CHARACTER CODES 124 & 125
OCT 001126001127 ;CHARACTER CODES 126 & 127
OCT 001130001131 ;CHARACTER CODES 130 & 131
OCT 001132001133 ;CHARACTER CODES 132 & 133
OCT 001134001135 ;CHARACTER CODES 134 & 135
OCT 001136001137 ;CHARACTER CODES 136 & 137
OCT 001100001101 ;CHARACTER CODES 140 & 141
OCT 001102001103 ;CHARACTER CODES 142 & 143
OCT 001104001105 ;CHARACTER CODES 144 & 145
OCT 001106001107 ;CHARACTER CODES 146 & 147
OCT 001110001111 ;CHARACTER CODES 150 & 151
OCT 001112001113 ;CHARACTER CODES 152 & 153
OCT 001114001115 ;CHARACTER CODES 154 & 155
OCT 001116001117 ;CHARACTER CODES 156 & 157
OCT 001120001121 ;CHARACTER CODES 160 & 161
OCT 001122001123 ;CHARACTER CODES 162 & 163
OCT 001124001125 ;CHARACTER CODES 164 & 165
OCT 001126001127 ;CHARACTER CODES 166 & 167
OCT 001130001131 ;CHARACTER CODES 170 & 171
OCT 001132001133 ;CHARACTER CODES 172 & 173
OCT 001134001135 ;CHARACTER CODES 174 & 175
OCT 001136001000 ;CHARACTER CODES 176 & 177
OCT 001000004136 ;CHARACTER CODES 200 & 201
OCT 004136004136 ;CHARACTER CODES 202 & 203
OCT 004136004136 ;CHARACTER CODES 204 & 205
OCT 004136004136 ;CHARACTER CODES 206 & 207
OCT 004136001011 ;CHARACTER CODES 210 & 211
OCT 001407001406 ;CHARACTER CODES 212 & 213
OCT 001400001420 ;CHARACTER CODES 214 & 215
OCT 004136004136 ;CHARACTER CODES 216 & 217
OCT 001401001402 ;CHARACTER CODES 220 & 221
OCT 001403001404 ;CHARACTER CODES 222 & 223
OCT 001405004136 ;CHARACTER CODES 224 & 225
OCT 004136004136 ;CHARACTER CODES 226 & 227
OCT 004136004136 ;CHARACTER CODES 230 & 231
OCT 004136001044 ;CHARACTER CODES 232 & 233
OCT 004136004136 ;CHARACTER CODES 234 & 235
OCT 004136004136 ;CHARACTER CODES 236 & 237
OCT 001040001041 ;CHARACTER CODES 240 & 241
OCT 001042001043 ;CHARACTER CODES 242 & 243
OCT 001044001045 ;CHARACTER CODES 244 & 245
OCT 001046001047 ;CHARACTER CODES 246 & 247
OCT 001050001051 ;CHARACTER CODES 250 & 251
OCT 001052001053 ;CHARACTER CODES 252 & 253
OCT 001054001055 ;CHARACTER CODES 254 & 255
OCT 001056001057 ;CHARACTER CODES 256 & 257
OCT 001060001061 ;CHARACTER CODES 260 & 261
OCT 001062001063 ;CHARACTER CODES 262 & 263
OCT 001064001065 ;CHARACTER CODES 264 & 265
OCT 001066001067 ;CHARACTER CODES 266 & 267
OCT 001070001071 ;CHARACTER CODES 270 & 271
OCT 001072001073 ;CHARACTER CODES 272 & 273
OCT 001074001075 ;CHARACTER CODES 274 & 275
OCT 001076001077 ;CHARACTER CODES 276 & 277
OCT 001100001101 ;CHARACTER CODES 300 & 301
OCT 001102001103 ;CHARACTER CODES 302 & 303
OCT 001104001105 ;CHARACTER CODES 304 & 305
OCT 001106001107 ;CHARACTER CODES 306 & 307
OCT 001110001111 ;CHARACTER CODES 310 & 311
OCT 001112001113 ;CHARACTER CODES 312 & 313
OCT 001114001115 ;CHARACTER CODES 314 & 315
OCT 001116001117 ;CHARACTER CODES 316 & 317
OCT 001120001121 ;CHARACTER CODES 320 & 321
OCT 001122001123 ;CHARACTER CODES 322 & 323
OCT 001124001125 ;CHARACTER CODES 324 & 325
OCT 001126001127 ;CHARACTER CODES 326 & 327
OCT 001130001131 ;CHARACTER CODES 330 & 331
OCT 001132001133 ;CHARACTER CODES 332 & 333
OCT 001134001135 ;CHARACTER CODES 334 & 335
OCT 001136001137 ;CHARACTER CODES 336 & 337
OCT 001100001101 ;CHARACTER CODES 340 & 341
OCT 001102001103 ;CHARACTER CODES 342 & 343
OCT 001104001105 ;CHARACTER CODES 344 & 345
OCT 001106001107 ;CHARACTER CODES 346 & 347
OCT 001110001111 ;CHARACTER CODES 350 & 351
OCT 001112001113 ;CHARACTER CODES 352 & 353
OCT 001114001115 ;CHARACTER CODES 354 & 355
OCT 001116001117 ;CHARACTER CODES 356 & 357
OCT 001120001121 ;CHARACTER CODES 360 & 361
OCT 001122001123 ;CHARACTER CODES 362 & 363
OCT 001124001125 ;CHARACTER CODES 364 & 365
OCT 001126001127 ;CHARACTER CODES 366 & 367
OCT 001130001131 ;CHARACTER CODES 370 & 371
OCT 001132001133 ;CHARACTER CODES 372 & 373
OCT 001134001135 ;CHARACTER CODES 374 & 375
OCT 001136001000 ;CHARACTER CODES 376 & 377
LIST
R$$LEN:!
DEPHASE
SUBTTL NORMAL.VFU
VFUBIT: EXP 00001 ;TAPE CHANNEL 1, OUR 0
EXP 00002
EXP 00004
EXP 00010
EXP 00020
EXP 00040
EXP 00400 ;TAPE CHANNEL 7, OUR 6
EXP 01000
EXP 02000
EXP 04000
EXP 10000
EXP 20000 ;TAPE CHANNEL 12, OUR 11
STDVFU: PHASE 0
V$PTR:! POINT 7,STDVFU+V$DATA,6 ;POINT TO BEFORE FIRST VFU DATA NIBBLE
V$DATA:! ;DATA FOR NORMAL.VFU
XLIST ;YOU REALLY DON'T WANT TO KNOW
OCT 125760310004 ;START, LINE 1A,1B, 2A,2B
OCT 120043001050 ;LINE 3A, 3B, 4A, 4B, 5A
OCT 010400216004 ;LINE 5B, 6A, 6B, 7A, 7B
OCT 100042401060 ;LINE 8A, 8B, 9A, 9B, 10A
OCT 011500210004 ;LINE 10B, 11A, 11B, 12A, 12B
OCT 160042001050 ;LINE 13A, 13B, 14A, 14B, 15A
OCT 010600212004 ;LINE 15B, 16A, 16B, 17A, 17B
OCT 100043401040 ;LINE 18A, 18B, 19A, 19B, 20A
OCT 011500314004 ;LINE 20B, 21A, 21B, 22A, 22B
OCT 120042001070 ;LINE 23A, 23B, 24A, 24B, 25A
OCT 010400212004 ;LINE 25B, 26A, 26B, 27A, 27B
OCT 140042401040 ;LINE 28A, 28B, 29A, 29B, 30A
OCT 011740210004 ;LINE 30B, 31A, 31B, 32A, 32B
OCT 120043001050 ;LINE 33A, 33B, 34A, 34B, 35A
OCT 010400216004 ;LINE 35B, 36A, 36B, 37A, 37B
OCT 100042401060 ;LINE 38A, 38B, 39A, 39B, 40A
OCT 011500310004 ;LINE 40B, 41A, 41B, 42A, 42B
OCT 160042001050 ;LINE 43A, 43B, 44A, 44B, 45A
OCT 010600212004 ;LINE 45B, 46A, 46B, 47A, 47B
OCT 100043401040 ;LINE 48A, 48B, 49A, 49B, 50A
OCT 011500214004 ;LINE 50B, 51A, 51B, 52A, 52B
OCT 120042001070 ;LINE 53A, 53B, 54A, 54B, 55A
OCT 010400212004 ;LINE 55B, 56A, 56B, 57A, 57B
OCT 140042401040 ;LINE 58A, 58B, 59A, 59B, 60A
OCT 010400010000 ;LINE 60B, 61A, 61B, 62A, 62B
OCT 100002000040 ;LINE 63A, 63B, 64A, 64B, 65A
OCT 000400053000 ;LINE 65B, 66A, 66B, STOP, 67A
OCT 000000000000 ;LINE 67B, 68A, 68B, 69A, 69B
OCT 000000000000 ;LINE 70A, 70B, 71A, 71B, 72A
OCT 000000000000 ;LINE 72B, 73A, 73B, 74A, 74B
OCT 000000000000 ;LINE 75A, 75B, 76A, 76B, 77A
OCT 000000000000 ;LINE 77B, 78A, 78B, 79A, 79B
OCT 000000000000 ;LINE 80A, 80B, 81A, 81B, 82A
OCT 000000000000 ;LINE 82B, 83A, 83B, 84A, 84B
OCT 000000000000 ;LINE 85A, 85B, 86A, 86B, 87A
OCT 000000000000 ;LINE 87B, 88A, 88B, 89A, 89B
OCT 000000000000 ;LINE 90A, 90B, 91A, 91B, 92A
OCT 000000000000 ;LINE 92B, 93A, 93B, 94A, 94B
OCT 000000000000 ;LINE 95A, 95B, 96A, 96B, 97A
OCT 000000000000 ;LINE 97B, 98A, 98B, 99A, 99B
OCT 000000000000 ;LINE 100A, 100B, 101A, 101B, 102A
OCT 000000000000 ;LINE 102B, 103A, 103B, 104A, 104B
OCT 000000000000 ;LINE 105A, 105B, 106A, 106B, 107A
OCT 000000000000 ;LINE 107B, 108A, 108B, 109A, 109B
OCT 000000000000 ;LINE 110A, 110B, 111A, 111B, 112A
OCT 000000000000 ;LINE 112B, 113A, 113B, 114A, 114B
OCT 000000000000 ;LINE 115A, 115B, 116A, 116B, 117A
OCT 000000000000 ;LINE 117B, 118A, 118B, 119A, 119B
OCT 000000000000 ;LINE 120A, 120B, 121A, 121B, 122A
OCT 000000000000 ;LINE 122B, 123A, 123B, 124A, 124B
OCT 000000000000 ;LINE 125A, 125B, 126A, 126B, 127A
OCT 000000000000 ;LINE 127B, 128A, 128B, 129A, 129B
OCT 000000000000 ;LINE 130A, 130B, 131A, 131B, 132A
OCT 000000000000 ;LINE 132B, 133A, 133B, 134A, 134B
OCT 000000000000 ;LINE 135A, 135B, 136A, 136B, 137A
OCT 000000000000 ;LINE 137B, 138A, 138B, 139A, 139B
OCT 000000000000 ;LINE 140A, 140B, 141A, 141B, 142A
OCT 000000000000 ;LINE 142B, 143A, 143B
V$$LEN:! ;LENGTH OF LONGEST POSSIBLE VFU
DEPHASE
SUBTTL Literal pool
VFULIT: LIT
VFUEND::!END