Trailing-Edge
-
PDP-10 Archives
-
AP-D483B-SB_1978
-
lptspl.mac
There are 45 other files named lptspl.mac in the archive. Click here to see a list.
TITLE LPTSPL -- Disk to Line-printer Spooler - version 102
SUBTTL D.A. Lewine - L.S. Samberg/LSS 29 Mar 77
;Copyright (C) 1970,71,72,73,74,75,76,77,
; Digital Equipment Corp., Maynard, MA.
;ASSEMBLY AND LOADING INSTRUCTIONS
;
; .COMP LPTSPL
; .LOAD /REL LPTSPL
; .SSAVE LPTSPL
SEARCH QSRMAC ;SEARCH GALAXY PARAMETERS
PROLOGUE(LPTSPL)
IFN FTJSYS,<
SEARCH RMSSYM
> ;END IFN FTJSYS
.REQUIRE SBSCOM ;SUBSYSTEM COMMON MODULE
.REQUIRE CSPQSR ;QUASAR INTERFACE MODULE
.REQUIRE CSPMEM ;MEMORY MANAGER
IF1,<
IFN FTJSYS,<PRINTX ASSEMBLING GALAXY-20 LPTSPL>
IFN FTUUOS,<PRINTX ASSEMBLING GALAXY-10 LPTSPL>
> ;END IF1
SALL ;SUPPRESS MACRO EXPANSIONS
;VERSION INFORMATION
LPTVER==102 ;MAJOR VERSION NUMBER
LPTMIN==0 ;MINOR VERSION NUMBER
LPTEDT==2263 ;EDIT LEVEL
LPTWHO==0 ;WHO LAST PATCHED
%LPT==<BYTE (3)LPTWHO(9)LPTVER(6)LPTMIN(18)LPTEDT>
;STORE VERSION NUMBER IN JOBVER
LOC 137
.JBVER::EXP %LPT
TWOSEG ;TWO SEGMENT PROGRAM
RELOC 400000 ;START IN HISEG
SEG==-1 ;AND FLAG US IN HISEG
SUBTTL Revision History
;2000 First field-test release of GALAXY-10, June,1975.
;2050 Make this version 101, Sept, 1975
;2056 On HELP command, just go thru and give a list
; of valid commands.
;2060 In initialization, read LPFORM.INI into core, and
; simply rescan the buffer on a forms change.
;2074 Insert the MONITOR Command as an emergency exit.
;2077 Add new LPFORM switches /ALCNT, /ALSLP.
;2111 Release version 101 on TOPS20, Feb, 1976
;2115
; START GALAXY 1B DEVELOPMENT
; MAKE THIS LPTSPL 101A
; Start converting output device handling to run under
; TOPS20 without compatibility.
;2122 Start putting in internal LOG code.
;2123 Finish up 2122 and add a new switch to LPFORM, /VFU
; which is equivalent to /TAPE.
;2124 Change SUPPRESS command to accept keyword argument
; instead of a switch.
;2125 Add new CSPQSR protocol and new interrupt code.
;2126 Add modifications to allow for new SBSMAC module.
;2133 Remove REQUEUE/C since it is the default.
;2141 Add a mechanism to flush all pending (already buffered)
; output on KILL.
;2142 Remove station locator option in LPFORM.INI.
;2145 Start putting in support for DAVFUs.
; (Direct Access Vertical Forms Unit)
;2147 Rearrange some code so that LPT is always kept open.
;2151 Put in more graceful error recovery for the LP20.
;2154 Invent OUTWON to wait for device to come on-line.
;2156 On TOPS20 allow command processor to run
; right after interrupt happens.
;2157 Have OPINFL, ACCCHK return TRUE or FALSE
; rather than diddling DSKOPN.
;2200 Make this version 102, May 1976.
;2201 Fix up control-C handling.
;2202 Ignore line-sequence-numbers in LPFORM.INI.
;2203 Random fixes and cleanup.
;2204 Drive the LPT using non-blocking I/O on -10.
;2205 Change FORMS command to simply tell QUASAR and nothing else.
;2206 More of 2203.
;2207 On TOPS10 build output buffer ring myself.
; Generate 4 200 word buffers (175+3).
;2210 Start moving operating system dependent code from the START command
; processor to the OUTGET routine. Symbolize buffer
; size parameters for both systems. Start phasing out the LOCAL
; macro since it precludes multi-programming LPTSPL.
;2211 Files printed with /HEAD:0 get a blank page
; between copies because FFSEEN was getting turned off at
; end-of-file.
;2212 Make KILL work correctly when banners or headers
; are printing.
;2213 Move more operating system dependent code from START
; to OUTGET.
;2214 Random code cleanup.
;2215 On -20 dont print LPTDOL if not busy.
; On -10 make output buffer 400 words (375+3).
;2216 Rearrange START routine to call OUTGET
; at the end. Start putting in hooks for multiple internal
; log pages.
;2217 Rework log file buffering code again.
;2220 Random code cleanup and bug fixes.
;2221 More of 2220.
;2222 COBOL sixbit files didn't print correctly.
;2223 Remove the MSGLVL command and add the new MESSAGE
; command.
;2224 More of 2223.
;2225 Make some commands run more reasonably when device is
; off-line.
;2226 Fix some forms changing problems.
;2227 Start updating LPTSPL to understand the "new" version
; 2 database and -20 structures etc.
;2230 More of 2227.
;2231 Remove all references to P4 and PURGE it.
;2232 Make VFU loading somewhat cleaner and smarter.
;2233 More of 2233 and random cleanup.
;2234 Rework BANNER and TRAILER code.
;2235 Start putting in RMS-20 support. Make octal number
; printer produce unsigned numbers. Recover from
; front-end reloads on -20. On -10 turn JACCT off unless
; I am a remote operator.
;2236 Fix printing of wrong request and file creation time on
; file header page on -20 [SPR 20-]. New banner page format
; caused the ruler to print on first data page.
;2237 Clean-up handling of STOP and PAUSE, and put in more RMS support.
;2240 Fix race condition in -20 terminal handler [SPR 20-10042].
; Finish implementing support for RMS-20 files.
;2241 Take a checkpoint whenever a backspace or forward reaches its
; destination. On -10, use normal size buffers for remote printer.
; Allow Open of LPT on -20 even if off-line. Fix some RMS
; releated bugs.
;2242 Fix a number of minor bugs. Re-read LPFORM.INI on FORMS command.
;2243 Cleanup a number of problems with RMS and other things.
;2244 Add code to load DAVFU.
;2245 Some more RMS fixes.
;2246 Enable for online interrupts on the -10. Ignore a
; Request for Checkpoint if lineprinter is off-line.
;2247 Fix a number of minor bugs.
;2250 Use new RMS symbols.
;;First Field-Test Release of GALAXY release 2, Jan. 1977
;2251 The guarenteed log file limit was no being granted due to
; a bad compare. A FORMS command given before a START command
; caused some very strange results (QAR#2). Setup the LUUO
; handler before calling OPNFRM (QAR#1).
;2252 Start inserting code for loading DAVFU on -10.
;2253 Fix time printer on -10 to be more accurate (esp.
; around midnite). Fix some problems with forms changes.
;2254 Allow 2 (assembly parameter LPTERR) hard lineprinter errors
; per copy of a file before giving up and resetting.
;2255 More code to load DAVFU on the -10.
;2256 Fix some bugs in 2255 and do some code cleanup.
;2257 Fix the command scanner to see commands which begin with
; lower-case alphabetics (QAR #5). If output device is a
; magtape, write a tape-mark at EOJ.
;2260 Log files which were to be deleted but not printed
; weren't deleted. If NORMAL/TAPE is found in LPFORM,
; make that tape the default. More code for DAVFU on -10.
;2261 Fix a number of minor problems (inc. qar #18).
;2262 More of the same (qar #22 and #23).
;2263 Fix a few minor bugs.
SUBTTL AC and I/O Channel Definitions
;ACCUMULATOR DEFINITIONS
S=0 ;STATUS FLAGS
AP=13 ;USED TO INTERFACE WITH QSRMEM (AND AS A TEMP)
E=14 ;POINTS TO CURRENT FILE
N=15 ;HOLDS A NUMBER - ALMOST NEVER PRESERVED
C=16 ;HOLDS A CHARACTER - ALMOST NEVER PRESERVED
J=P4 ;JOB PARAMETER BLOCK POINTER
PURGE P4 ;NOW GET RID OF P4 FOREVER
;INPUT-OUTPUT CHANNELS
DSK==1 ;SPOOLED DATA ON DSK
LOGF==2 ;LOG FILE ON DISK
LPT==3 ;LINEPRINTER
ALP==5 ;FOR ALIGN COMMAND
VFC==6 ;FOR READING DAVFU FILE
FRM==7 ;READ LPFORM.INI
SUBTTL Parameters
;PARAMETERS WHICH MAY BE CHANGED AT ASSEMBLY TIME
ND PDSIZE,200 ;SIZE OF PUSHDOWN LIST
ND SLTIME,^D5000 ;MS TO WAIT ON ?DEVICE OK
ND MAXERR,5 ;NUMBER OF DISK I/O ERRS BEFORE PUNTING
ND LPTERR,2 ;NUMBER OF LPT I/O ERRS BEFORE QUITTING
ND FTDPM,0 ;OUTPUT TO LPT IN "LINE" MODE.
;THIS ALLOWS LPT TO BE TURNED OFF AND
;ON WITHOUT DATA LOSS, AT SOME COST IN
;CPU TIME.
ND LOGPAG,12 ;PAGE LIMIT FOR LOG IF OVER QUOTA
ND ACCTSW,-1 ;-1 TO INCLUDE ACCOUNTING
ND TABSIZ,^D50 ;SIZE OF BACKSPACE TABLE
ND AUTTIM,^D20 ;AUTO-TIMEOUT IN MINUTES
ND MAXLIM,^D10000 ;DEFAULT VALUE OF MLIMIT
IFN FTJSYS,<
ACCTSW==0 ;NO ACCOUNTING YET ON -20
> ;END IFN FTJSYS
;CONSTANT PARAMETERS
XP FCTHDR,<251000,,13> ;FACT ENTRY CODE AND LENGTH
XP .EQNOT,.EQLM2+1 ;NOTE FIELD IN EXTERNAL REQUEST
;CHECKPOINT BLOCK OFFSETS
XP CKFIL,0 ;NUMBER OF FILES PRINTED
XP CKCOP,1 ;NUMBER OF COPIES OF LAST FILE
XP CKPAG,2 ;NUMBER OF PAGES OF LAST COPY
XP CKTPP,3 ;TOTAL PAGES PRINTED
XP CKFLG,4 ;FLAGS
XP CKFREQ,1B0 ;JOB WAS REQUEUED BY OPR
XP CKFCHK,1B1 ;JOB WAS CHECKPOINTED
SYSPRM BUFNUM,2,1 ;NUMBER OF BUFFERS
SYSPRM BUFSPC,1000,1000 ;SPACE ALLOCATED FOR BUFFERS
SYSPRM BUFSIZ,<1000/BUFNUM>,<1000/BUFNUM>
;SIZE OF EACH BUFFER
SYSPRM BUFCHR,<BUFSIZ-3>*5,<BUFSIZ*5>
;NUMBER OF CHARS PER BUFFER
BUFSPC==BUFNUM*BUFSIZ
SYSPRM DEFLPT,<SIXBIT/LPT/>,<SIXBIT/PLPT0/> ;DEFAULT LPT NAME
SUBTTL MACROS
IFN FTJSYS,<
;MACROS TO MANIPULATE FIELDS IN THE FAB AND RAB FOR RMS-20 FILES
DEFINE $STFAB(AC,FLD),<
IFNDEF .OF'FLD,<PRINTX FAB FIELD FLD IS UNDEFINED>
IFDEF .OF'FLD,<
..MASK=MASK.(.SZ'FLD,.PS'FLD)
STORE AC,J$DFAB+.OF'FLD'(J),..MASK
>
> ;END DEFINE $STFAB
DEFINE $LDFAB(AC,FLD),<
IFNDEF .OF'FLD,<PRINTX FAB FIELD FLD IS UNDEFINED>
IFDEF .OF'FLD,<
..MASK=MASK.(.SZ'FLD,.PS'FLD)
LOAD AC,J$DFAB+.OF'FLD'(J),..MASK
>
> ;END DEFINE $LDFAB
DEFINE $STRAB(AC,FLD),<
IFNDEF .OF'FLD,<PRINTX RAB FIELD FLD IS UNDEFINED>
IFDEF .OF'FLD,<
..MASK=MASK.(.SZ'FLD,.PS'FLD)
STORE AC,J$DRAB+.OF'FLD'(J),..MASK
>
> ;END DEFINE $STRAB
DEFINE $LDRAB(AC,FLD),<
IFNDEF .OF'FLD,<PRINTX RAB FIELD FLD IS UNDEFINED>
IFDEF .OF'FLD,<
..MASK=MASK.(.SZ'FLD,.PS'FLD)
LOAD AC,J$DRAB+.OF'FLD'(J),..MASK
>
> ;END DEFINE $LDRAB
PURGE $STORE,$LOAD ;PURGE CONFUSING RMS MACROS
> ;END OF IFN FTJSYS
;FREQUENTLY USED INSTRUCTIONS SEQUENCES
DEFINE ACTCHR (CH,A)<
CAIN C,"CH" ;;IS THIS A CH
XLIST
JRST A ;YES
LIST
SALL
>
;RELOC TO HISEG
DEFINE TOPSEG,<
IFE SEG,<
XLIST
LIT
SEG==-1
RELOC>
LIST
SALL>
;RELOC TO LOWSEG
DEFINE LOWSEG,<
IFN SEG,<
XLIST
LIT
LIST
SALL
RELOC>
SEG==0>
;MACRO TO ASSIGN BITS WITHIN A WORD (NOTE: BIT 0 = 400000 000000)
DEFINE BIT(AC,SYMBOL)<
IF1,< ;;DO NOT REDEFINE IN PASS2
IFDEF AC'..< ;;SET UP COUNTER
AC'..==AC'.._<-1> ;;AND MOVE TO NEXT BIT
>
IFNDEF AC'..< ;;ON FIRST CALL
AC'..==1B0> ;;GIVE AWAY FIRST BIT
SYMBOL==AC'.. ;;DEFINITION OF SYMBOL
IFE AC'..,< ;;NO MORE ROOM
PRINTX ? AC IS FULL
>>>
;BIT TESTING MACROS
DEFINE ON(AC,FLAG),<TXO AC,FLAG>
DEFINE OFF(AC,FLAG),<TXZ AC,FLAG> ;TURN OFF A FLAG
DEFINE LP(SYM,VAL),<
IF1,<
XLIST
IFNDEF J...X,<J...X==1000>
IFDEF SYM,<PRINTX ?PARAM SYM USED TWICE>
SYM==J...X
J...X==J...X+VAL
IFL 2000-J...X,<PRINTX ?PARAMETER AREA LONGER THAN A PAGE>
LIST
SALL
> ;END IF 1
> ;END DEFINE LP
SUBTTL Special Forms Handling Parameters
LOWSEG ;DOWN TO LOWSEG
;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)
; DRUM:SS DRUM TYPE
; CHAIN:SS CHAIN TYPE (DRUM/CHAIN ARE THE SAME)
; NOTE:AA TYPE NOTE TO THE OPERATOR
; PAUSE PAUSE BETWEEN JOBS ON THIS TYPE OF FORM
; WHAT PRINT A SHORT "WHAT" TO OPERATOR ON EACH JOB
;IN THE ABOVE AND BELOW EXPLANATIONS:
; NN IS A DECIMAL NUMBER
; SS IS A 1-6 CHARACTER STRING
; AA IS A STRING OF 1 TO 50 CHARACTERS
; OO IS AN OCTAL NUMBER
;LOCATION SPECIFIERS
; ALL ALL LINEPRINTERS
; CENTRAL ALL LINEPRINTERS AT THE CENTRAL SITE
; REMOTE ALL REMOTE LINEPRINTERS
; LPTOOO LINEPRINTER OOO ONLY
;NOTE: LPTSPL WILL USE THE FIRST ENTRY WHICH MEETS THE LOCATION
; SPECIFICATION FOR ITS LINEPRINTER.
DEFINE F,<
FF BANNER,2
FF TRAILER,2
FF HEADER,2
FF LINES,^D60
FF WIDTH,^D132
FF ALIGN,0
FF ALCNT,25
FF ALSLP,5
FF RIBBON,FRMNOR
FF TAPE,FRMNOR
FF VFU,FRMNOR
FF DRUM,FRMNOR
FF CHAIN,FRMNOR
FF NOTE,0
FF PAUSE,0
FF WHAT,0
>
;GENERATE TABLE OF SWITCH NAMES
DEFINE FF(A,B),<
XLIST
<<SIXBIT /A/>&777777B17>+S$'A
LIST
SALL
>
FFNAMS: F
;GENERATE TABLE OF DEFAULT PARAMTERS
DEFINE FF(X,Y),<
XLIST
D$'X: EXP Y
LIST
SALL
>
FFDEFS: F
F$NSW==.-FFDEFS
PURGE D$VFU,D$CHAI
F$CL1==^D60 ;WIDTH CLASS ONE IS 1 TO F$CL1
F$CL2==^D100 ;WIDTH CLASS TWO IS F$CL1 TO F$CL2
SUBTTL Flag Definitions
IF1 <
BIT S,RUNB, ;ON IF I/O IN PROGRESS TO OUTDEV
BIT S,TELOPR, ;PRINT ON OPERATORS TTY (SET BY TELL)
BIT S,TELLOG, ;PLACE IN LOG (SET BY TELL)
BIT S,XTRA, ;XTRA BIT
BIT S,TELUSR, ;SENT DIRECTLY TO OUDEV(SET BY TELL)
;******* DO NOT MOVE BITS DEFINED ABOVE THIS LINE *******
BIT S,PAUSEB, ;(5) PAUSE AT EOJ
BIT S,TNOACT, ;(6) NO ACTION CHARACTERS
BIT S,STARTD, ;(7) START COMMAND GIVEN
BIT S,ARROW, ;(8) ARROW MODE IN EFFECT
BIT S,SUPRES, ;(9) NO USER FORM CONTROL
BIT S,DSKOPN, ;(10) DISK DATA READ GOING ON
BIT S,RQB, ;(11) JOB HAS BEEN REQUED
BIT S,SUPJOB, ;(12) SUPPRESS /JOB
BIT S,NOTYPE, ;(13) CNTRL O THE OUTPUT DEVICE
BIT S,XXX, ;(14)
BIT S,XXX, ;(15)
BIT S,PLOCK, ;(16) DO NOT CLEAR THE PAUSE BIT
BIT S,FFSEEN, ;(17) FORM FEED SEEN (LPTOUT)
BIT S,FROZE, ;(18) DON'T ASK TO CHANGE FORMS TYPE
BIT S,ABORT, ;(19) THE SHIP IS SINKING
BIT S,FCONV, ;(20) THE NEXT CHAR IS FORTRAN FORMAT DATA
BIT S,NEWLIN, ;(21) FLAG FOR THE BEGINING OF LINE
BIT S,MNTBIT, ;(22) REQUEST FOR FORMS TO BE MOUNTED
BIT S,JOBLOG, ;(23) THIS JOB HAS A LOG FILE
BIT S,BUSY, ;(24) JOB IN PROGRESS
BIT S,LOGOPN, ;(25) LOG FILE IS OPEN
BIT S,TTYBRK, ;(26) BREAK WAS SEEN ON TTY
BIT S,XXX, ;(27)
BIT S,BANDUN, ;(28) WE WENT THRU THE BANNER SEQUENCE
;STILL IN IF1
SUBTTL LUUO Definitions
OPDEF TELL [001000,,0]
OPDEF TELLN [002000,,0]
OPDEF STAMP [004000,,0]
;AC FIELD OF TELL UUO
OPR==10 ;SEND TO OPERATOR
LOG==4 ;SEND TO LOG
USR==1 ;ALSO PUT ON USER DEVICE
;BIT POSITION (FOR BYTE POINTERS)
SFRLOC==4 ;LOCATION OF TELL BITS IN S
SFSBIT==4 ;NUMBER OF TELL BITS
UURLOC==14 ;LOCATION OF AC IN UUO
UUSBIT==4 ;NUMBER OF BITS IN AC FIELD
ASUPPRESS
> ;END OF IF1 CONDITIONAL
;LUUO BYTE POINTERS
PAC: POINT UUSBIT,.JBUUO##,UURLOC ;POINTER TO AC IN LUUO
PS: POINT SFSBIT,S,SFRLOC ;SAME FIELD IN S
SUBTTL Job Parameter Area
LP J$$BEG,0 ;BEGINNING OF PARAMETER AREA
;REQUEST PARAMETERS
LP J$RFLN,1 ;NUMBER OF FILES IN REQUEST
LP J$RFLP,1 ;NUMBER OF FILES TO BE PRINTED
LP J$RLIM,1 ;JOB LIMIT IN PAGES
LP J$RLFS,1 ;ADR OF LOG FILE SPEC
LP J$RNFP,1 ;NUMBER OF FILES PRINTED
LP J$RNCP,1 ;NUMBER OF COPIES OF CURRENT FILE
LP J$RNPP,1 ;NUMBER OF PAGES IN CURRENT COPY PRINTED
LP J$RACS,20 ;CONTEXT ACS
LP J$RPDL,50 ;CONTEXT PUSHDOWN LIST
;ALIGN FILE PARAMETERS
LP J$ABRH,1 ;BUFFER RING HEADER
LP J$ABPT,1 ;BYTE POINTER
LP J$ABCT,1 ;BYTE COUNT
LP J$APAG,1 ;ALIGN SCRATCH PAGE NUMBER
;LPT PARAMETERS
LP J$LBUF,1 ;ADDRESS OF LPT BUFFER
LP J$LBRH,1 ;BUFFER RING HEADER
LP J$LBPT,1 ;BYTE POINTER
LP J$LBCT,1 ;BYTE COUNT
LP J$LDEV,1 ;ACTUAL OUTPUT DEVICE NAME
LP J$LGNM,1 ;DEV NAME SPEC ON START CMD
LP J$LSDV,1 ;SCHEDULING DEVICE
LP J$LERR,1 ;LPT ERROR DOWNCOUNTER
LP J$LLCL,1 ;-1 IF UPPER/LOWER CASE PRINTER
LP J$LHNG,1 ;-1 IF OUTPUT DEVICE IS HUNG
LP J$LDVF,1 ;-1 IF DAVFU ON PRINTER
LP J$LPCR,1 ;-1 IF DEVICE HAS A PAGE CNTR
LP J$LREM,1 ;-1 IF REMOTE PRINTER
LP J$LIOA,1 ;-1 IF WE ARE IN A SOUT OR OUT
IFN FTJSYS,<
LP J$LJFN,1 ;JFN FOR THE LPT
LP J$LSTG,2 ;DEVICE NAME STRING
LP J$LIBC,1 ;INITIAL BYTE COUNT
LP J$LIBP,1 ;INITIAL BYTE POINTER
> ;END IFN FTJSYS
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;CURRENT FORMS PARAMETERS
LP J$FORM,1 ;CURRENT FORMS TYPE
LP J$FPFM,1 ;PREVIOUS FORMS TYPE
LP J$FSFM,1 ;TYPE OF FORMS QUASAR IS SCHEDULING
DEFINE FF(X,Y),<
LP J$F'X,1
>
LP J$FCUR,0 ;START OF FORMS PARAMS
F ;CURRENT FORMS PARAMS
LP J$FWCL,1 ;CURRENT WIDTH CLASS
LP J$FLVT,1 ;CURRENTLY 'LOADED' VFU TYPE
LP J$FNBK,16 ;OPERATOR NOTE BLOCK
PURGE J$FVFU,J$FCHA ;DON'T USE THESE
;MISCELLANY
LP J$XSBC,1 ;SAVE BYTE-COUNT FOR FAST BAKSPC
LP J$XDPG,1 ;FORW/BACK DESTINATION PAGE
LP J$XPOS,1 ;CURRENT VERTICAL POSITION
LP J$XSPC,1 ;CURRENT SPACING
LP J$XHIP,1 ;HEADER-IN-PROGRESS
LP J$XHBF,<45> ;BUFFER TO BUILD HEADER LINE
LP J$XCOD,<^D49> ;COMPILE A ROUTINE TO CHECK
; FOR MATCH ON /REPORT
LP J$XHUN,3 ;PLACE TO BUILD USER NAME
LP J$XHUW,1 ;NUMBER OF WORDS IN USER NAME
LP J$XHNO,3 ;PLACE TO BUILD THE NOTE
LP J$XCOP,1 ;NUMBER OF COPIES TO PRINT
LP J$XPG1,1 ;START PAGE FOR FIRST COPY
LP J$XPG2,1 ;START PAGE FOR SUBSEQENTS
LP J$XMLM,1 ;MLIMIT FOR PRINTER
LP J$XPCB,1 ;BLOCKSIZE FOR "PICTURE"
LP J$XPCS,1 ;NUMBER OF SIG CHARS FOR "PICTURE"
IFN FTUUOS,<
LP J$XPTB,<TABSIZ> ;PAGE TABLE FOR BACKSPACE
LP J$XVFP,1 ;SCRATCH PAGE FOR READING VFUS
LP J$XVFB,3 ;BUFFER RING HEADER FOR READING VFUS
> ;END IFN FTUUOS
IFN FTJSYS,<
LP J$XUNO,1 ;OWNER'S USER NUMBER
LP J$XSFO,<10> ;SCRATCH FOR FORMATTED OUTPUT RTNS
> ;END IFN FTJSYS
;ACCOUNTING BLOCK
IFN FTUUOS,<
LP J$AFNC,1 ;DAEMON FUNCTION
LP J$AHED,1 ;TYPE,,LENGTH (251B8,,13)
LP J$APPN,1 ;PPN
LP J$ADAT,1 ;DATE (FILLED BY DAEMON)
LP J$AQUE,1 ;0-11 = QUEUE NAME
;12-17 = STATION
;18-35 = SERIAL # OF MASTER CPU
LP J$ARTM,1 ;RUNTIME IN SECS*100
LP J$ACTI,1 ;CORE-TIME INTEGRAL IN KCS*100
LP J$ADRD,1 ;DISK READS
LP J$ADWT,1 ;DISK WRITES
LP J$ADEV,1 ;PROCESSING DEVICE
LP J$ASEQ,1 ;JOB SEQUENCE NUMBER
LP J$APRT,1 ;NUMBER OF PAGES PRINTED
J$AEND==J$APRT ;END OF BLOCK
J$ALEN==J$AEND-J$AHED+1
> ;END IFN FTUUOS
IFN FTJSYS,<
LP J$AHED,1 ;CODE,JOB,LINE,SIZE
LP J$ADIR,1 ;0,,DIRECTORY
LP J$ADAT,1 ;DATE,,TIME
LP J$ARTM,1 ;RUNTIME USED
LP J$ADEV,1 ;DEVICE USED
LP J$APRT,1 ;# PAGES PRINTED
LP J$AFRM,1 ;FORMS TYPE
LP J$AANO,1 ;ACCOUNT NUMBER (OR -BYTE COUNT)
LP J$ASTG,10 ;ACCOUNT STRING
J$AEND==J$ASTG+7 ;END OF BLOCK
J$ALEN==J$AEND-J$AHED+1
LP J$AFIL,J$ALEN ;ACCOUNTING BLOCK FOR CURRENT FILE
LP J$ASVP,1 ;SAVE AMOUNT PRINTED
LP J$ASVR,1 ;SAVE RUNTIME
> ;END IFN FTJSYS
;DISK FILE PARAMETERS
IFN FTUUOS,<
LP J$DPAT,<10> ;PATH BLOCK
LP J$DUUO,<.RBTIM+1> ;UUO BLOCK
LP J$DFLP,.FOPPN+1 ;FILOP. BLOCK
> ;END IFN FTUUOS
IFN FTJSYS,<
LP J$DSTG,1 ;ADDRESS OF CURRENT FILENAME
LP J$DJFN,1 ;JFN OF CURRENT FILE
LP J$DBIF,1 ;#BYTES LEFT IN FILE (36BIT)
; IF RMS FILE, -1 MEANS NORMAL READ
; AND 0 MEANS EOF SET EXTERNALLY
LP J$DMOD,1 ;POINT <BYTE-SIZE>,<BYTES/WORD>
LP J$DNAM,10 ;PLACE TO JFNS THE FILENAME
LP J$DFDB,.FBLEN ;FDB FOR THE DISK FILE
LP J$DCAB,5 ;CHKAC BLOCK
;--RMS PARAMETERS
LP J$DRMS,1 ;-1 IF THIS IS AN RMS FILE
LP J$DFAB,FA$LNG ;FILE ACCESS BLOCK (FAB)
LP J$DRAB,RA$LNG ;RECORD ACCESS BLOCK (RAB)
LP J$DRFA,1 ;RFA OF FIRST RECORD
LP J$DRME,1 ;RMS ERROR FLAG SET BY RMSERR
> ;END IFN FTJSYS
LP J$DBUF,1 ;ADDRESS OF DSK BUFFERS
LP J$DINF,1 ;CURRENT DISK BLK OR PAGE NUMBER
LP J$DRNM,2 ;DISK FILE'S REFERENCE NAME
LP J$DREX,2 ;FILE'S REFERENCE EXTENSION
LP J$DRBS,1 ;CONTAINS BLOCK SIZE FOR HEADER
LP J$DERR,1 ;NUMBER OF DEVICE ERRORS
LP J$DBRH,3 ;BUFFER RING HEADER
J$DBPT==J$DBRH+1 ;BUFFER BYTE POINTER
J$DBCT==J$DBRH+2 ;BUFFER BYTE COUNT
;LOG FILE PARAMETERS
IFN FTUUOS,<
LP J$GPAT,<10> ;PATH BLOCK
LP J$GUUO,<.RBPRV+1> ;LOOKUP BLOCK
LP J$GFLP,<6> ;FILOP. UUO BLOCK
LP J$GBRH,1 ;BUFFER RING HEADER
LP J$GBPT,1 ;BYTE-POINTER
LP J$GBCT,1 ;BYTE-COUNT
> ;END IFN FTUUOS
IFN FTJSYS,<
LP J$GSTG,1 ;POINTER TO GTJFN STRING
LP J$GJFN,1 ;THE JFN
> ;END IFN FTJSYS
LP J$GBUF,10 ;ADDRESS OF LOG FILE BUFFERS
LP J$GNLN,1 ;NUMBER OF LINES WRITTEN IN LOG
LP J$GIBC,1 ;INTERNAL LOG BYTE COUNT
LP J$GIBP,1 ;INTERNAL LOG BYTE POINTER
LP J$GINP,1 ;NUMBER OF INTERNAL LOG PAGES
LP J$$END,1 ;END OF PARAMETER AREA
J$$LEN==J$$END ;LENGTH OF PARAMETER AREA
SUBTTL Random Impure Storage
NXTJOB: BLOCK 1 ;NEXT JOB TO RUN
MESSAG: BLOCK 1 ;ADDRESS OF MESSAGE JUST RECEIVED
MSGBLK: BLOCK 15 ;PLACE TO BUILD MESSAGES TO QUASAR
TTYFLG: BLOCK 1 ;SET TO -1 ON TTY INTERRUPT
XITFLG: BLOCK 1 ;-1 IF PENDING EXIT
RSTFLG: BLOCK 1 ;-1 IF PENDING RESET
ACTFLG: BLOCK 1 ;-1 IF DOING ACCOUNTING
LPTPID: BLOCK 1 ;MY PID (RETURN BY CSPINI)
QRYFLG: BLOCK 1 ;ADR OF WORD TO SETOM WHEN AN IPCF INTERRUPT
; COMES IN
MSGJOB: BLOCK 1 ;-1 ON MESSAGE JOB
MSGFIL: BLOCK 1 ;-1 ON MESSAGE FILE
MSGERR: BLOCK 1 ;-1 ON MESSAGE ERROR
FMBPT: BLOCK 1 ;BYTE POINTER
FMADR: BLOCK 1 ;ADDRESS OF BUFFER
FMNEW: BLOCK 1 ;SET TO -1 AFTER RE-READING LPFORM
LPCNF: BLOCK 10 ;SYSNAME
PDL: BLOCK PDSIZE ;PUSHDOWN LIST
CNTSTA: BLOCK 1 ;NUMBER OF THE CENTRAL STATION
MYSTA: BLOCK 1 ;MY STATION
JOBPAG: BLOCK 1 ;ADDRESS OF A TWO PAGE BLOCK
; ONE FOR REQUEST, ONE FOR JOB PARAMS
NORMAL: EXP FRMNOR ;NAME OF STD FORMS
IFN FTJSYS,<
BLOKED: BLOCK 1 ;SET WHEN WE GO TO SLEEP
AWOKEN: BLOCK 1 ;SET WHEN WE GET AN INTERRUPT
GJBLK: BLOCK 10 ;BLOCK FOR LONG GTJFN
TTYFRK: BLOCK 1 ;FORK HANDLE FOR TTY PROCESS
TTYRUN: BLOCK 1 ;-1 IF TTY PROCESS IS RUNNING
TTYPTR: BLOCK 1 ;POINTER TO TTY BUFFER
TTYBUF: BLOCK 30 ;TTY BUFFER (FILLED BY LOWER FORK)
> ;END IFN FTJSYS
IFN FTUUOS,<
SEGBLK: BLOCK 6 ;GETSEG BLOCK
JIFSEC: BLOCK 1 ;JIFFIES/SEC
> ;END IFN FTUUOS
IFN FTJSYS,<
DDEV: -1,,[ASCIZ /SYS/] ;DEFAULT DEVICE FOR VFU AND TRM
DVFU: -1,,[ASCIZ /VFU/] ;DEF. EXT FOR VFU FILE
DTRM: -1,,[ASCIZ /TRM/] ;DEF. EXT FOR LP20 TRANS RAM FILE
DJFN: .NULIO,,.NULIO ;DEFAULT I/O JFNS
> ;END IFN FTJSYS
SUBTTL Idle Loop
TOPSEG
MAIN: MOVE P,[IOWD PDSIZE,PDL] ;SETUP A NEW PDL
SKIPE XITFLG ;EXIT PENDING?
JRST DOEXIT ;YES, DO IT
SKIPE RSTFLG ;NO, WHAT ABOUT A RESET
JRST DOREST ;YUP!
TXNN S,PLOCK ;SKIP IF PAUSE LOCK IS SET
TXNE S,PAUSEB ;TIME TO PAUSE?
PUSHJ P,DOPAUS ;YES, PAUSE NOW
SLP0: AND S,[RUNB+STARTD+PLOCK+FROZE+TTYBRK]
;CLEANUP FLAGS
PUSHJ P,CHKALL ;SOMETHING THERE?
HRRZ AP,MESSAG ;GET ADDRESS OF MESSAGE
JUMPE AP,SLP1 ;NO. GO TO SLEEP
LOAD T1,.MSTYP(AP),MS.TYP ;GET THE MESSAGE TYPE
CAIE T1,.QONEX ;IS IT A JOB FOR ME?
JRST [MOVX S1,1B0 ;LOAD A BIT
TDNN S1,MESSAG ;WAS IT A PAGE?
JRST SLP0 ;NO, JUST IGNORE IT
ADR2PG AP ;MAKE A PAGE NUMBER
PUSHJ P,M$RELP## ;RELEASE IT
JRST SLP0] ;AND LOOP
HRRZ S2,J ;YES, GET ADR OF JOB BLOCK
HRL S2,AP ;MAKE A BLT POINTER
LOAD T1,.MSTYP(AP),MS.CNT ;GET SIZE OF REQUEST
ADDI T1,-1(J) ;GET END OF BLT ADR
BLT S2,(T1) ;BLT THE REQEST
ADR2PG AP ;MAKE A PAGE NUMBER
PUSHJ P,M$RELP## ;RELEASE THE PAGE
JRST SETJOB ;AND GO DO IT
SLP1: PUSHJ P,M$CLNC## ;CLEAN UP BEFORE RESTING
MOVEI S1,^D60 ;60 SECONDS
PUSHJ P,SUSPND ;GO WAIT
JRST SLP0 ;AND LOOP
SUBTTL Job Setup
SETJOB: ON S,BUSY ;WE'VE GOT A JOB!!
PUSHJ P,M$ACQP## ;GET A DSK BUFFER PAGE
PG2ADR AP ;MAKE AN ADDRESS
MOVEM AP,J$DBUF(J) ;SAVE AS DISK BUFFER ADDRESS
PUSHJ P,ACTBEG ;SETUP ACCOUNTING INFO
LOAD T1,.EQSEQ(J),EQ.SEQ ;GET THE SEQUENCE NUMBER
CAMN T1,NXTJOB ;IS THE SPECIFIED NXTJOB?
CLEARM NXTJOB ;YES, CLEAR IT
PUSHJ P,CHKJOB ;CHECK OUT THE JOB
PUSHJ P,FNDLOG ;GO SETUP THE LOG-FILE
PUSHJ P,STALOG ;START THE LOG FILE
LOAD T1,.EQLM2(J),EQ.PGS ;GET LIMIT IN PAGES
SUB T1,.EQCHK+CKTPP(J) ;SUBRTRACT AMT PRINTED
MOVEM T1,J$RLIM(J) ;SAVE IT
SETZM J$RNFP(J) ;CLEAR FILES PRINTED
SETZM J$RNCP(J) ;CLEAR COPIES PRINTED
SETZM J$RNPP(J) ;CLEAR PAGES PRINTED
PUSHJ P,MOUNT ;MOUNT THE CORRECT FORMS
SKIPN MSGJOB ;MESSAGE JOB?
SKIPE J$FWHA(J) ;OR /WHAT?
SKIPA ;YES!!
JRST SETJ.1 ;NO, CONTINUE
TELL OPR,[ASCIZ /Starting /]
PUSHJ P,WHAT ;AND SOME MORE
SETJ.1: SKIPE J$FPAU(J) ;/PAUSE?
PUSHJ P,DOPAUS ;AND PAUSE
LOAD T1,.EQSEQ(J),EQ.RDE ;GET "IGNORE REQUEST" BIT
SKIPE T1 ;IS IT SET?
TXO S,ABORT ;YES, SET ABORT
SKIPE J$RFLP(J) ;SKIP IF NO FILES TO BE PRINTED
TXNE S,ABORT ;WERE WE ABORTED?
SKIPA ;EITHER 0 FILES, OR ABORTED
PUSHJ P,JOBHDR ;NO, GIVE THE BANNER
SUBTTL Do the Job
DOJOB: LOAD E,.EQLEN(J),EQ.LOH ;GET LENGTH OF HEADER
ADD E,J ;POINT TO FIRST FILE
SKIPN .EQCHK+CKFLG(J) ;IS THIS A RESTARTED JOB?
JRST DOJO.4 ;NO, SKIP ALL THIS STUFF
STAMP LPMSG ;STAMP THE LOG
TELL LOG,%%JBR ;JOB WAS RESTARTED
MOVEI T1,%%JBR1 ;AFTER CRASH
MOVX T2,CKFREQ ;GET REQUEUE BIT
TDNE T2,.EQCHK+CKFLG(J) ;CHECK IT
MOVEI T1,%%JBR2 ;YES, REQ
TELL LOG,(T1) ;FINISH THE MESSAGE
MOVE T1,.EQCHK+CKFIL(J) ;YES, GET NUMBER OF FILES DONE
MOVEM T1,J$RNFP(J) ;STORE FOR NEXT CHECKPOINT
SKIPGE T1 ;IS IT DURING THE LOG FILE?
JRST DOJO.7 ;YES, GO DO THE LOG
DOJO.1: SOJL T1,DOJO.2 ;DECREMENT AND JUMP IF SKIPED ENUF
PUSH P,T1 ;ELSE, SAVE T1
PUSHJ P,NXTFIL ;BUMP E TO NEXT SPEC
POP P,T1 ;RESTORE T1
JUMPE E,ENDJOB ;EASY JOB
JRST DOJO.1 ;LOOP SOME MORE
DOJO.2: MOVE T1,.EQCHK+CKCOP(J) ;GET NUMBER OF COPIES PRINTED
MOVEM T1,J$RNCP(J) ;SAVE FOR NEXT CHECKPOINT
DOJO.3: SKIPA T1,.EQCHK+CKPAG(J) ;GET CHKPNT'ED PAGE
DOJO.4: LOAD T1,.FPFST(E) ;GET /START PARAMETER
MOVEM T1,J$XPG1(J) ;SAVE FOR FIRST COPY
DOJO.5: LOAD T1,.FPFST(E) ;GET START PARAMETER
MOVEM T1,J$XPG2(J) ;SAVE FOR SUBSEQUET COPIES
CAME E,J$RLFS(J) ;IS IT THE LOG FILE?
PUSHJ P,FILE ;NO, PRINT THE FILE
DOJO.6: PUSHJ P,NXTFIL ;BUMP TO NEXT FILE
JUMPN E,DOJO.4 ;AND LOOP
DOJO.7: PUSHJ P,RIDLOG ;CLOSE AND RELEASE THE LOG
SKIPN E,J$RLFS(J) ;GET ADR OF LOG-SPEC
JRST ENDJOB ;NO, FINISH JOB
SETZM J$RLFS(J) ;CLEAR SOME LOCATIONS
SETZM J$RFLN(J) ; TO AVOID POSIBILITY OF LOOPS
SETOM J$RNFP(J) ;AND MAKE CHECKPOINT WORK RIGHT
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
OFF S,ABORT ;CLEAR ABORT FLAG
PUSHJ P,FILE ;PRINT THE FILE
JRST ENDJOB ;AND FINISH UP
NXTFIL: SETZM J$RNCP(J) ;CLEAR COPIES PRINTED
SOSG J$RFLN(J) ;DECREMENT FILE COUNT
JRST NXTF.1 ;DONE, RETURN A ZERO
PUSHJ P,CLSLOG ;CLOSE OUT THE LOG
LOAD T1,.FPSIZ(E),FP.FHD ;GET SIZE OF THE FP
LOAD T2,.FPSIZ(E),FP.FFS ;GET SIZE OF THE FD
ADD E,T1 ;BUMP E ONCE
ADD E,T2 ;AND AGAIN
AOS J$RNFP(J) ;ONE MORE FILE DOWN
POPJ P, ;AND RETURN
NXTF.1: SETZ E, ;CLEAR E
POPJ P, ;AND RETURN
SUBTTL Print a File
FILE: PUSHJ P,OPINFL ;OPEN THE FILE UP
PJUMPE S1,CLSFIL ;LOSE, CLOSE FILE AND RETURN
TXNE S,ABORT ;HAVE WE KILLED HIM?
JRST FILDIS ;YES, CLEAN UP SOME
LOAD T1,.FPINF(E),FP.IGN ;WAS FILE /REMOVE'D?
JUMPN T1,FILDIS ;YES, GO DISPOSE OF IT
PUSHJ P,ACCCHK ;CHECK FILE ACCESS
PJUMPE S1,CLSFIL ;NO ACCESS...
PUSHJ P,SETREF ;YES, GO SETUP REF-NAME
STAMP LPMSG ;GIVE A STAMP
TELL LOG,%%STF ;AND GIVE A START MESSAGE
SKIPE MSGFIL ;OPR WANT ONE TOO?
TELL OPR,%%STF ;YES,
LOAD T1,.FPINF(E),FP.FCY ;GET NUMBER OF COPIES
SUB T1,J$RNCP(J) ;SUBRTRACT THOSE ALREADY PRINTED
MOVEM T1,J$XCOP(J) ;AND STORE IT
SETZM J$RNCP(J) ;CLEAR NUMBER OF COPIES WORD
PUSHJ P,ACTBFL ;DO PRE-FILE ACCOUNTING
PUSHJ P,COPY ;DO THE COPY LOOP
PUSHJ P,ACTEFL ;DO POST-FILE ACCOUNTING
TXNE S,ABORT ;HAVE WE ABORTED?
JRST FILDIS ;YES, SKIP THE MESSAGE
STAMP LPMSG ;GIVE A STAMP
TELL LOG,%%FPF ;GIVE A MESSAGE
FILDIS: LOAD T1,.FPINF(E) ;GET THE INFO WORD
TXNE T1,FP.SPL ;IS IT SPOOLED?
JRST FILD.1 ;YES, DELETE IT
TXNE T1,FP.IGN ;IS IT IGNORED
JRST CLSFIL ;YES, JUST CLOSE IT OFF
TXNN T1,FP.DEL ;IS IT /DELETE?
PJRST CLSFIL ;NO, JUST CLOSE IT OFF
TXNE T1,FP.FLG ;YES, IS IT THE LOG FILE?
TXNE T1,FP.FCY ;YES, IS IT /COPIES:0
SKIPA ;NO, NORMAL FILE
JRST FILD.1 ;YES, DELETE IT
TXNN S,ABORT ;ITS ORDINARY, IS JOB ABORTED?
FILD.1: PUSHJ P,DELFIL ;NO, GO DELETE THE FILE
PJRST CLSFIL ;CLOSE THE FILE AND RETURN
SUBTTL Per Copy Loop
COPY: SOSGE J$XCOP(J) ;COUNT DOWN COPIES
POPJ P, ;RETURN WHEN DONE
PUSHJ P,HEAD ;PUT ON A HEADER
PUSHJ P,OUTDMP ;DUMP THE REST OUT AND WAIT
ON S,DSKOPN ;TURN ON FILE-OPEN FLAG
TXNE S,ABORT ;KILLED WHILE PRINTING?
POPJ P, ;YES, RETURN
PUSHJ P,REWIND ;REWIND THE FILE
CLEARM J$XSBC(J) ;CLEAR SAVED BYTE COUNT
TXNE S,SUPJOB ;SUPRES /JOB?
ON S,SUPRES ;YES.LIGHT A BIT
MOVEI T1,MAXERR ;NUMBER OF I/O ERROR BEFORE QUITTING
MOVEM T1,J$DERR(J) ;STORE
SETZM J$RNPP(J) ;CLEAR THE PAGE WORD
MOVE N,J$XPG1(J) ;GET PAGE FOR 1ST COPY
MOVE T1,J$XPG2(J) ;GET PAGE FOR SUBSEQENTS
MOVEM T1,J$XPG1(J) ;SAVE SO WE GET IT NEXT TIME
SOSLE N ;JUMP IF NONE
PUSHJ P,FORWD1 ;CALL FORWARD TO SET EVERYTHING UP
PUSHJ P,FILOUT ;PRINT THE FILE
OFF S,NOTYPE!DSKOPN ;CLEAR SOME FLAGS
TXNE S,ABORT ;ABORTED?
POPJ P, ;YES, RETURN
AOS J$RNCP(J) ;INCREMENT COPIES WORD
JRST COPY ;STILL MORE TO DO
SUBTTL End of Job
ENDJOB: PUSHJ P,ACTEND ;DO THE NECESSARY ACCOUTING
MOVX T1,<REL.SZ,,.QOREL>
MOVEM T1,MSGBLK ;SETUP MESSAGE HEADER
LOAD T1,.EQITN(J) ;GET THE JOBS ITN
STORE T1,MSGBLK+REL.IT ;STORE IN THE MESSAGE
MOVEI T1,MSGBLK ;LOAD ADDRESS
TXNN S,RQB ;DON'T SEND REL IF WE HAVE REQ'D
PUSHJ P,SNDQSR## ;SEND IT
ENDJ.1: STAMP LPSUM ;GENERATE A SUMMARY STAMP
MOVE N,J$ARTM(J) ;GET CP TIME USED
IDIVI N,^D1000 ;DIVIDE BY MILLI-SECS PER SEC
TELL LOG,[ASCIZ /Spooler runtime # Seconds, /]
IFN FTUUOS,<
MOVE N,J$ACTI(J) ;GET # OFKCS USED
IDIVI N,144 ;CONVERT TO SECONDS
TELL LOG,[ASCIZ /# KCS, /]
MOVE N,J$ADRD(J) ;READ COUNT
TELL LOG,[ASCIZ /# disk reads, /]
> ;END IFN FTUUOS
MOVE N,J$APRT(J) ;GET PAGES
TELL LOG,[ASCIZ /# pages printed
/]
PUSHJ P,JOBTRL ;PRINT THE TRAILER
MOVE AP,J$DBUF(J) ;GET ADR OF DSK BUFFER
ADR2PG AP ;MAKE IT A PAGE NUMBER
PUSHJ P,M$RELP## ;RETURN IT
PUSHJ P,CLNLOG ;CLEAN UP LOG PAGES
SKIPN MSGJOB ;WANT JOB MESSAGES?
JRST ENDJ.2 ;NO, CONTINUE ON
TELL OPR,[ASCIZ /Finished /]
PUSHJ P,WHAT ;JOB ID
ENDJ.2: OFF S,BUSY ;NOT BUSY
JRST MAIN ;AND LOOP TO THE BEGINNING
SUBTTL CHKJOB - Check the files and count them
;CHKJOB IS CALLED DURING JOB SETUP. IT FILLS IN 3 LOCATIONS:
; J$RFLN - NUMBER OF FILES IN REQUEST
; J$RFLP - NUMBER OF FILES WHICH WILL BE PRINTED
; J$RLFS - ADDRESS OF THE LOG FILE SPEC
CHKJOB: SETZM J$RLFS(J) ;ASSUME NO LOG FILE
LOAD T1,.EQSPC(J),EQ.NUM ;GET NUMBER OF FILES IN REQUEST
MOVEM T1,J$RFLN(J) ;AND SAVE IT
MOVEM T1,J$RFLP(J) ;AND START AS NUMBER TO PRINT
LOAD T2,.EQLEN(J),EQ.LOH ;GET LENGTH OF HEADER
ADD T2,J ;AND POINT TO FIRST FILE
CHKJ.1: LOAD T3,.FPINF(T2) ;GET INFO WORD
TXNE T3,FP.FLG ;IS IT THE LOG FILE?
MOVEM T2,J$RLFS(J) ;YES, SAVE ITS ADDRESS
TXNE T3,FP.FCY ;/COP:0?
TXNE T3,FP.IGN ;NO, IS IT IGNORED?
SOS J$RFLP(J) ;EITHER 0 COPIES OR IGNORED
LOAD T3,.FPSIZ(T2),FP.FHD ;GET LENGTH OF THE FP
LOAD T4,.FPSIZ(T2),FP.FFS ;GET LENGTH OF THE FD
ADD T2,T3 ;BUMP T2 ONCE
ADD T2,T4 ;BUMP T2 AGAIN
SOJG T1,CHKJ.1 ;AND LOOP
LOAD T1,.EQSEQ(J),EQ.RDE ;GET THE RDE BIT
SKIPE T1 ;SKIP IF NOT AN RDE JOB
SETZM J$RLFS(J) ;ELSE, NO LOG FILE
POPJ P, ;DONE, RETURN
SUBTTL Message Check Routines
LOWSEG ;PLACE IN LOW SEGMENT
;THREE ROUTINES ARE USED TO CHECK FOR VARIOUS MESSAGES:
; CHKALL -- CHECKS FOR BOTH OPERATOR TYPEIN AND IPCF MESSAGES
; CHKOPR -- CHECKS FOR OPERATOR TYPE IN
; CHKQUE -- CHECKS FOR IPCF MESSAGES
;LOCATION "MESSAG" IS RETURNED WITH THE ADDRESS OF ANY MESSAGE RECEIVED.
CHKALL: PUSHJ P,CHKSEG ;CHECK TO SEE IF WE HAVE A HISEG
PUSHJ P,CHKOP0 ;SEE IF OPR WANTS SOMETHING
PUSHJ P,CHKQU0 ;SEE IF ANYTHING'S IN THE QUEUE
POPJ P, ;AND RETURN
;CHKSEG SIMPLY RETURNS IF THE HISEGMENT EXISTS, AND CALLS ITS CALLER
; IF NOT. HENCE, WHEN THE CALLER RETURNS WE GET TO DELETE THE
; HISEG.
;
CHKSEG: SKIPE .JBHRL## ;IS THERE A HISEG?
POPJ P, ;YES, JUST RETURN
EXCH S1,0(P) ;NO, SAVE S1 GET CALLERS ADDRESS
PUSHJ P,(S1) ;AND CALL HIM
POP P,S1 ;RESTORE S1
PJRST CLRSEG ;AND CLEAR THE HISEG
CHKOPR: PUSHJ P,CHKSEG ;CHECK THE HISEG
CHKOP0: ;ENTER HERE FROM CHKALL
IFN FTUUOS,<
SETZ S1, ;LOAD A 0
EXCH S1,TTYFLG ;LOAD TTYFLG AND SET FOR NEXT TIME
JUMPE S1,.POPJ## ;NO, RETURN IF NOTHING THERE
SKPINL ;CHECK
POPJ P, ;NOTHING THERE FOR REAL
PUSHJ P,GETSPL ;GET THE HISEG
PUSHJ P,SAVALL ;SAVE ALL ACS
CHKOP1: PUSHJ P,COMIN ;DO ONE COMMAND
SKPINL ;IS THERE ONE?
POPJ P, ;NO, RETURN
JRST CHKOP1 ;YES, GET ANOTHER COMMAND
> ;END IFN FTUUOS
IFN FTJSYS,<
SKIPN TTYFLG ;HAS HE TYPED ANYTHING?
POPJ P, ;NO, RETURN
PUSHJ P,SAVALL ;YES, SAVE ACS
PJRST COMIN ;GET A COMMAND
> ;END IFN FTJSYS
CHKQUE: PUSHJ P,CHKSEG ;SEE IF WE HAVE A HISEG
CHKQU0: ;ENTER HERE FROM CHKALL
PUSHJ P,CSPRCV## ;RECEIVE A MESSAGE
MOVEM S1,MESSAG ;SAVE ADDRESS OF MESSAGE
JUMPE S1,.POPJ## ;RETURN NOTHING THERE, RETURN
LOAD S2,.MSTYP(S1),MS.TYP
CAIE S2,.QONEX ;IS IT A JOB FOR ME?
JRST CHKQU1 ;NO, CONTINUE
POPJ P,
CHKQU1: TXNN S,BUSY ;ARE WE BUSY?
POPJ P, ;NO, JUST IGNORE THE WHOLE THING
PUSHJ P,SAVALL ;SAVE THE T REGS
CAIE S2,.QOABO ;IS IT ABORT??
JRST CHKQU2 ;NO, SEE IF QUASAR IS REQUESTING A CHKPNT
PUSHJ P,GETSPL ;YES, GET THE HISEG
PJRST UKILL ;AND KILL OFF THE JOB
CHKQU2: CAIE S2,.QORCK ;CHECKPOINT REQUEST?
POPJ P, ;NO, RETURN
PJRST TAKCHK ;AND TAKE A CHECKPOINT
SUBTTL Core and Segment Handling Routines
; GETSPL -- GET THE SPOOLER'S HISEG
; CLRSEG -- CLEAR THE SPOOLER'S HISEG
LOWSEG ;THESE ARE IN THE LOWSEG
SUBTTL GETSPL - Routine to get the spooler's hiseg
;GETSPL IS CALLED TO MAP THE SPOOLER'S HISEG IN
;CALL WITH:
; PUSHJ P,GETSPL
; RETURN HERE
IFN FTUUOS,<
GETSPL: SKIPE .JBHRL ;SKIPE IF NO HISEG
POPJ P, ;ELSE SKIP SEGCON
PUSHJ P,SAVALL ;SAVE THE AC'S
PUSHJ P,INTOFF ;TURN OFF INTERRUPTS
GETSP1: MOVEI T1,SEGBLK ;POINT TO SEGBLK
PUSH P,S
MOVEM P,SAVP#
GETSEG T1, ;GET IT
HALT [MOVE P,SAVP
POP P,S
JRST GETSP1]
MOVE P,SAVP
POP P,S
PJRST INTON ;TURN ON INTERRUPTS AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
GETSPL: POPJ P,
> ;END IFN FTJSYS
SUBTTL CLRSEG - Routine to clear the spooler's hiseg
;CLRSEG IS CALLED TO MAP THE SPOOLER'S HISEG OUT
;CALL:
; PUSHJ P,CLRSEG
; RETURN HERE
IFN FTUUOS,<
CLRSEG: SKIPN .JBHRL ;IS THERE A HISEG?
POPJ P, ;NO, DON'T GET RID OF IT
PUSH P,T1 ;SAVE T1
MOVSI T1,1 ;SET SIZE OF HISEG TO 1 WORD
CORE T1, ;CALL CORE0
JFCL ;IGNORE ANY ERROR
POP P,T1 ;RESTORE T1
POPJ P, ;IGNORE SUCCESS
> ;END IFN FTUUOS
IFN FTJSYS,<
CLRSEG: POPJ P,
> ;END IFN FTJSYS
SUBTTL Input File Facilities
; OPINFL -- OPEN THE INPUT FILE
; ACCCHK -- CHECK USER'S ACCESS TO THE INPUT FILE
; DELFIL -- DELETE THE INPUT FILE
; CLSFIL -- CLOSE THE INPUT FILE
; TELCAF -- REPORT FILE ACCESS ERROR
; SETREF -- SETUP REFERENCE NAME FOR FILE
TOPSEG ;PUT THEM ALL IN THE HISEG
SUBTTL OPINFL - Routine to open the input file
;OPINFL IS CALLED WITH AC "E" POINTING TO THE FP AREA FOR THE FILE
; TO BE OPENED.
;
;CALL:
; PUSHJ P,OPINFL
; ALWAYS RETURN HERE
;
;RETURNS S1 = "TRUE" ON SUCCESS, "FALSE" OTHERWISE.
IFN FTUUOS,<
OPINFL: LOAD S1,.FPSIZ(E),FP.FHD ;GET SIZE OF THE FP AREA
ADD S1,E ;AND POINT S1 TO THE FD AREA
MOVE T2,.FDNAM(S1) ;GET THE FILENAME
MOVEM T2,J$DUUO+.RBNAM(J) ;SAVE IN LOOKUP BLOCK
HLLZ T2,.FDEXT(S1) ;GET THE EXTENSION
MOVEM T2,J$DUUO+.RBEXT(J) ;SAVE IN THE UUO BLOCK
MOVSI T1,J$DPAT(J) ;ADR OF PATH BLOCK,,0
HRRI T1,J$DPAT+1(J) ;BLT POINTER TO ZERO IT OUT
CLEARM J$DPAT(J) ;CLEAR THE FIRST WORD
BLT T1,J$DPAT+7(J) ;CLEAR THE REST
MOVEI T1,J$DPAT+2(J) ;POINT TO PPN WORD
HRLI T1,.FDPPN(S1) ;SETUP TO BLT THE PATH
LOAD T2,.FPSIZ(E),FP.FFS ;GET SIZE OF FD AREA
ADDI T2,-FDMSIZ(J) ;SUB FDMSIZ, ADD AP
BLT T1,J$DPAT+2(T2) ;BLT THE PATH
MOVEI T1,J$DPAT(J) ;ADDRESS OF PATH BLOCK
SKIPN J$DPAT+3(J) ;IS THERE AN SFD?
MOVE T1,J$DPAT+2(J) ;NO, LOAD THE PPN
MOVEM T1,J$DUUO+.RBPPN(J) ;AND SAVE IN THE UUO BLOCK
MOVEI T1,.RBTIM ;GET THE SIZE OF THE BLOCK
MOVEM T1,J$DUUO+.RBCNT(J) ;AND SAVE IT IN RIBCNT
MOVX T1,FO.PRV+.FORED+<DSK>B17 ;FILOP SETUP
MOVEM T1,J$DFLP+.FOFNC(J) ;STORE THE FUNCTION WORD
MOVEI T1,.IOASC ;ASSUME ASCII MODE
LOAD T2,.FPINF(E),FP.FFF ;GET /FILE:
LOAD T3,.FPINF(E),FP.FPF ;GET /PAPER:
CAIE T2,.FPFCO ;/FILE:COBOL?
CAIN T3,%FPLOC ;OR /PAPER:OCTAL?
MOVEI T1,.IOBIN ;YES, USE BINARY MODE
MOVEM T1,J$DFLP+.FOIOS(J) ;SAVE IOS
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
SKIPN T1,.FDSTR(S1) ;GET THE STRUCTURE
MOVSI T1,'DSK' ;GUARD AGAINST CONKLIN
MOVEM T1,J$DFLP+.FODEV(J) ;AND SAVE IT
MOVEI T1,J$DBRH(J) ;LOAD ADR OF BUFFER RING HDR
MOVEM T1,J$DFLP+.FOBRH(J) ;AND STORE IT
MOVEI T1,<1000/203> ;NUMBER OF INPUT BUFFERS
MOVEM T1,J$DFLP+.FONBF(J) ;STORE IT
MOVEI T1,J$DUUO(J) ;ADDRESS OF THE LOOKUP BLOCK
MOVEM T1,J$DFLP+.FOLEB(J) ;AND STORE IT
MOVE T4,J$DBUF(J) ;GET ADR OF BUFFERS
EXCH T4,.JBFF ;AND SAVE IT AS JOBFF
MOVEI T1,J$DFLP(J) ;LOAD ADR OF FILOP BLOCK
HRLI T1,6 ;LOAD THE LENGTH
FILOP. T1, ;GET THE FILE
JRST [MOVEM T4,.JBFF ;RESTORE JOBFF
JRST OPIN.1] ;TYPE MESSAGE AND GO ON
MOVEM T4,.JBFF ;RESTORE JOBFF
PJRST .TRUE## ;WIN RETURN
OPIN.1: MOVE S1,T1 ;GET THE ERROR CODE
MOVX S2,LOG ;TELL LOG
SKIPE MSGERR ;AND IF OPR WANTS ERRORS
IORX S2,OPR ;TELL HIM TOO
PUSHJ P,TELCAF ;TELL THEM
PJRST .FALSE## ;AND LOSE RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
OPINFL: LOAD S2,.FPSIZ(E),FP.FHD ;GET SIZE OF FP AREA
ADD S2,E ;S2 POINTS TO FD
MOVEM S2,J$DSTG(J) ;AND SAVE THE POINTER
HRLI S2,(POINT 7,0) ;MAKE IT A BYTE POINTER
MOVX S1,<GJ%OLD!GJ%SHT> ;SHORT GTJFN, OLD FILE ONLY
GTJFN ;FIND THE FILE
JRST OPIN.3 ;FAILED?
MOVEM S1,J$DJFN(J) ;SAVE THE JFN
SETZM J$DRMS(J) ;ASSUME NOT AN RMS FILE
MOVE S1,J$DJFN(J) ;GET THE JFN
MOVX S2,<.FBLEN,,.FBHDR> ;GET ENTIRE FDB
MOVEI T1,J$DFDB(J) ;LOAD ADDRS OF BLOCK
GTFDB ;AND GET IT
LOAD T1,J$DFDB+.FBCTL(J),FB%FCF
CAIN T1,.FBRMS ;LOAD FILE CLASS AND TEST IT
SETOM J$DRMS(J) ;IT IS AN RMS FILE
MOVE S1,J$DJFN(J) ;NOW, GET THE JFN
MOVX S2,<OF%RD+44B5> ;READ 36BIT BYTES
SKIPL J$DRMS(J) ;SKIP IF RMS FILE
OPENF ;ELSE, OPEN THE FILE
ERJMP OPIN.3 ;LOSE
LOAD T2,.FPINF(E),FP.FFF ;GET /FILE
LOAD T3,.FPINF(E),FP.FPF ;GET /PAPER
MOVX T1,<POINT 7,5> ;ASSUME 5 7BIT-BYTES/WORD
CAIE T2,.FPFCO ;/FILE:COBOL
CAIN T3,%FPLOC ;OR /PAPER:OCTAL?
MOVX T1,<POINT 36,1> ;YES, 1 36BIT-BYTE/WORD
MOVEM T1,J$DMOD(J) ;SAVE IT FOR "FILL"
SKIPN J$DRMS(J) ;SKIP IF RMS FILE
PJRST .TRUE## ;WIN RETURN
;MORE OF "OPINFL" ON FOLLOWING PAGE
;HERE IF OPENING AN RMS-20 FILE, FIRST SETUP THE FAB
MOVSI T1,J$DFAB(J) ;GET FAB,,0
HRRI T1,J$DFAB+1(J) ;GET FAB,,FAB+1
SETZM J$DFAB(J) ;CLEAR THE FIRST WORD
BLT T1,J$DFAB+FA$LNG-1(J) ;CLEAR THE REST
MOVX T1,FA$TYP ;BLOCK TYPE
$STFAB T1,BID ;STORE THE BLOCK ID
MOVX T1,FA$LNG ;BLOCK LENGTH
$STFAB T1,BLN ;AND STORE IN FAB
MOVX T1,FB$GET ;GET "GET" ACCESS CODE
$STFAB T1,FAC ;STORE IN FILE ACCESS FIELD
SETZ T1, ;CLEAR T1
$STFAB T1,SHR ;AND STORE IT IN SHARE FIELD
MOVE T1,J$DJFN(J) ;GET THE JFN
$STFAB T1,JFN ;STORE IT IN JFN FIELD
PUSHJ P,SETRMS ;SETUP TO CALL RMS
MOVEI AP,J$DFAB(J) ;LOAD ADDRESS OF FAB
$OPEN <(AP)>,RMSERR ;OPEN THE FAB
SKIPE J$DRME(J) ;ERROR?
JRST OPIN.3 ;YES, GO HANDLE IT
$LDFAB S1,BSZ ;GET THE BYTE SIZE
LSH S1,6 ;POSITION IT
TRO S1,440000 ;MAKE A BYTE POINTER
HRLZ S1,J$DMOD(J) ;AND STORE IT
;NOW SETUP THE RAB
MOVSI T1,J$DRAB(J) ;GET RAB,,0
HRRI T1,J$DRAB+1(J) ;GET RAB,,RAB+1
SETZM J$DRAB(J) ;CLEAR THE FIRST WORD
BLT T1,J$DRAB+RA$LNG-1(J) ;CLEAR THE REST
MOVX T1,RA$TYP ;GET BLOCK TYPE
$STRAB T1,BID ;STORE IT
MOVX T1,RA$LNG ;GET BLOCK LENGTH
$STRAB T1,BLN ;STORE IT
MOVX T1,RB$SEQ ;LOAD SEQUENTIAL ACCESS
$STRAB T1,RAC ;STORE RECORD ACCESS TYPE
MOVX T1,RB$LOC ;DONT MOVE RECORD
$STRAB T1,ROP ;REQUESTED OPERATION
MOVEI T1,1000 ;LOAD THE BUFFER SIZE
$STRAB T1,USZ ;SAVE IT
MOVE T1,J$DBUF(J) ;LOAD ADDRESS OF BUFFER
$STRAB T1,UBF ;STORE IT
MOVEI T1,J$DFAB(J) ;LOAD ADDRESS OF FAB
$STRAB T1,FAB ;STORE IT
PUSHJ P,SETRMS ;SETUP TO CALL RMS
MOVEI AP,J$DRAB(J) ;LOAD ADDRESS OF RAB
$CONNEC <(AP)>,RMSERR ;CONNECT IT TO THE FAB
SKIPE J$DRME(J) ;ANY ERROR?
JRST OPIN.3 ;YES, HANDLE IT
SETOM J$DRFA(J) ;INDICATE NO RFA YET
PJRST .TRUE## ;AND RETURN TRUE
;OPINFL IS CONTINUED ON FOLLOWING PAGE
;CONTINUED FROM PREVIOUS PAGE
OPIN.3: MOVX S2,LOG ;TELL LOG
SKIPE MSGERR ;AND IF OPR WANTS ERRORS
IORX S2,OPR ;TELL HIM TOO
PUSHJ P,TELCAF ;TELL THEM
PJRST .FALSE## ;AND LOSE
> ;END IFN FTJSYS
SUBTTL ACCCHK - Check access to current file
;ACCCHK IS CALLED TO CHECK THE USER'S ACCESS TO THE CURRENT FILE.
;
;THERE ARE FOUR CASES:
; 1) IF THE REQUEST CREATOR WAS PRIVILEGED, SUCCESS IS RETURNED
; 2) IF THE FILE IS SPOOLED, SUCCESS IS AUTOMATICALLY RETURNED
; 3) IF THE FILE IS NOT TO BE DELETED, "READ" ACCESS IS CHECKED
; 4) IF THE FILE IS TO BE DELETED:
; A) DELETE ACCESS IS CHECKED. IS THIS SUCCEEDS, SUCCESS
; IS RETURNED.
; B) IF THIS FAILS, THE DISPOSITION IS CHANGED TO
; PRESERVE AND WE GO BACK TO STEP 3.
;
;ON SUCCESS, S1 IS RETURNED "TRUE", OTHERWISE IT IS RETURNED "FALSE".
IFN FTUUOS,<
ACCCHK: LOAD S1,.EQSEQ(J),EQ.PRV ;GET PRIV BIT
PJUMPN S1,.TRUE## ;AND RETURN IF CREATOR WAS PRIV'ED
LOAD S1,.FPINF(E),FP.SPL ;GET SPOOLED BIT
JUMPN S1,.TRUE## ;IT'S SPOOLED, JUST RETURN
HRLZI T2,.ACRED ;ASSUME READ ACCESS
LOAD S2,.FPINF(E),FP.DEL ;ARE WE DELETING IT?
SKIPE S2 ;SKIP IF NO
HRLZI T2,.ACREN ;YES, WE ARE
HLRZ T3,J$DUUO+.RBPRV(J) ;GET PROTECTION CODE
LSH T3,-^D9 ;SHIFT IT OVER
HRR T2,T3 ;AND COPY IT INTO T2
MOVE T3,J$DUUO+.RBPPN(J) ;GET THE FILE'S DIRECTORY
TLNN T3,-1 ;A PATH?
MOVE T3,2(T3) ;YES, GET PPN FROM PATH BLOCK
MOVE T4,.EQOWN(J) ;GET USER'S PPN
MOVE T1,[3,,T2] ;LOAD BLOCK POINTER
CHKACC T1, ;TRY IT!
JRST ACCC.1 ;FAILURE
JUMPE T1,.TRUE## ;SUCCESS!!
CLEAR S2, ;CLEAR A REG
STORE S2,.FPINF(E),FP.DEL ;CLEAR THE DELETE BIT
HRLI T2,.ACRED ;TRY READ ONLY
MOVE T1,[3,,T2] ;LOAD ARG POINTER
CHKACC T1, ;TRY AGAIN
JRST ACCC.1 ;THAT'S FUNNY?
JUMPE T1,.TRUE## ;WIN!
ACCC.1: MOVX S1,ERPRT% ;LOAD ERROR CODE
MOVX S2,LOG ;TELL LOG
SKIPE MSGERR ;AND IF OPR WANTS ERRORS
IORX S2,OPR ;TELL HIM TOO
PUSHJ P,TELCAF ;TELL THEM
PJRST .FALSE## ;AND LOSE
> ;END IFN FTUUOS
IFN FTJSYS,<
ACCCHK: LOAD S1,.EQSEQ(J),EQ.PRV ;GET PRIV BIT
PJUMPN S1,.TRUE## ;RETURN IF HE WAS PRIV'ED
LOAD S1,.FPINF(E),FP.SPL ;GET SPOOL BIT
PJUMPN S1,.TRUE## ;RETURN IF IT IS SPOOLED
MOVX S1,.CKARD ;GET "READ" CODE
LOAD S2,.FPINF(E),FP.DEL ;GET DELETE BIT
SKIPE S2 ;WAS IT SET?
MOVX S1,.CKAWT ;YES, CHECK "WRITE" CODE
MOVEM S1,J$DCAB+.CKAAC(J) ;STORE IN CHKAC BLOCK
MOVE S1,J$DJFN(J) ;GET THE FILE'S JFN
MOVEM S1,J$DCAB+.CKAUD(J) ;STORE IN BLOCK
HRROI S1,.EQOWN(J) ;POINT TO USER'S DIRECTRY
STORE S1,J$DCAB+.CKALD(J) ;STORE IT
HRROI S1,.EQCON(J) ;POINT TO CONNECTED DIR
STORE S1,J$DCAB+.CKACD(J) ;STORE IT
ZERO J$DCAB+.CKAEC(J)
MOVEI S1,.CKAUD+1 ;LOAD ARG COUNT
TXO S1,CK%JFN ;SET JFN ARG BIT
MOVEI S2,J$DCAB(J) ;LOAD BLOCK ADR
CHKAC ;CHECK ACCESS
JRST ACCC.1 ;LOSE, NO ACCESS
PJUMPN S1,.TRUE## ;RETURN IF SUCCESSFUL
ZERO S2 ;CLEAR OUT S2
STORE S2,.FPINF(E),FP.DEL ;AND CLEAR THE DELETE BIT
MOVX S1,.CKARD ;GET READ CODE
MOVEM S1,J$DCAB+.CKAAC(J) ;STORE IT
MOVEI S1,.CKAUD+1 ;NUMBER OF ARGS
TXO S1,CK%JFN ;SET JFN ARG BIT
MOVEI S2,J$DCAB(J) ;WHERE THEY ARE
CHKAC ;TRY AGAIN
JRST ACCC.1 ;LOSE
PJUMPN S1,.TRUE## ;WIN ?
ACCC.1: MOVX S1,OPNX3 ;LOAD THE ERROR CODE
MOVX S2,LOG ;TELL LOG
SKIPE MSGERR ;AND IF OPR WANTS ERRORS
IORX S2,OPR ;TELL HIM TOO
PUSHJ P,TELCAF ;TELL THEM
PJRST .FALSE## ;AND LOSE
> ;END IFN FTJSYS
SUBTTL DELFIL - Routine to delete the current file
;DELFIL SIMPLY DELETES THE CURRENT FILE
IFN FTUUOS,<
DELFIL: CLEARB T1,T2 ;CLEAR TWO WORDS
CLEARB T3,T4 ;AND TWO MORE
RENAME DSK,T1 ;DELETE IT
JFCL ;IGNORE THIS
POPJ P, ;AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
DELFIL: MOVX S1,1B0 ;"DON'T RELEASE JFN"
HRR S1,J$DJFN(J) ;GET THE JFN
CLOSF ;CLOSE THE FILE
JFCL ;IGNORE
MOVX S1,DF%EXP ;DELETE AND EXPUNGE
HRR S1,J$DJFN(J) ;GET THE JFN
DELF ;DELETE IT
JFCL ;IGNORE THIS
POPJ P, ;AND RETURN
> ;END IFN FTJSYS
SUBTTL CLSFIL - Routine to close current file
;CLSFIL IS CALLED TO SIMPLY CLOSE OUT THE CURRENT INPUT FILE
IFN FTUUOS,<
CLSFIL: CLOSE DSK,100 ;CLOSE AND GIVE UP THE A.T.
RELEAS DSK, ;RELEASE THE CHANNEL
OFF S,DSKOPN ;TURN OFF THE OPEN FLAG
POPJ P, ;AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
CLSFIL: SKIPE J$DRMS(J) ;IS THIS AN RMS FILE?
JRST CLSF.1 ;YES, GO DO SOMETHING DIFFERENT
HRRZ S1,J$DJFN(J) ;GET THE JFN
CLOSF ;CLOSE IT AND RELEASE THE JFN
JFCL ;IGNORE THE ERROR
OFF S,DSKOPN ;CLEAR THE OPEN FLAG
POPJ P, ;AND RETURN
CLSF.1: MOVEI T1,J$DRAB(J) ;LOAD ADDRESS OF THE RAB
$DISCON <(T1)> ;AND DISCONNECT FROM THE FAB
MOVEI T1,J$DFAB(J) ;NO GET ADR OF THE FAB
$CLOSE <(T1)> ;AND CLOSE THE FILE
MOVE S1,J$DJFN(J) ;GET THE JFN
RLJFN ;RELEASE IT
JFCL ;IGNORE THE ERROR RETURN
POPJ P, ;RETURN
> ;END IFN FTJSYS
SUBTTL TELCAF - Routine to report file access failure
;TELCAF IS CALLED TO REPORT A FAILURE IN ATTEMPTING TO ACCESS A FILE.
;
;CALL:
; MOVE S1,[ERROR CODE]
; MOVE S2,[AC FIELD (DESTINATION) OF TELL UUO]
; PUSHJ P,TELCAF
; ALWAYS RETURN HERE
TELCAF: LOAD T1,.FPINF(E),FP.IGN ;GET FILE-IGNORE BIT
LOAD T2,.EQSEQ(J),EQ.RDE ;AND REQUEST-IGNORE BIT
IOR T1,T2 ;OR THEM TOGETHER
JUMPN T1,.POPJ## ;AND RETURN IF EITHER IS SET
LSH S2,^D23 ;PUT BITS INTO AC FIELD
DMOVEM S1,T3 ;AND STORE THE ARGS
TXNE S2,LOG_^D23 ;IS IT GOING TO THE LOG
STAMP LPERR ;YES, STAMPIT
MOVE N,T3 ;GET THE ERROR CODE
MOVE T1,[TELL %%CAF] ;LOAD THE UUO
IOR T1,T4 ;OR IN THE DESTINATION
XCT T1 ;AND DO THE UUO
IFN FTUUOS,<
MOVSI T1,-ERTBLN ;MAKE AOBJN PTR FOR TABLE
MOVE S1,T3 ;AND GET ERROR CODE
TELC.1: MOVE T2,ERRTAB(T1) ;GET AN ENTRY
CAIN S1,(T2) ;CORRECT CODE?
JRST TELC.2 ;YUP!!
AOBJN T1,TELC.1 ;NO, LOOP
MOVSI T2,[ASCIZ /Unexpected System Error/]
> ;END IFN FTUUOS
IFN FTJSYS,<
HRROI S1,J$XSFO(J) ;GET A SCRATCH BLOCK
MOVE S2,T3 ;GET THE ERROR CODE
HRLI S2,.FHSLF ;AND GET MY FORK HANDLE
MOVSI T1,-<<5*10>-1> ;LOAD -VE CHARACTERS TO STORE
ERSTR ;GET THE ERROR STRING
JFCL ;IGNORE ERROR 1
JFCL ;IGNORE ERROR 2
MOVSI T2,J$XSFO(J) ;LOAD 0,,ADR
> ;END IFN FTJSYS
TELC.2: MOVSS T2 ;GET ADR OF MESS IN RH
HRLI T2,(TELL) ;PUT IN THE OP-CODE
IOR T2,T4 ;PUT IN THE DESTINATION
XCT T2 ;TYPE IT OUT
MOVE T2,[TELL CRLF] ;SETUP TO TYPE CRLF
IOR T2,T4 ;TO THE RIGHT PEOPLE
XCT T2 ;DO IT
POPJ P, ;AND RETURN
;ERROR MESSAGE TABLES
;FORMAT OF TABLE IS XWD ADR-OF-STRING,ERROR-CODE
IFN FTUUOS,<
ERRTAB: XWD [ASCIZ /File Not Found/], ERFNF%
XWD [ASCIZ /No UFD on that Structure/], ERIPP%
XWD [ASCIZ /Protection Failure/], ERPRT%
XWD [ASCIZ /File Being Modified/], ERFBM%
XWD [ASCIZ /RIB or UFD Error/], ERTRN%
XWD [ASCIZ /No such device/], ERNSD%
XWD [ASCIZ /No Room or Quota Exceeded/], ERNRM%
XWD [ASCIZ /Structure is Write-locked/], ERWLK%
XWD [ASCIZ /SFD Not Found/], ERSNF%
XWD [ASCIZ /SFD Nesting too deep/], ERLVL%
ERTBLN==.-ERRTAB
> ;END IFN FTUUOS
SUBTTL SETREF - Setup reference name for file
;SETREF IS CALLED TO SETUP THE REFERENCE NAME FOR THE CURRENT FILE.
; THIS NAME IS PRIMARILY USED FOR THE HEADER PAGES.
;CALL:
; PUSHJ P,SETREF
; ALWAYS RETURN HERE
IFN FTUUOS,<
SETREF: SETZB S1,S2 ;CLEAR TWO REGS
DMOVEM S1,J$DRNM(J) ;AND CLEAR REF NAME
DMOVEM S1,J$DREX(J) ;CLEAR REF EXTENSION
MOVE S1,J$FWCL(J) ;GET FORMS WIDTH CLASS
MOVEM S1,J$DRBS(J) ;AND SAVE AS BLOCKSIZE FOR HEADER
SKIPN S1,.FPFR1(E) ;IS THERE A /REPORT?
JRST SETR.1 ;NO, CONTINUE
MOVE S2,.FPFR2(E) ;YES, GET THE SECOND HALF
MOVEM S1,J$DRNM(J) ;STORE FIRST HALF
MOVEM S2,J$DREX(J) ;AND SECOND HALF
POPJ P, ;AND RETURN
SETR.1: LOAD S1,.FPINF(E),FP.SPL ;GET SPOOL BIT
JUMPE S1,SETR.2 ;AND JUMP IF NOT SPOOLED
SKIPN S1,J$DUUO+.RBSPL(J) ;GET SPOOLED NAME
JRST SETR.2 ;NONE, USE REAL FILENAME
MOVEM S1,J$DRNM(J) ;STORE THE NAME
POPJ P, ;AND RETURN
SETR.2: MOVE S1,J$DUUO+.RBNAM(J) ;GET FILE NAME
MOVEM S1,J$DRNM(J) ;AND SAVE IT
HLLZ S1,J$DUUO+.RBEXT(J) ;AND THE EXTENSION
MOVEM S1,J$DREX(J) ;SAVE IT
POPJ P, ;AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
SETREF: SETZB S1,S2 ;CLEAR SOME REGS
DMOVEM S1,J$DRNM(J) ;CLEAR THE REF NAME
DMOVEM S1,J$DREX(J) ;CLEAR THE REF EXTENSION
MOVE S1,J$FWCL(J) ;START WITH THE WIDTH CLASS
MOVEM S1,J$DRBS(J) ;AS THE BLOCK SIZE
SKIPN S1,.FPFR1(E) ;IS THERE A /REPORT?
JRST SETR.1 ;NO, CONTINUE
MOVE S2,.FPFR2(E) ;YES, GET SECOND HALF
MOVEM S1,J$DRNM(J) ;SAVE THE FIRST HALF
MOVEM S2,J$DREX(J) ;SAVE THE SECOND HALF
POPJ P, ;AND RETURN
SETR.1: HRROI S1,J$DNAM(J) ;GET POINTER TO NAME BLOCK
MOVE S2,J$DJFN(J) ;GET THE JFN
MOVX T1,1B8 ;FILENAME ONLY
JFNS ;GET IT
LOAD S1,.FPINF(E),FP.SPL ;GET THE SPOOL BIT
JUMPN S1,SETR.4 ;AND JUMP IF SPOOLED
SETR.2: MOVE S1,[POINT 7,J$DNAM(J)] ;POINT TO FILENAME
MOVE S2,[POINT 6,J$DRNM(J)] ;AND SOME PLACE TO STORE IT
SETZ T1, ;AND CLEAR A COUNTER
SETR.3: ILDB T2,S1 ;GET A CHARACTER
JUMPE T2,SETR.7 ;JUMP TO GET EXTENSION
SUBI T2,40 ;CONVERT TO SIXBIT
IDPB T2,S2 ;AND DEPOSIT IT
CAIGE T1,10 ;GET 9 YET?
AOJA T1,SETR.3 ;NO, LOOP
JRST SETR.7 ;GO GET EXTENSION
;HERE ON A SPOOLED FILE
SETR.4: MOVE S1,[POINT 7,J$DNAM(J)] ;POINT TO THE NAME
MOVE S2,[POINT 6,J$DRNM(J)] ;AND A PLACE TO STORE IT
SETZ T1, ;AND CLEAR A COUNTER
SETR.5: ILDB T2,S1 ;GET A CHARACTER
CAIN T2,"-" ;GOT A DASH?
JRST SETR.6 ;YES, HAVE TO SKIP 3 OF THEM
JUMPE T2,SETR.2 ;END, GIVE FULL FILENAME
JRST SETR.5 ;LOOP
SETR.6: CAIE T1,2 ;GOT 3 DASHES YET?
AOJA T1,SETR.5 ;NO, KEEP LOOKING
SETZ T1, ;YES, CLEAR T1
JRST SETR.3 ;AND NOW PICK UP THE NAME
;"SETREF" IS CONTINUED ON THE NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
SETR.7: LOAD S1,.FPINF(E),FP.SPL ;SPOOLED FILE?
SKIPN J$DRNM(J) ;IS THE NAME NULL?
JUMPN S1,SETR.2 ;IF YES TO BOTH, GET SPOOLED NAME
HRROI S1,J$DNAM(J) ;POINT TO TEMP EXTENSION BLOCK
MOVE S2,J$DJFN(J) ;GET THE JFN
MOVX T1,1B11 ;EXTENSION ONLY
JFNS ;GET IT
MOVE S1,[POINT 7,J$DNAM(J)] ;ELSE, POINT TO EXTENSION
MOVE S2,[POINT 6,J$DREX(J)] ;AND A PLACE TO STORE IT
SETZ T1, ;AND CLEAR A COUNTER
SETR.8: ILDB T2,S1 ;GET A CHARACTER
JUMPE T2,SETR.9 ;END!!
SUBI T2,40 ;CONVERT TO 6BIT
IDPB T2,S2 ;AND STORE IT
CAIGE T1,7 ;GET 8 YET?
AOJA T1,SETR.8 ;NO, LOOP
SETR.9: SKIPN J$DRNM+1(J) ;.GT. 6 CHAR NAME?
SKIPE J$DREX+1(J) ;OR .GT. 6 CHAR EXT?
SKIPA ;YES, ADJUST THINGS A LITTLE
POPJ P, ;NO, JUST RETURN
DMOVE S1,J$DREX(J) ;YES, LOAD EXTENSION
LSHC S1,-6 ;SHIFT OVER SOME
DMOVEM S1,J$DREX(J) ;AND STORE IT
SOS J$DRBS(J) ;DECREMENT THE BLOCK SIZE
POPJ P, ;AND RETURN
> ;END IFN FTJSYS
SUBTTL Accounting Routines
; ACTBEG -- SETUP ACCOUNTING AT JOB-START
; ACTBFL -- DO PRE-FILE ACCOUNTING
; ACTEFL -- DO POST-FILE ACCOUNTING
; ACTEND -- FINISH ACCOUNTING AT JOB-END
; ACTERR -- HANDLE ACCOUNTING ERROR
TOPSEG ;THESE ARE IN THE HISEG
SUBTTL ACTBEG - Routine to setup accounting
;ACTBEG IS CALLED AT THE BEGINNING OF EACH JOB TO SETUP THE ACCOUNTING
; FOR THE JOB.
;
;CALL:
; PUSHJ P,ACTBEG
; ALWAYS RETURN HERE
IFN FTUUOS,<
ACTBEG: MOVSI S1,J$AFNC(J) ;GET ADR,,0
HRRI S1,J$AFNC+1(J) ;GET ADR,,ADR+1
SETZM J$AFNC(J) ;ZERO FIRST WORD OF ACCT BLOCK
BLT S1,J$AEND(J) ;ZERO THE REST
MOVEI T1,.FACT ;GET CORRECT DAEMON FUNCTION
MOVEM T1,J$AFNC(J) ;AND STORE IT
MOVNI T1,1 ;GET THIS JOB'S TTY NUMBER
GETLCH T1 ; ..
TXNE T1,GL.CTY ;CTY?
MOVNI T1,1 ;YES
GETLIN T2, ;SEE IF DETACHED
TLNN T2,-1 ; ..
MOVNI T1,2 ;YES. FLAG AS DETACHED
ANDI T1,7777 ;AND DOWN TO 12 BITS
LSH T1,6 ;AND PUT INTO BITS 18-29
PJOB T2, ;GET JOB NUMBER
HRL T1,T2 ;PUT INTO LH OF T1
IOR T1,[FCTHDR] ;OR IN FUNCTION AND LENGTH
MOVEM T1,J$AHED(J) ;AND STORE IN FACT BLOCK
MOVE S1,J$LDEV(J) ;GET THE PROCESSING DEVICE
MOVEM S1,J$ADEV(J) ;AND STORE IT
HRROI T1,.GTTIM ;GET THE RUNTIME
GETTAB T1, ; FROM THE MONITOR
SETZ T1, ;FAILED!!!
MOVNM T1,J$ARTM(J) ;-VE TO FACT BLOCK
HRROI T1,.GTKCT ;GET THE TOTAL KCT'S
GETTAB T1, ; FROM THE MONITOR
SETZ T1, ;FAILED!!!
MOVNM T1,J$ACTI(J) ;STORE -VE (SO ADDB WILL CAUSE SUB)
HRROI T1,.GTRCT ;BLOCKS READ
GETTAB T1, ; FROM THE MONITOR
SETZ T1, ;FAILED!!!
TLZ T1,777700 ;CLEAR INCR.
MOVNM T1,J$ADRD(J) ;STORE -VE IN BLOCK
HRROI T1,.GTWCT ;DISK WRITES
GETTAB T1, ;ASK THE MONITOR
SETZ T1, ;EGAD!! MUST BE LEVEL C
TLZ T1,777700 ;CLEAR INCREMENTAL
MOVNM T1,J$ADWT(J) ;STORE -VE FOR TESTQ
LOAD T1,.EQSEQ(J),EQ.SEQ ;GET THE SEQUENCE NUMBER
MOVEM T1,J$ASEQ(J) ;STORE IT
LOAD T1,.EQOWN(J) ;GET REQUEST DIRECTORY
MOVEM T1,J$APPN(J) ;AND STORE IT
POPJ P, ;AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
ACTBEG: MOVSI S1,J$AHED(J) ;GET FIRST ADR,,0
HRRI S1,J$AHED+1(J) ;MAKE A BLT POINTER
SETZM J$AHED(J) ;CLEAR THE FIRST WORD
BLT S1,J$AEND(J) ;AND ZERO THE BLOCK
GJINF ;GET JOB INFORMATION
DPB T1,[POINT 9,J$AHED(J),17] ;STORE JOB NUMBER
DPB T2,[POINT 9,J$AHED(J),26] ;STORE LINE NUMBER
MOVX S1,<401B8+J$ALEN> ;LOAD REST OF THE HEADER WORD
IORM S1,J$AHED(J) ;STORE IT
; LOAD S1,.EQDIR(J),DI.OWN ;GET OWNER
; MOVEM S1,J$ADIR(J) ;SAVE IN FACT BLOCK
GTAD ;GET DATE AND TIME
MOVEM S1,J$ADAT(J) ;AND SAVE IT
MOVX S1,.FHSLF ;GET FORK HANDLE
RUNTM ;GET RUNTIME IN MS
MOVNM S1,J$ARTM(J) ;AND STORE NEGATED
MOVE S1,J$LDEV(J) ;GET PROCESSING DEVICE
MOVEM S1,J$ADEV(J) ;SAVE IT
MOVE S1,.EQLM1(J) ;GET FORMS
MOVEM S1,J$AFRM(J) ;SAVE IT
POPJ P, ;RETURN
> ;END IFN FTJSYS
SUBTTL ACTBFL -- Do Pre-file Accounting
ACTBFL: POPJ P,
SUBTTL ACTEFL -- Do Post-file Accounting
ACTEFL: POPJ P,
SUBTTL ACTEND - Routine to do accounting at end-of-job
;ACTEND IS CALLED AT THE END OF A JOB TO DO THE NECESSARY ACCOUNTING
; FOR THE JOB.
;
;CALL:
; PUSHJ P,ACTEND
; ALWAYS RETURN HERE
IFN FTUUOS,<
ACTEND: HRROI T1,.GTTIM ;RUNTIME
GETTAB T1, ;GET FROM MONITOR
SETZ T1, ;FAILED???
ADDB T1,J$ARTM(J) ;ADD TO -VE START TIME
IMULI T1,^D1000 ;CONVERT TO MILLI-JIFFIES
IDIV T1,JIFSEC ;AND THEN TO MILLI-SECONDS
MOVEM T1,J$ARTM(J) ;AND STORE AGAIN
HRROI T1,.GTKCT ;GET THE NUMBER OF KCT'S
GETTAB T1, ; FROM THE MONITOR
SETZ T1, ;FAILED!!!
ADDB T1,J$ACTI(J) ;COMPUTE ELAPSED KCT'S
IMULI T1,144 ;CONVERT TO CENTI-JIFFIES
IDIV T1,JIFSEC ;CONVERT TO CENTI-SECONDS
MOVEM T1,J$ACTI(J) ;AND STORE
HRROI T1,.GTRCT ;GET THE NUMBER OF READS
GETTAB T1, ; FROM THE MONITOR
SETZ T1, ;FAILED...
TLZ T1,777700 ;CLEAR INCREMENTAL
ADDM T1,J$ADRD(J) ;GET ELAPSED READS
HRROI T1,.GTWCT ;GET THE NUMBER OF DISK WRITES
GETTAB T1, ; FROM THE MONITOR
SETZ T1, ;FAILED,,,
TLZ T1,777700 ;CLEAR INCREMENTAL
ADDM T1,J$ADWT(J) ;COMPUTE ELAPSED WRITES
HRROI T1,.GTLOC ;WHERE WE ARE
GETTAB T1, ;ASK THE MONITOR
SETZ T1, ;WE ARE LOST DON'T SWEAT
HRLZ T2,T1 ;SAVE OUR PLACE
MOVE T1,[%CNSER] ;APR SERIAL NUMBER (MASTER IF MORE
GETTAB T1, ; THAN ONE IN M/S)
SETZ T1, ;EGAD!!
HRR T2,T1 ;COPY APRSN
MOVSI T1,'LP ' ;QUEUE NAME
IOR T1,T2 ;MUSH TOGETHER
MOVEM T1,J$AQUE(J) ;SAVE FOR FACT ENTRIES
SKIPN ACTFLG ;CAN WE CALL THE DAEMON?
POPJ P, ;NO, RETURN
MOVSI N,14 ;GET THE BLOCK LENGTH IN LH
HRRI N,J$AFNC(J) ;AND THE ADDRSS IN RH
DAEMON N, ;ACTIVATE THE DAEMON
JFCL ;IGNORE THE ERROR
POPJ P, ;AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
ACTEND: MOVX S1,.FHSLF ;LOAD FORK HANDLE
RUNTM ;GET RUNTIME
ADDM S1,J$ARTM(J) ;STORE IT
SKIPN ACTFLG ;ARE WE DOING ACCT?
POPJ P, ;NO, RETURN
;EFACT STUFF
POPJ P, ;AND RETURN
> ;END IFN FTJSYS
SUBTTL COMMAND TABLES AND DISPATCHER
;FLAG BITS
BIT T2,IOACT, ;DISK FILE MUST BE OPEN
;COMMANDS
DEFINE NAMES,<
C EXIT,XITCOM,0
C MESSAGE,MESSGE,0
C STOP,STOP,0
C KILL,KILL,0
C FORMS,FRMCOM,0
C GO,GO,0
C ST,START,0
C START,START,0
C RESET,RESETC,0
C REQUEU,REQUE,0
C CURRENT,CURDEF,0
C CHKPNT,TAKCHK,IOACT
C PAUSE,PAUSE,0
C LOCK,SETLOK,0
C UNLOCK,CLRLOK,0
C WHAT,WHAT,0
C MLIMIT,MLIMIT,0
C LIMIT,LIMIT,0
C NEXT,NXTCOM,0
C HELP,HELP,0
C FREEZE,FREEZE,0
C UNFREE,UNFREE,0
C REPRIN,REPRNT,IOACT
C SKPFIL,SKPFIL,IOACT
C SKPCOP,SKPCOP,IOACT
C SUPPRE,SUPPRE,IOACT
C NOSUPP,NOSUPR,IOACT
C BACKSP,BACKSP,IOACT
C FORWAR,FORWAR,IOACT
IFN FTUUOS,<
C ALIGN,ALIGN,0
> ;END IFN FTUUOS
> ;END OF NAMES MACRO
;TABLES
DEFINE C(A,B,C),<
XALL
<SIXBIT /A/>
SALL
>
TOPSEG
COMTAB: NAMES
DEFINE C(A,B,D),<
EXP D+B
>
DSPTAB: NAMES
DISPL=.-DSPTAB
SALL ;BACK TO SHORT FORM
UUMASK==TELOPR!TELUSR!TELUSR!TNOACT ;UUO BITS
;ALL IN THE LH
;HERE WHEN A COMMAND HAS BEEN TYPED
COMIN: PUSHJ P,SETNL ;SETUP FOR A NEW LINE
MOVX T1,UUMASK ;BITS TO SAVE AROUND COMMAND
AND T1,S ;EXTRACT THE BITS
TXZ S,UUMASK ;CLEAR THE BITS
MOVEM T1,UUSAVE# ;SAVE THEM.
PUSHJ P,SIXIN ;GET COMMAND
PJRST CUE ;NULL COMMAND
CAMN T1,['MONITO'] ;EMERGENCY EXIT?
JRST DOEXIT ;YES, DO IT
MOVE T2,T1 ;COPY COMMAND
SETO T3, ;SET MASK TO ONES
LSH T3,-6 ;SHIFT MASK
LSH T2,6 ;SHIFT OFF 1 CHAR
JUMPN T2,.-2 ;ANYTHING LEFT?
MOVEI N,0 ;CLEAR FLAGS
MOVSI T2,-DISPL ;SET UP LENGTH OF TABLE
COMLP: MOVE T4,COMTAB(T2) ;GET A COMMAND
CAMN T4,T1 ;AN EXACT MATCH?
JRST COMFND ;YES. THIS IS IT
TDZ T4,T3 ;CLEAR PART NOT TYPED
CAME T4,T1 ;PARTIAL MATCH
JRST COMNEQ ;NO. TRY NEXT
TLOE N,1 ;FIRST OCCURENCE
JRST NOCOM ;NO. CAN'T BE UNIQUE
HRR N,T2 ;YES. SAVE INDEX
COMNEQ: AOBJN T2,COMLP ;ANY MORE COMMANDS
TLNN N,-1 ;NO. EXACTLY 1 MATCH?
JRST NOCOM ;NO, LOSE!
HRR T2,N ;YES, COPY INDEX
COMFND: MOVE T2,DSPTAB(T2) ;GET ADDRESS AND BITS
COMCK2: TXNN T2,IOACT ;DO WE HAVE TO BE IOACTIVE?
JRST COMCK3 ;NO, GO ON
TXNN S,DSKOPN ;YES, ARE WE?
JRST CMSG2C ;NO, GIVE A MESSAGE
COMCK3: PUSHJ P,(T2) ;DISPATCH THE COMMAND
JRST CUE ;WAKE UP THE OPERATOR
NOCOM: TELL OPR,%%URC ;NOT UNIQUE
PJRST CUE ;RETURN
CMSG2C: PUSHJ P,NOTBSY ;TELL HIM WE'RE NOT BUSY
CUE: PUSHJ P,EAT ;EAT THE REST OF THE LINE
TXNE S,RUNB ;IF RUN IS ON
TELL OPR,EXCLPT ; TYPE A !
TXNN S,RUNB ;IF RUN IS OFF
TELL OPR,STAR ; TYPE A *
TDZ S,[UUMASK] ;CLEAR SAVED BITS
IOR S,UUSAVE ;PUT BACK ANY NEEDED
TXNN S,RUNB ;ARE WE RUNNABLE?
JRST COMIN ;NO, GET NEXT COMMAND
POPJ P,
NOTBSY: MOVEI T1,%%LII ;WE ARE IDLE
TXNN S,STARTD ;BUT IF WE'RE NOT STARTED,
MOVEI T1,%%WFS ;TELL HIM THAT INSTEAD
TELL OPR,(T1) ;GIVE SOME MESSAGE
POPJ P, ;AND RETURN
SUBTTL Operator Commands -- START
;SUBROUTINE TO SELECT OUTPUT DEVICE AND START SPOOLER
;CALL WITH
; PUSHJ P,START
; RETURN HERE
;
START: TXNN S,STARTD ;HAVE WE BEEN STARTED ALREADY?
JRST STAR.3 ;NO, CONTINUE
SKIPN XITFLG ;IS THERE A PENDING EXIT?
SKIPE RSTFLG ;OR A PENDING RESET?
JRST STAR.1 ;YES, CLEAR IT
TXZN S,PAUSEB ;NO, PENDING PAUSE?
JRST STAR.2 ;NO, GIVE AN ERROR
STAR.1: TELL OPR,%%CPC ;TELL HIM
SETZM XITFLG ;CLEAR EXIT
SETZM RSTFLG ;AND RESET
POPJ P, ;AND RETURN
STAR.2: TELL OPR,%%LAS ;TELL HIM
POPJ P, ;AND RETURN
STAR.3: PUSHJ P,SIXIN ;GET A DEVICE NAME
MOVX T1,DEFLPT ;USE THE DEFAULT
MOVEM T1,J$LGNM(J) ;SAVE AS GIVEN NAME
PUSHJ P,OUTGET ;OPEN THE DEVICE
STAR.4: CAIE C,"=" ;DID HE SAY DEV=DEV?
JRST STAR.5 ;NO SCAN AHEAD
PUSHJ P,SIXIN ;YES, GET THE DEVICE
MOVSI T1,'LPT' ;DEFAULT DEVICE
MOVEM T1,J$LSDV(J) ;STORE IT
JRST STAR.6 ;AND CONTINUE
STAR.5: PUSHJ P,SIXIN ;SCAN AHEAD
JFCL ;THAT'S OK
CAIN C,"=" ;FIND AN EQUAL?
JRST STAR.4 ;YES, LOOP AROUND
STAR.6: HLRZ T1,J$LSDV(J) ;GET SCHEDULING DEVICE
CAIN T1,'LPT' ;IS IT A LPT?
JRST STAR.7 ;YES, CONTINUE
PUSHJ P,EAT ;CLEAR TYPE AHEAD
TELL OPR,[ASCIZ /Specified device is not a LPT
What device do you want to schedule jobs for: /]
PUSHJ P,SETNL ;SET NEW LINE
PUSHJ P,SIXIN ;AND GET A DEVICE
JFCL ;IGNORE THIS
MOVEM T1,J$LSDV(J) ;STORE IT
JRST STAR.6 ;AND LOOP
STAR.7: PUSHJ P,EAT ;EAT THE REST OF THE LINE
ON S,STARTD!RUNB ;FLAG THAT WE ARE STARTED
PUSHJ P,SETHEL ;SETUP HELLO BLOCK
MOVEI T1,MSGBLK ;LOAD ADR OF BLOCK
PJRST SNDQSR## ;AND SEND IT
SUBTTL Operator Commands -- ALIGN
IFN FTUUOS,<
;SUBROUTINE TO ALLOW FORMS TO BE SET UP
;CALL WITH:
; PUSHJ P,ALIGN
; HERE WHEN DONE
;
ALIGN: TXNN S,STARTD ;HAVE WE BEEN STARTED
JRST [TELL OPR,%%WFS ;NO TELL HIM
POPJ P,] ;AND RETURN
ALIGN1: PUSHJ P,SIXIN ;GET FILENAME
MOVE T1,J$FALI(J) ;USE DEFAULT
MOVE P1,T1 ;SETUP FOR LOOKUP
MOVSI P2,'ALP' ;EXTENSION .ALP
CLEARB P3,P4 ;...
SETZ T1, ;ASCII MODE
MOVEI T3,J$ABRH(J) ;BUFFERS FOR ALIGN
MOVSI T2,'DSK' ;TRY DSK FIRST
ALOPN: OPEN ALP,T1 ;INIT THE DEVICE
HALT . ;???
LOOKUP ALP,P1 ;LOOK FOR FILE
SKIPA ;SKIP IF LOOKUP FAILED
JRST ALGOT ;GOT IT!!
CAMN T2,[SIXBIT /SYS/] ;DID WE LOOK ON SYS?
JRST [MOVE T1,P1 ;GET FILE NAME
TELL OPR,%%CFA
POPJ P,] ;GUESS WE CAN'T FIND IT
MOVSI T2,'SYS' ;NO, TRY SYS
JRST ALOPN ;AND LOOP
ALGOT: PUSHJ P,M$ACQP## ;GET A PAGE
MOVEM AP,J$APAG(J) ;SAVE PAGE NUMBER
PG2ADR AP ;MAKE AN ADDRESS
EXCH AP,.JBFF ;SAVE AS JOBFF
INBUF ALP,2 ;ALLOCATE BUFFERS
MOVEM AP,.JBFF ;RESTORE JOBFF
OUTPUT LPT, ;CLEAN UP
TELL OPR,STAR ;TELL THE OP TO DO SOMETHING
MOVE T1,J$FALC(J) ;GET LOOP COUNTER
ALNXT: SOSGE T1 ;COUNT DOWN
JRST ALDIE ;DONE, RETURN
USETI ALP,1 ;REWIND THE FILE
SKPINL ;ANYTHING THERE?
JRST ALOOP ;NO, PRINT FILE AGAIN
JRST ALDIE ;YES, THAT'S ALL
ALOOP: SOSLE J$ABCT(J) ;ROOM IN BUFFERS
JRST ALDB ;YES--SHOVE IT
IN ALP, ;READ SOME FILE
JRST ALDB ;NO ERRORS, CONTINUE
STATO ALP,IO.EOF ;IS IT END OF FILE?
JRST ALDIE ;NO, STOP
OUTPUT LPT, ;DUMP THE PARTIAL BUFFER
MOVE T2,J$FALS(J) ;YES, GET SLEEP TIME
SLEEP T2, ;SLEEP
JFCL
JRST ALNXT ;LOOP
ALDB: ILDB C,J$ABPT(J) ;GET THE CHAR
PUSHJ P,DEVOUT ;PRINT THE CHAR
JRST ALOOP ;NOT SAVED
ALDIE: RELEAS ALP, ;GIVE UP THE DISK
MOVE AP,J$APAG(J) ;GET THE PAGE NUMBER BACK
PUSHJ P,M$RELP## ;RELEAS IT
POPJ P, ;AND RETURN
> ;END IFN FTUUOS
SUBTTL Operator Commands -- HELP - MLIMIT
;SUBROUTINE TO TYPE THE HELP TEXT
;CALL WITH:
; PUSHJ P,HELP
; RETURN HERE
;
HELP: TELL OPR,[ASCIZ /
Available Commands Are:
/]
PUSHJ P,.SAVE2## ;SAVE P1 AND P2
MOVSI P1,-DISPL ;SETUP AOBJN POINTER
SETZ P2, ;AND COMMAND COUNTER IS CLEAR
HELP.1: MOVEI C,.CHTAB ;LOAD A TAB
SKIPE P2 ;FIRST COMMAND OF A LINE?
PUSHJ P,SEND ;NO, TYPE THE COMMA
MOVE T1,COMTAB(P1) ;GET THE COMMAND
CAMN T1,[SIXBIT /ST/]
MOVE T1,[SIXBIT /MONITO/]
PUSHJ P,SIXOUT ;TYPE IT
CAIGE P2,6 ;TYPED SEVEN?
AOJA P2,HELP.2 ;NO, KEEP GOING
TELL OPR,CRLF ;YES, TYPE A CRLF
SETZ P2, ;CLEAR THE COUNTER
HELP.2: AOBJN P1,HELP.1 ;AND LOOP
TELL OPR,CRLF ;AND A FINAL CRLF
POPJ P, ;RETURN WHEN DONE
;SUBROUTINE TO SET MAX OUTPUT LIMIT FOR ALL JOBS
; ANY JOB OVER LIMIT WILL SIT IN QUEUE.
;CALL WITH:
; PUSHJ P,MLIMIT
; RETURN HERE
;
MLIMIT: PUSHJ P,DECARG ;GET N
JRST BADNBR ;BAD NUMBER
JUMPE N,LIMERR ;CAN'T BE ZERO
MOVEM N,J$XMLM(J) ;STORE AWAY
PJRST SNDSTC ;SEND A STATUS CHANGE AND RETURN
SUBTTL Operator Commands -- EXIT
;SUBROUTINE TO EXIT FROM SPOOLER
;CALL WITH:
; PUSHJ P,XITCOM
; RETURN ONLY IF ERROR
;
XITCOM: SETOM XITFLG ;SET THE EXIT FLAG
TXNN S,BUSY ;ARE WE BUSY?
JRST DOEXIT ;NO, GO EXIT
TELL OPR,%%LWE ;YES, MAKE IT PEND
POPJ P, ;TELL OPR AND RETURN
DOEXIT: PUSHJ P,SETHEL ;SETUP HELLO BLOCK
MOVX T1,HELBYE!HELSTC;GOODBYE+STATUS CHANGE
IORM T1,MSGBLK+HEL.ST ;STORE THEM
MOVEI T1,MSGBLK ;ADDRESS OF BLOCK
PUSHJ P,SNDQSR## ;SEND IT
RESET ;CLEAR ALL DEVICE PROBLEMS
IFN FTUUOS,<
EXIT ;AND BACK TO MONITOR
> ;END IFN FTUUOS
IFN FTJSYS,<
HALTF ;AND BACK TO MONITOR
> ;END IFN FTJSYS
SUBTTL Operator Commands -- LIMIT
;SUBROUTINE TO CHANGE LIMIT FOR THIS JOB ONLY
;CALL WITH:
; PUSHJ P,LIMIT
; RETURN HERE
;
LIMIT: TXNN S,BUSY ;ARE WE BUSY?
PJRST NOTBSY ;NO, TELL HIM AND RETURN
PUSHJ P,DECARG ;GET ARGUMENT
JRST BADNBR ;OOPS
JUMPE N,LIMERR ;CAN'T BE ZERO
MOVEM N,J$RLIM(J) ;STORE
STAMP LPOPR ;STAMP THE LOG
TELL LOG,%%OCL ;AND TELL THE LOG FILE
POPJ P,
LIMERR: TELL OPR,%%ICA ;ILLEGAL COMMAND ARGUMENT
POPJ P,
BADNBR: TELL OPR,BADNMS
POPJ P,
SUBTTL Operator Commands -- FORMS
;SUBROUTINE TO DECLARE A NEW TYPE OF FORMS TO BE MOUNTED
;CALL FROM COMAND DISPATCH
;
FRMCOM: PUSHJ P,SIXIN ;GET SPECIFIED TYPE
MOVX T1,FRMNOR ;USE NORMAL BY DEFAULT
TXNN S,STARTD ;IS LPTSPL STARTED?
JRST FRMC.1 ;NO, JUST SAVE FORMS AND RETURN
MOVEM T1,J$FSFM(J) ;SAVE AS SCHED TYPE
PUSHJ P,SNDSTC ;TELL QUASAR
PJRST OPNFRM ;RE-READ LPFORM.INI AND RETURN
FRMC.1: MOVEM T1,J$FORM(J) ;STORE FORMS TYPE
MOVEM T1,J$FSFM(J) ;AND SCHED FORMS TYPE
POPJ P, ;AND RETURN
SUBTTL Operator Commands -- KILL
;SUBROUTINE TO KILL THE CURRENT JOB
;
;CALL KILL - ON OPERATOR KILL MESSAGE
; UKILL - ON ABORT MESSAGE FROM USER
KILL: SKIPA P1,[EXP OPRKIL] ;LOAD ADR OF ROUTINE AND SKIP
UKILL: MOVEI P1,USRKIL ;LOAD ADDRESS
TXNN S,BUSY ;ARE WE DOING A JOB?
PJRST NOTBSY ;NO, TELL HIM AND RETURN
TXNN S,MNTBIT ;NO, ARE WE IN MOUNT WAIT?
JRST KILL2 ;NO, JUST DO THE REGULAR THINGS
MOVE T1,J$FPFM(J) ;YES, GET PREVIOUS FORMS TYPE
MOVEM T1,J$FORM(J) ;SAVE A CURRENT FORMS
MOVEM T1,J$FSFM(J) ;SAVE AS SCHEDULING FORMS
PUSHJ P,SNDSTC ;AND TELL QUASAR
PUSHJ P,FRMINI ;INITIALIZE FORMS PARAMTERS
KILL2: TXNE S,DSKOPN ;ARE WE PRINTING A FILE?
PUSHJ P,OUTFLS ;YES, FLUSH ALL OUTPUT
PUSHJ P,(P1) ;CALL TYPE DEPENDENT ROUTINE
KILL3: OFF S,FFSEEN ;TURN OFF FF FLAG
PUSHJ P,SETEOF ;CAUSE AN EOF TO HAPPEN
ON S,ABORT ;AND SET ABORT BIT
JRST GO ;GO!
;HERE FOR OPERATOR KILL STUFF
OPRKIL: TXNN S,BANDUN ;HAVE WE PRINTED A BANNER?
PUSHJ P,JOBHDR ;NO, DO SO
STAMP LPOPR ;STAMP THE LOG
TELL LOG,%%KBO ;PUT IN A MESSAGE
POPJ P, ;AND RETURN
;HERE FOR USER KILL STUFF
USRKIL: MOVE S1,MESSAG ;GET ADDRESS OF MESSAGE
MOVE T1,ABO.CD(S1) ;GET ABORT CODE
CAIN T1,ABOOPR ;ABORT BY OPR?
JRST OPRKIL ;YES, SWITCH GEARS
STAMP LPMSG ;STAMP THE LOG
TELL LOG,%%CBU ;KILLED BY USER
MOVE T1,ABO.ID(S1) ;GET ID OF KILLER
PUSHJ P,TYPUID ;TYPE IT ON THE LOG
TELL LOG,CRLF ;PLACE A CRLF
POPJ P, ;AND RETURN
SUBTTL Operator Commands -- PAUSE - STOP - GO
PAUSE: TXNE S,BUSY ;PAUSE=STOP IFN BUSY
TXOA S,PAUSEB ;SET PAUSE BIT AND SKIP
STOP: OFF S,RUNB ;TURN OFF THE RUN BIT
PJRST SNDSTC ;STOP SCHEDULING AND RETURN
GO: TXNE S,STARTD
ON S,RUNB
OFF S,PAUSEB!MNTBIT
PJRST SNDSTC ;START SCHEDULING AGAIN
;HERE AT END-OF-JOB WHEN WE MUST PAUSE
DOPAUS: TELL OPR,[ASCIZ /Spooler is PAUSE'ing ON $, type GO to continue
/]
JRST STOP ;AND GO STOP
SUBTTL Operator Commands -- REPRINT - SKPCOPY - SKPFILE
;REPRINT -- ROUTINE TO START THE CURRENT COPY OF THE CURRENT
; FILE OVER AGAIN.
;CALL WITH:
; PUSHJ P,REPRNT
; RETURN HERE
;
REPRNT: PUSHJ P,OUTFLS ;FLUSH OUTPUT
AOS J$XCOP(J) ;INCREMENT COPY COUNT
STAMP LPOPR ;STAMP THE LOG
MOVE N,J$RNCP(J) ;GET COPY-1
ADDI N,1 ;GET COPY #
TELL LOG,%%ORC ;AND A MESSAGE
MOVN T1,J$RNPP(J) ;GET -VE PAGES PRINTED THIS COPY
ADDM T1,J$APRT(J) ;AND DECREMENT THE TOTAL PRINTED
SOS J$RNCP(J) ;AND DECREMENT COPIES PRINTED
JRST SKPCP1 ;AND MAKE AN END-OF-FILE
;SKPCOP -- ROUTINE TO START THE NEXT COPY OF THE CURRENT FILE
;CALL WITH:
; PUSHJ P,SKPCOP
; RETURN HERE
;
SKPCOP: PUSHJ P,OUTFLS ;FLUSH OUTPUT
STAMP LPOPR ;STAMP THE LOG
MOVE N,J$RNCP(J) ;GET COPY NUMBER-1
ADDI N,1 ;MAKE IT COPY NUMBER
TELL LOG,%%OSC ;AND TELL HIM
SKPCP1: PUSHJ P,SETEOF ;CAUSE AN EOF TO HAPPEN
POPJ P, ;AND RETURN
;SKPFIL -- ROUTINE TO START THE NEXT FILE
;CALL WITH:
; PUSHJ P,SKPFIL
; RETURN HERE
;
SKPFIL: PUSHJ P,OUTFLS ;FLUSH OUTPUT
STAMP LPOPR ;STAMP THE LOG
TELL LOG,%%OSF ;AND TELL HIM
PUSHJ P,SETEOF ;CAUSE AN EOF
SETZM J$XCOP(J) ;CAUSE END OF COPIES LOOP
POPJ P, ;AND RETURN
SUBTTL Operator Commands -- (UN)LOCK - (UN)FREEZE
;SUBROUTINES TO SET OR CLEAR BOTH PAUSE AND PAUSE LOCK
;CALL WITH:
; PUSHJ P,SETLOK (CLRLOK)
; RETURN HERE
;
SETLOK: TXOA S,PLOCK ;SET THE LOCK
CLRLOK: TXZ S,PLOCK ;CLEAR THE LOCK
POPJ P, ;AND RETURN
;SUBROUTINES TO SET AND CLEAR FORMS LOCK. CALLED ON THE FREEZE AND
;UNFREEZE COMMANDS.
;CALL WITH
; PUSHJ P,FREEZE (OR UNFREE)
; RETURN HERE
;
FREEZE: TXOA S,FROZE ;TURN ON FROZE BIT
UNFREE: OFF S,FROZE ;TURN OFF FROZE BIT
PJRST SNDSTC ;SEND A STATUS CHANGE AND RETURN
SUBTTL Operator Commands -- NEXT
;SUBROUTINE TO FORCE JOB #N TO BE RUN NEXT
;CALL WITH:
; PUSHJ P,NXTCOM
; RETURN HERE
;
NXTCOM: PUSHJ P,DECARG ;READ A DECIMAL ARGUMENT
PJRST BADNBR ;OOPS...
MOVEM N,NXTJOB ;SAVE FOR LATER
PJRST SNDSTC ;AND SEND A STATUS CHANGE
SUBTTL Operator Commands -- REQUEUE
;SUBROUTINE TO REQUEUE AN ENTRY
;CALL WITH:
; PUSHJ P,REQUE
;
REQUE: TXNN S,BUSY ;ARE WE BUSY?
PJRST NOTBSY ;NO, RETURN
TXZN S,MNTBIT ;ARE WE IN MOUNT WAIT?
JRST REQUE0 ;NO, SKIP THIS STUFF
MOVE T1,J$FPFM(J) ;YES, LOAD OLD FORMS
MOVEM T1,J$FORM(J) ;AND STORE
MOVEM T1,J$FSFM(J) ;SAVE AS SCHEDULING FORMS
ON S,RQB!RUNB ;TURN ON REQUE AND RUN
PUSHJ P,SNDSTC ;AND SEND A STATUS CHANGE
PUSHJ P,FRMINI ;AND INITALIZE PARAMETERS
REQUE0: PUSHJ P,SETCHP ;SETUP CHECKPOINT INFO
MOVEI T1,5 ;/AFTER:5 IS DEFAULT
MOVEM T1,MSGBLK+REQ.AF ;STORE IT
MOVX T1,CKFREQ ;GET REQUEUE BIT
MOVEM T1,MSGBLK+REQ.IN+CKFLG ;STORE IT
REQUE1: PUSHJ P,DOSW ;SCAN FOR A /
TXNE S,TTYBRK ;HIT EOL?
JRST REQUE2 ;YES, DONE
ACTCHR A,RQAFT ;AFTER
ACTCHR H,RQHOLD ;HOLD
ACTCHR T,RQTOP ;TOP OF JOB
ACTCHR B,RQBACK ;BACK N UNITS
ACTCHR F,RQFOR ;FORWARD N UNITS
TELL OPR,BADSW ;BAD SWITCH
POPJ P, ;PUNT THE COMMAND
RQHOLD: MOVEI T1,^D720 ;12 HOURS (720 MINUTES)
MOVEM T1,MSGBLK+REQ.AF ;NEW AFTER PARAM
JRST REQUE1 ;DO NEXT SWITCH
RQBACK: PUSHJ P,GTARGU ;GET ARGUMENT
MOVN N,N ;BACK
SKIPA ;THE REST IS LIKE /FORWARD
RQFOR: PUSHJ P,GTARGU ;GET THE ARGUMENT
ADDM N,MSGBLK+REQ.IN+CKPAG ;ADD TO CURRENT POSITION
JRST REQUE1 ;AND LOOP
RQAFT: PUSHJ P,FNDELM ;GET THE DELIMITER
SKIPA ;NONE
PUSHJ P,DECARG ;GET THE NUMBER
MOVEI N,^D30 ;ASSUME 30 MIN.
MOVEM N,MSGBLK+REQ.AF ;STORE AWAY
JRST REQUE1 ;LOOP FOR MORE COMPLEX STUFF
RQTOP: SETZM MSGBLK+REQ.IN+CKFIL ;CLEAR THE FILE WORD
SETZM MSGBLK+REQ.IN+CKCOP ;CLEAR THE COPIES WORD
SETZM MSGBLK+REQ.IN+CKPAG ;CLEAR THE PAGES WORD
SETZM MSGBLK+REQ.IN+CKTPP ;CLEAR THE TOTAL PAGES WORD
JRST REQUE1 ;LOOK FOR MORE SWITCHES
REQUE2: PUSHJ P,RIDLOG ;RELEASE THE LOG FILE
STAMP LPOPR ;TELL USER WHAT OPR DID
TELL LOG,%%RBO ;SEND THE REQUEUE MESSAGE
MOVX T1,<REQ.SZ,,.QOREQ> ;GET MESSAGE HEADER
MOVEM T1,MSGBLK ;STORE IT
MOVEI T1,MSGBLK ;ADR OF REQUEUE BLOCK
PUSHJ P,SNDQSR## ;SEND IT TO QUASAR
PUSHJ P,CLSFIL ;AND CLOSE INPUT FILE
PUSHJ P,EAT ;EAT TILL EOL
TELL OPR,EXCLPT ;AND GIVE OPR THE PROMPT
JRST ENDJOB ;AND GO FINISH UP
GTARGU: PUSHJ P,FNDELM ;GET HTE DELIMITER
JFCL ;NONE DON'T SWEAT
PUSHJ P,DECARG ;GET A DECNAL NUMBER
JFCL ;LOSS DO NOT WORRY
POPJ P, ;RETURN
SUBTTL Operator Commands -- WHAT
;SUBROUTINE TO GIVE CURRENT STATUS OF SPOOLER
WHAT: TXNN S,STARTD ;ARE WE STARTED?
PJRST CURINF ;NO, JUST GIVE USEFUL INFO
TXNN S,BUSY ;DO WE HAVE A JOB?
JRST WHATC ;NO, SKIP ALLLLLLL OF THIS
WHATA: LOAD T1,.EQJOB(J) ;GET JOB NAME
LOAD N,.EQSEQ(J),EQ.SEQ ;AND SEQUENCE NUMBER
TELL OPR,[ASCIZ \$:+/SEQ:#/USER:] \]
MOVE N,J$APRT(J) ;GET AMOUNT PRINTED
TELL OPR,WHAT6 ;AND TYPE AMOUNT PRINTED
MOVE N,J$RLIM(J) ;GET LIMIT
TELL OPR,WHAT7 ;AND TYPE IT
TXNN S,DSKOPN ;IS A FILE OPEN?
JRST WHATB ;NO, SKIP THIS STUFF
TELL OPR,WHAT10 ;TYPE THE FILE NAME
LOAD T2,.FPINF(E),FP.DEL ;GET THE DISPOSITION
MOVX T1,'PRESER' ;ASSUME PRESERVED
SKIPE T2 ;SKIP IF PRESERVED
MOVX T1,'DELETE' ;NO, DELETE
LOAD T2,.FPINF(E),FP.SPL ;GET SPOOL BIT
SKIPE T2 ;IS IT SET?
MOVX T1,'SPOOL ' ;YES, TELL HIM
TELL OPR,WHAT11 ;AND PRINT IT
TXNE S,SUPRES ;ARE WE SUPPRESSED?
TELL OPR,[ASCIZ ?/SUPPRESS?]
MOVE N,J$RNCP(J) ;GET NUMBER OF COPIES PRINTED
AOS N ;GET CURRENT COPY NUMBER
TELL OPR,WHAT8 ;AND PRINT IT
LOAD N,.FPINF(E),FP.FCY ;GET TOTAL NUMBER OF COPIES
TELL OPR,WHAT9 ;PRINT IT
MOVE N,J$RNPP(J) ;GET NUMBER OF PAGES PRINTED
TELL OPR,WHAT12 ;AND TEEL THE OPERATOR
WHATB: SKIPN T1,.EQNOT(J) ;IS THERE A USER NOTE?
JRST WHATC ;NO, CONTINUE ON
TELL OPR,[ASCIZ /![User note: +/]
MOVE T1,.EQNOT+1(J) ;GET THE SECOND HALF
TELL OPR,[ASCIZ /+!]
/]
WHATC: TXNN S,BUSY ;ARE WE BUSY?
TELL OPR,%%LII ;NO, TELL HIM
MOVE T1,J$FORM(J) ;LOAD THE FORMS TYPE
TXNE S,MNTBIT ;ARE WE IN MOUNT WAIT?
TELL OPR,%%WFF ;YES, TELL HIM
PJRST CURINF ;AND GIVE THE REST OF CURRENT INFO
SUBTTL Operator Commands -- CURRENT
;SUBROUTINE TO GIVE THE CURRENT DEFAULTS
CURDEF: MOVE N,J$XMLM(J) ;PICK UP MLIMIT
TELL OPR,CURMS1 ;GIVE THE FIRST MESSAGE
TELL OPR,[ASCIZ /Messages on:/]
SKIPE T1,MSGJOB ;JOB?
TELL OPR,[ASCIZ / JOB/]
SKIPE T2,MSGFIL ;FILE?
TELL OPR,[ASCIZ / FILE/]
SKIPE T3,MSGERR ;ERRORS?
TELL OPR,[ASCIZ / ERRORS/]
ADD T1,T2 ;COMBINE JOB+FILE
ADD T1,T3 ;ADD IN ERROR
SKIPN T1 ;ANY OF THE ABOVE?
TELL OPR,[ASCIZ / No Conditions/]
TELL OPR,CRLF ;AND AN EOL
SKIPE N,NXTJOB ;GET NEXT-JOB
TELL OPR,CURMS2 ;TELL HIM
MOVE T1,J$FORM(J) ;GET CURRENT FORMS TYPE
TXNE S,MNTBIT ;ARE WE WAITING FOR MOUNT?
MOVE T1,J$FPFM(J) ;YES, USE PREVIOUS TYPE
MOVEI T2,%%TFM ;LOAD FORMS MOUNTED MESSAGE
TXNE S,FROZE ;ARE WE FROZEN?
MOVEI T2,%%FAF ;YES, GET FROZEN MESSAGE
TELL OPR,(T2) ;AND TYPE A MESSAGE
MOVE T1,J$FSFM(J) ;TYPE OF FORM QUASAR BELIEVES IN
CAME T1,J$FORM(J) ;IS IT THE TYPE MOUNTED?
TELL OPR,%%FHB ;NO, TELL HIM
SKIPE J$FNOT(J) ;IS THERE A NOTE?
TELLN OPR,@J$FNOT(J) ;YES, TYPE IT
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
CURINF: TXNE S,STARTD ;ARE WE STARTED?
JRST CURD.1 ;YES, CONTINUE
TELL OPR,%%WFS ;NO, TELL HIM
POPJ P, ;AND RETURN
CURD.1: TXNN S,RUNB ;ARE WE RUNNING?
TELL OPR,%%SIS ;NO, TELL HIM
CURD.3: SKIPE XITFLG ;WILL WE EXIT
TELL OPR,%%LWE ;YES, TELL HIM
CURD.4: SKIPE RSTFLG ;WILL WE RESET?
TELL OPR,%%LWR ;YES, TELL HIM
CURD.5: TXNE S,PAUSEB!PLOCK ;WILL WE PAUSE?
TELL OPR,%%LWP ;YES
CURD.7: SKIPE J$LHNG(J) ;IS THE LPT HUNG?
TELL OPR,%%DOL ;YES, TELL HIM
POPJ P, ;RETURN
SUBTTL Operator Commands -- BACKSPACE
;(NOTE: ENTER AT "IBACK" WITH N CONTAINING NUMBER OF PAGES)
BACKSP: TXNE S,NOTYPE ;IS BACK OR FORWARD IN PROGRESS?
JRST BFINPR ;YES, GIVE AN ERROR
PUSHJ P,DECARG ;GET THE ARGUMENT
POPJ P, ;ZERO OR ILLEGAL
BACK.1: CAMLE N,J$RNPP(J) ;BACKING UP PAST BEGINNING?
MOVE N,J$RNPP(J) ;YES, MAKE IT A REWIND
STAMP LPOPR ;STAMP THE MESSAGE
TELL LOG,%%BSF ;PUT MESSAGE IN THE LOG
IFN FTUUOS,<
CAIG N,TABSIZ ;IS BACK-SKIP WITHIN TABLE?
JRST BSPCF ;YES, TRY FOR FAST BACKSPACE
> ;END IFN FTUUOS
BACKS1: PUSHJ P,REWIND ;REWIND THE FILE
MOVNS N ;GET NEGATIVE PAGES TO SKIP
ADD N,J$RNPP(J) ;ADD TO CURRENT PAGE = DESTINATION PAGE
SETZM J$RNPP(J) ;SET CURRENT PAGE TO 0
SOJG N,FORWD1 ;AND SKIP THE PAGES IF GT 1
POPJ P, ;AND RETURN
;ENTER HERE FOR INTERNAL BACKSPACE CALL WITH N CONTAINING THE NUMBER OF PAGES
IBACK: JRST BACK.1 ;JUMP INTO MIDDLE OF ROUTINE
BFINPR: TELL OPR,WHATB7 ;BACKSPACE OR FORWARD IN PRGRESS
POPJ P, ;RETURN
IFN FTUUOS,<
;HERE IS ACTUAL "FAST BACKSPACE" CODE
BSPCF: MOVN T1,N ;GET NEGATIVE ARGUMENT
ADD T1,J$RNPP(J) ;GET DESTINATION PAGE
CAIG T1,1 ;ARE WE JUST DOING A REWIND?
JRST BACKS1 ;YES, USE REGULAR CODE
IDIVI T1,TABSIZ ;DIVIDE BY SIZE OF TABLE
MOVE T1,T2 ;SAVE THE INDEX IN T1
ADD T2,J ;POINT INTO JOB-INFO PAGE
SKIPN T2,J$XPTB(T2) ;GET THE TABLE ENTRY
JRST BACKS1 ;ITS ZERO!! USE OLD CODE
MOVEI T3,DSK ;DSK CHANNEL
WAIT T3, ;AND WAIT FOR IO TO COMPLETE
PUSHJ P,REWIND ;REWIND THE FILE
USETI DSK,(T2) ;SET THE BLOCK
HRRZM T2,J$DINF(J) ;SAVE FOR NEXT TIME
HLRZM T2,J$XSBC(J) ;AND STORE THE BYTE COUNT
SOS J$DINF(J) ;SAVE DECREMENTED.
MOVNS N ;GET -VE PAGES
ADDM N,J$RNPP(J) ;SET CURRENT PAGE
MOVNS N ;RE-NEGATE
ADDM N,J$RLIM(J) ;HOW MANY TO SKIP
BSPCF3: ADDI T1,1 ;POINT TO NEXT INVALID PAGE
IDIVI T1,TABSIZ ;GET IT MODULO TABSIZ
ADD T2,J ;POINT INTO JOB INFO PAGE
CLEARM J$XPTB(T2) ;CLEAR IT
MOVE T1,T2 ;RESTORE THE INDEX
SUB T1,J ;SUBTRACT OUT THE ADR OF J-I PAGE
SOJG N,BSPCF3 ;AND LOOP FOR ALL SKIPPED PAGES
POPJ P, ;AND RETURN
;ROUTINE TO CLEAR OUT THE PAGE-LOCATION TABLE
CLRTAB: HRRI T4,J$XPTB(J) ;GET ADR OF FIRST WORD
HRL T4,T4 ;XWD ADR,ADR
CLEARM (T4) ;CLEAR THE FIRST WORD
ADDI T4,1 ;MAKE XED ADR,ADR+1
MOVEI T3,J$XPTB(J) ;GET ADDRESS OF BLOCK
BLT T4,TABSIZ-1(T3) ;BLT THE BLOCK
POPJ P, ;AND RETURN
> ;END IFN FTUUOS
SUBTTL Operator Commands -- FORWARD
;SUBROUTINE TO SPACE FORWARD N PAGES
;CALLED FROM COMIN:
; PUSHJ P,FORWAR
; RETURN WITH SOME LOCATIONS FIXED
;
FORWAR: PUSHJ P,DECARG ;GET THE ARGUMENT
POPJ P, ;ILLEGAL OR ZERO
STAMP LPOPR ;STAMP THE LOG
TELL LOG,%%FSF ;PUT MESSAGE IN THE LOG
FORWD1: TXOE S,NOTYPE ;SET NOTYPE AND SKIP IF IT WASN'T ALREADY
JRST FORWD2 ;IT WAS, WE'RE MOVING FORWARD ALREADY
MOVN T1,N ;GET -VE NUMBER OF PAGES TO SKIP
ADDM T1,J$APRT(J) ;AND DECREMENT NUMBER PRINTED BY IT
ADD N,J$RNPP(J) ;ADD CURRENT PAGE NUMBER
MOVEM N,J$XDPG(J) ;SAVE AS DESTINATION PAGE
POPJ P, ;AND RETURN
FORWD2: ADDM N,J$XDPG(J) ;JUST PUSH DESTINATION AHEAD
POPJ P, ;AND RETURN
SUBTTL Operator Commands -- MESSAGE
MESSGE: SETZ AP, ;CLEAR ARGUMENT COUNTER
MESS.0: SETZM MSGJOB ;START WITH A CLEAN SLATE
SETZM MSGFIL ; DITTO
SETZM MSGERR ; DITTO AGAIN
MESS.1: PUSHJ P,SIXIN ;GET A WORD
JRST MESS.4 ;NO MORE, CHECK FOR NULL ARG AND RET
LDB T2,[POINT 6,T1,5] ;GET THE FIRST CHARACTER
CAIN T2,'A' ;IS IT 'ALL'?
JRST MESS.5 ;YES, HANDLE SPECICAL CASE
MOVSI T4,-MSGTLN ;MAKE AN AOBJN POINTER TO TABLE
MESS.2: HLRZ T3,MSGTBL(T4) ;GET AN ENTRY
CAMN T2,T3 ;IS IT A MATCH?
JRST MESS.3 ;YES, GO DO SOMETHING
AOBJN T4,MESS.2 ;NO, LOOP
TELL OPR,%%ICAS ;NO MATCH, ERROR
JRST MESS.4 ;BUT CONTINUE ANYWAY
MESS.3: AOJ AP, ;FLAG THAT WE GOT AN ARGUMENT
HRRZ T3,MSGTBL(T4) ;GET WORD TO SET
SETZ T1, ;DUMMY FOR 'NONE'
SETOM (T3) ;SET IT
JUMPN T1,MESS.0 ;JUMP IF 'NONE'
MESS.4: CAIN C,"," ;IS THERE MORE?
JRST MESS.1 ;YES, LOOP
SKIPN AP ;DID WE GET AN ARGUMENT?
SETOM MSGERR ;NO, SET DEFAULT
POPJ P, ;NO, RETURN
MESS.5: SETOM MSGFIL ;SET JOB
SETOM MSGJOB ;SET FILE
SETOM MSGERR ;SET ERROR
JRST MESS.4 ;AND CONTINUE
MSGTBL: XWD 'J',MSGJOB
XWD 'F',MSGFIL
XWD 'E',MSGERR
XWD 'N',T1 ;DUMMY FOR 'NONE'
MSGTLN==.-MSGTBL
SUBTTL Operator Commands -- (NO)SUPPRESS
;SUBROUTINE TO IMPLEMENT THE SUPPRESS COMMAND
;CALL WITH:
; PUSHJ P,SUPPRE
; RETURN HERE
;
SUPPRE: OFF S,SUPJOB!SUPRES ;START CLEAN
PUSHJ P,SIXIN ;GET ARGUMENT
MOVSI T1,'FIL' ;GET DEFAULT ARGUMENT
LDB T2,[POINT 6,T1,5] ;GET THE FIRST CHARACTER
CAIN T2,'F' ;"FILE"
ON S,SUPRES ;YES, LIGHT THE BIT
CAIN T2,'J' ;"JOB"
ON S,SUPJOB ;YES, SET THE BIT
TXNN S,SUPJOB!SUPRES ;DID WE LIGHT ONE?
TELL OPR,%%ICAS ;NO, GIVE AN ERROR
POPJ P, ;YES, RETURN
;ROUTINE TO IMPLEMENT THE NOSUPPRESS COMMAND
;CALL WITH
; PUSHJ P,NOSUPR
; RETURN HERE ALWAYS
;
NOSUPR: OFF S,SUPJOB!SUPRES ;TURN OFF LOCAL AND GLOBAL FLAGS
POPJ P, ;AND RETURN
SUBTTL LOWSEG Operator Commands -- RESET - CHECKPOINT
LOWSEG
;SUBROUTINE TO DO A RESET
;CALL WITH:
; PUSHJ P,RESETC
; NEVER RETURNS
;ALL AC'S REFRESHED
RESETC: SETOM RSTFLG ;SET THE RESET FLAG
TXNE S,BUSY ;ARE WE BUSY?
POPJ P, ;YES, MAKE IT PEND
DOREST: PUSHJ P,GETSPL ;GET THE HISEG
PUSHJ P,SETHEL ;SETUP HELLO BLOCK
MOVX T1,HELSTC!HELBYE ;GOODBYE+STATUS CHANGE
IORM T1,MSGBLK+HEL.ST ;STORE FLAGS
MOVEI T1,MSGBLK ;LOAD ADR OF BLOCK
PUSHJ P,SNDQSR## ;SEND IT
TELL OPR,%%LIR ;LPTSPL IS RESET
JRST LPTSPL
;SUBROUTINE TO TAKE A CHECKPOINT
TAKCHK: SKIPN J$LHNG(J) ;RETURN IF DEVICE IS OFF-LINE
TXNE S,ABORT ;ARE WE ABORTED?
POPJ P, ;YES, DON'T CHECKPOINT
PUSHJ P,SETCHP ;SETUP THE CHECKPOINT BLOCK
PUSHJ P,CLSLOG ;AND CLOSE THE LOG
MOVX T1,<CHE.SZ,,.QOCHE> ;LOAD THE MESSAGE HEADER
MOVEM T1,MSGBLK ;STORE IT
MOVEI T1,MSGBLK ;LOAD THE BLOCK ADDRESS
PJRST SNDQSR## ;AND SEND IT
SETCHP: STAMP LPMSG ;GIVE A STAMP
MOVEI T2,MSGBLK ;LOAD ADDRESS OF MSG BLOCK
MOVE N,J$RNFP(J) ;GET NUMBER OF FILES
MOVEM N,CHE.IN+CKFIL(T2) ;STORE IT
MOVE N,J$RNCP(J) ;GET NUMBER OF COPIES
MOVEM N,CHE.IN+CKCOP(T2) ;AND STORE IT
AOS N ;INCREMENT IT
TELL LOG,%%CPT ;AND TYPE FIRST PART OF MESSAGE
MOVE N,J$RNPP(J) ;GET NUMBER OF PAGES
MOVEM N,CHE.IN+CKPAG(T2) ;AND STORE IT
TELL LOG,%%CPT1 ;AND SECOND PART OF MESSAGE
MOVE N,J$APRT(J) ;NUMBER OF PAGES PRINTED
MOVEM N,CHE.IN+CKTPP(T2) ;AND STORE IT
LOAD N,.EQITN(J) ;GET JOBS ITN
MOVEM N,MSGBLK+CHE.IT ;AND STORE IT
MOVX N,CKFCHK ;CHKPOINT FLAG
MOVEM N,CHE.IN+CKFLG(T2) ;STORE IT
POPJ P, ;AND RETURN
SUBTTL TTY I/O Routines
TOPSEG
;SUBROUTINE TO FIND A DELIMITER (ANY OF :,=)
;CALL WITH:
; PUSHJ P,FNDELM
; CAN'T FIND A DELIMITER
; RETURN HERE WITH DELIMITER IN C
;
FNDELM: PUSHJ P,GETCHR ;GET A CHAR
CAIN C,12 ;LINE FEED?
POPJ P, ;YES. NO DELIMITER
CAIE C,":" ;COLON?
CAIN C,"=" ; OR EQUALS
JRST .POPJ1## ;YES. WE HAVE A DELIMITER
JRST FNDELM ;NO KEEP LOOKING
;SUBROUTINE TO INSERT THE FIRST CHAR AFTER A / IN C
;CALL WITH
; PUSHJ P,DOSW
; RETURN HERE IF NO SWITCHES
; RETURN HERE WITH C SET UP
;
DOSW: CAIE C,"/" ;GOT A SLASH?
DOSW.1: PUSHJ P,GETCHR ;NO, GET A CHARACTER
TXNE S,TTYBRK ;HIT EOL?
POPJ P, ;YES, RETURN
CAIE C,"/" ;DO WE HAVE A SLASH?
JRST DOSW.1 ;NO, LOOP
PJRST GETCHR ;YES, GET THE NEXT CHRACTER AND RETURN
;SUBROUTINE TO INPUT A DECMAL NUMBER
;CALL WITH:
; PUSHJ P,DECARG
; INVALID DATA
; RETURN HERE WITH NUMBER IN N
;MUST RESPECT T2
DECARG: SETZ N, ;CLEAR RESULT
PUSHJ P,SPACES ;FLUSH SPACES
SKIPA ;AND SKIP INTO LOOP
DECAR1: PUSHJ P,GETCHR ;GET A CHAR
CAIG C,71 ;IS THIS CHAR A DIGIT
CAIGE C,60 ; ..
JRST ACH ;NO. MUST BE END OF NUMBER
IMULI N,12 ;ADJUST N FOR NEXT DECADE
ADDI N,-60(C) ;NIFTY INSTRUCTION, TO INCR. N
JRST DECAR1 ;GET NEXT DIGIT
ACH: CAIE C," " ;BLANKS TABS
CAIN C,12 ; AND LINE FEEDS ARE VALID AFTER NUMBER
AOS (P) ;GOOD DELIMITER IN C
POPJ P, ;INVALID DELIMITER
;SUBROUTINE TO INPUT A SIXBIT WORD (A-Z AND 0-9 ONLY VALID CHARS.)
;CALL WITH:
; PUSHJ P,SIXIN
; RETURN HERE IF NOTHING FOUND
; RETURN HERE WITH WORD IN T1
;
SIXIN: SETZ T1, ;CLEAR RESULT
MOVE T2,[POINT 6,T1];SET UP A BYTE POINTER
PUSHJ P,SPACES ;SKIP SPACES
SKIPA ;AND GET INTO LOOP WITH 1ST CHAR
SIXLPI: PUSHJ P,GETCHR ;GET A CHAR
TXNE S,TTYBRK ;GOT A BREAK CHAR?
JRST CKT1 ;YES. CHECK RESULT
CAIL C,"0" ;STANDARD CHECK
CAILE C,"Z" ; FOR ALPHABETIC
JRST CKT1 ; OR NUMERIC DATA
CAILE C,"9" ; ANYTHING THAT FAILS
CAIL C,"A" ; IS CONSIDERED A TERMINAL
JRST .+2
JRST CKT1 ; CHARACTOR
SUBI C,40 ;CONVERT TO SIXBIT
TLNE T2,770000 ;MORE THAN 6 CHARS?
IDPB C,T2 ;STORE
JRST SIXLPI ;LOOP GO MORE
CKT1: JUMPN T1,.POPJ1## ;DID WE FIND A CHAR
POPJ P, ;NO. PUNT
;SUBROUTINE TO INPUT ONE CHAR HANDLING SYNTAX
;CALL WITH:
; PUSHJ P,GETCHR
; RESULT IN C
GETCHR: PUSHJ P,TTYIN ;GET A CHARACTER
CAIL C,"A"+40 ;CHECK TO SEE IF IT IS
CAILE C,"Z"+40 ; A LOWER CASE CHARACTER
SKIPA ;IT'S NOT
SUBI C,40 ;IT IS, MAKE IT UPPER CASE
CAIE C,.CHCRT ;CARRAGE RETURN
CAIN C,177 ;RUBOUT
JRST GETCHR ;GET A NEW CHAR
CAIN C,11 ;TAB?
MOVEI C,40 ;YES. SAME AS BLANK
CAIE C,";" ;COMMENT
CAIN C,"!" ; " "
SKIPA ;YES, SKIP
POPJ P, ;NO, RETURN
EAT: PUSHJ P,TTYIN ;GET A CHARACTER
TXNN S,TTYBRK ;GET A BREAK YET?
JRST EAT ;NO, LOOP
IFN FTJSYS,<
PUSHJ P,TTYSTA ;START THE TTY PROCESS GOING
> ;END IFN FTJSYS
POPJ P, ;YES, RETURN
SPACES: PUSHJ P,GETCHR ;SKIP A CHARACTER
CAIN C," " ;IS IT A SPACE?
JRST SPACES ;NO, LOOP
POPJ P, ;AND RETURN
SUBTTL SETNL -- Setup to read a new line from TTY
IFN FTUUOS,<
SETNL: OFF S,TTYBRK ;CLEAR THE BREAK FLAG
POPJ P, ;AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
SETNL: OFF S,TTYBRK ;CLEAR THE BREAK FLAG
MOVE S1,[POINT 7,TTYBUF] ;POINT TO THE BUFFER
MOVEM S1,TTYPTR ;SAVE THE POINTER
SKIPE TTYFLG ;IS THERE ANYTHING?
POPJ P, ;YES, RETURN
PUSHJ P,TTYSTA ;NO, START IT
MOVEI S1,^D60 ;LOAD A MINUTE
PUSHJ P,SUSPND ;GO SLEEP
JRST SETNL ;AND LOOP
> ;END IFN FTJSYS
SUBTTL TTYIN -- Read a character from the TTY
;TTYIN ROUTINE TO GET A CHARACTER FROM THE OPERATOR'S CONSOLE
; RETURNS CHARACTER IN C
IFN FTUUOS,<OPDEF GTCHR. [INCHWL C]>
IFN FTJSYS,<OPDEF GTCHR. [ILDB C,TTYPTR]>
TTYIN: TXNN S,TTYBRK ;GOT A BREAK?
JRST TTYI.1 ;NO, CONTINUE
MOVEI C,.CHLFD ;YES, LOAD A LF
POPJ P, ;AND RETURN
TTYI.1: GTCHR. ;GET A CHARACTER
CAIE C,.CHCNZ ;IS IT A CONTROL-Z OR A
CAIN C,.CHCNC ; CONTROL-C?
JRST DOEXIT ;YES, GO EXIT
CAIE C,.CHESC ;IS IT AN ESCAPE?
CAIN C,.CHLFD ; OR A LINEFEED?
ON S,TTYBRK ;YES, SET FLAG
POPJ P, ;RETURN
SUBTTL TTYOUT -- Type out a character on the TTY
;TTYOUT ROUTINE TO TYPE A CHARACTER ON THE OPERATOR'S CONSOLE
; CALL WITH CHARACTER IN AC C
IFN FTUUOS,<
TTYOUT: OUTCHR C ;TYPE IT
POPJ P, ;AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
TTYOUT: EXCH C,S1 ;GET CHARACTER IN S1
PBOUT ;OUTPUT IT
EXCH C,S1 ;EXCHANGE BACK
POPJ P, ;AND RETURN
> ;END IFN FTJSYS
SUBTTL LUUO Handler
;HERE FROM LOCATOIN 40 ON THE TELL AND TELLN AND STAMP UUO.
LOWSEG
UUOL: MOVEM N,SAVN# ;SAVE N
MOVEM T1,SAVT1# ;SAVE T1
PUSHJ P,SAVALL ;SAVE THE AC'S
PUSHJ P,GETSPL ;GET THE SPOOLER
PJRST UUOH ;PROCESS THE UUO
TOPSEG
UUOH: OFF S,TNOACT ;CLEAR SOME BITS
MOVE P1,.JBUUO## ;PICK UP THE UUO
TXNE P1,STAMP ;IS IT A STAMP UUO?
JRST STPLOG ;YES, DO IT
TXNE P1,TELLN ;IS IT A TELLN UUO?
ON S,TNOACT ;YES, DON'T ALLOW ACTION CHARACTERS
HRLI P1,440700 ;CONVERT TO BYTE POINTER
LDB T1,PAC ;PICK UP THE AC BITS
DPB T1,PS ;SAV3 IN STATUS REG.
TXNE S,TELUSR ;IF THIS IS FOR THE USER
OFF S,FFSEEN ; THEN WE ARE NOT AT TOP OF FORM
TLOOP: ILDB C,P1 ;GET A CHAR
TLOOP0: JUMPE C,UUORST ;JUMP IF NULL
CAIE C,"!" ;THE ESCAPE CHAR?
JRST TLOOP1 ;NO, CONTINUE
ILDB C,P1 ;YES, GET NEXT CHAR
JUMPE C,UUORST ;FINISH UP IF NULL
PUSHJ P,SEND ;ELSE, SEND IT
JRST TLOOP ;AND LOOP
TLOOP1: TXNN S,TNOACT ;ACTION ALLOWED?
PUSHJ P,DOACT ;YES. IS THIS ACTIVE
SKIPE C ;C=0 IF IT WAS AN ACTION CHAR
PUSHJ P,SEND ;NO. JUST PRINT
JRST TLOOP ;DO NEXT CHAR
UUORST: OFF S,TNOACT ;CLEAR A BIT
POPJ P, ;RETURN
;SUBROUTINE TO PROCESS ACTION CHARS
;CALL WITH:
; MOVE C,CHAR-TO-CHECK
; PUSHJ P,DOACT
; ACTION TAKEN IF (C) = 0
;ALL ACS PRESERVEVED UNLESS ACTION SAYS OTHERWISE
DOACT: PUSHJ P,DOACT1 ;GO DO THE CHECKS
SETZ C, ;HERE IF IT WAS AN ACTION CHARACTER
POPJ P, ;HERE IF IT WASN'T AN ACTION CHAR
DOACT1: ACTCHR <^>,A5 ;PRINT FILE NAME
ACTCHR <]>,PRUSER ;PRINT USER IDENTIFICATION
ACTCHR <+>,A9 ;PRINT T1 AS SIXBIT
ACTCHR <#>,A10 ;PRINT N AS DECMAL NUMBER
ACTCHR <@>,PRDTC ;PRINT CURRENT DATE AND TIME
ACTCHR <&>,A13 ;PRINT N AS OCTAL
ACTCHR <$>,PRDEV ;PRINT CURRENT PROCESSING DEVICE
PJRST .POPJ1## ;SKIP RETURN - NOTHING DONE
;SUBROUTINE TO PRINT A SIXBIT VALUE PASSED TO MESSAGE HANDLER
;CALL WITH:
; PUSHJ P,A9
; RETURN HERE
;
A9: MOVE T1,SAVT1 ;PICK UP WORD
PJRST SIXOUT ;PRINT IT
;SUBROUTINE TO PRINT N AS DECMAL
A10: MOVE T1,SAVN ;GET ARGUMENT
PJRST DECOUT ;PRINT AND RETURN
;SUBROUTINE TO PRINT N IN OCTAL
A13: MOVE T1,SAVN
PJRST OCTOUT
;SUBROUTINE TO PRINT A FILE NAME
;CALL WITH:
; PUSHJ P,A5
; ALWAYS RETURN HERE
IFN FTUUOS,<
A5: MOVE T1,J$DFLP+.FODEV(J) ;GET STR NAME
JUMPE T1,A5A ;DON'T PRINT ":" ON NULL DEVICE
PUSHJ P,SIXOUT ;PRINT IT
MOVEI C,":" ;DELIMIT WITH A
PUSHJ P,SEND ; DOUBLE DECKER PERIOD
A5A: MOVE T1,J$DUUO+.RBNAM(J) ;PICK UP FILE NAME
PUSHJ P,SIXOUT ;AND PRINT IT
HLLZ T1,J$DUUO+.RBEXT(J) ;GET EXTENSION
JUMPE T1,A5.1 ;GO AWAY IF NULL
MOVEI C,"." ;PRINT A DOT
PUSHJ P,SEND ; ..
PUSHJ P,SIXOUT ;AND PRINT EXT
A5.1: MOVEI C,74 ;LOAD OPEN WIDGET
PUSHJ P,SEND ;SEND IT
LDB T1,[POINT 9,J$DUUO+.RBPRV(J),8]
MOVEI C,"0" ;READY TO PAD
CAIL T1,100 ;LESS THAN 3 DIGITS?
JRST A5.2 ;NO, TYPE IT
PUSHJ P,SEND ;YES, PAD IT
CAIL T1,10 ;LESS THAN TWO DIGITS?
JRST A5.2 ;NO, TYPE IT
PUSHJ P,SEND ;YES, MORE PADDING
A5.2: PUSHJ P,OCTOUT ;TYPE IT NOW
MOVEI C,76 ;LOAD A CLOSE WIDGET
PUSHJ P,SEND ;SEND IT
MOVEI T1,J$DPAT(J) ;GET ADDRESS OF PATH BLOCK
PUSHJ P,TYPUID ;AND TYPE IT
SKIPN T1,J$DUUO+.RBSPL(J) ;GET RIBSPL
POPJ P, ;NONE, RETURN
MOVEI C,"(" ;LOAD OPEN PAREN
PUSHJ P,SEND ;SEND IT
PUSHJ P,SIXOUT ;SEND THE SPOOLED NAME
MOVEI C,")" ;LOAD A CLOSE PAREN
PJRST SEND ;SEND IT AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
A5: MOVE T1,J$DSTG(J) ;GET ADR OF THE STRING
HRLI T1,(POINT 7,0) ;MAKE A BYTE POINTER
A5.1: ILDB C,T1 ;GET A BYTE
JUMPE C,.POPJ## ;RETURN WHEN DONE
PUSHJ P,SEND ;ELSE, SEND IT
JRST A5.1 ;AND LOOP
> ;END IFN FTJSYS
;SUBROUTINE TO TYPE A USER ID SPECIFICATION
;
;CALL:
; MOVE T1,[DIRECTORY SPEC] (T10=PPN-PATH, T20=DIRECT #)
; PUSHJ P,TYPUID
; ALWAYS RETURN HERE
IFN FTUUOS,<
TYPUID: PUSHJ P,.SAVE2## ;SAVE P1 & P2
MOVE P1,T1 ;AND SAVE THE ARG
TLNN T1,-1 ;IS IT A PATH?
MOVE T1,2(T1) ;YES, GET THE PPN
PUSHJ P,TYPPPN ;AND TYPE THE PPN
TLNE P1,-1 ;DID HE SUPPLY A PATH?
JRST TYPU.2 ;NO, FINISH OFF AND RETURN
MOVEI P1,3(P1) ;POINT TO FIRST SFD
TYPU.1: SKIPN T1,(P1) ;GET NEXT SFD
JRST TYPU.2 ;DONE
MOVEI C,"," ;GET A COMMA
PUSHJ P,SEND ;SEND IT
PUSHJ P,SIXOUT ;SEND THE SFD NAME
AOJA P1,TYPU.1 ;AND LOOP
TYPU.2: MOVEI C,"]" ;LOAD THE CLOSER
PJRST SEND ;AND SEND IT
TYPPPN: MOVEI C,"[" ;LOAD THE OPENER
PUSHJ P,SEND ;SEND IT
MOVE P2,T1 ;AND COPY THE PPN
HLRZS T1 ;GET THE PROJECT NUMBER
PUSHJ P,OCTOUT ;TYPE IT
MOVEI C,"," ;LOAD A COMMA
PUSHJ P,SEND ;SEND IT
HRRZ T1,P2 ;GET PROGRAMMER NUMBER
PJRST OCTOUT ;SEND IT AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
TYPUID: MOVE S2,T1 ;GET USER NUMBER IN S2
HRROI S1,J$XSFO(J) ;AND POINT TO THE BLOCK
DIRST ;MAKE A STRING
JFCL ;AND IGNORE THE FAIL
MOVE T1,[POINT 7,J$XSFO(J)] ;POINT TO THE BLOCK
TYPU.1: ILDB C,T1 ;GET A CHARACTER
JUMPE C,.POPJ## ;RETURN IF DONE
PUSHJ P,SEND ;ELSE SEND IT
JRST TYPU.1 ;AND LOOP
> ;END IF FTJSYS
;SUBROUTINE TO PRINT A NUMBER IN ANY RADIX
;CALL WITH:
; MOVE T1,NUMBER-TO-PRINT
; PUSHJ P,OCTOUT
;
; -OR-
;
; MOVE T1,NUMBER-TO-PRINT
; PUSHJ P,DECOUT
;
; -OR-
;
; MOVEI T4,RADIX
; MOVE T1,NUMBER-TO-PRINT
; PUSHJ P,ANYRDX
;
;
DECOUT: MOVEI T4,^D10 ;BASE TEN
ANYRDX: JUMPGE T1,RDXOUT ;JUMP IF POSITIVE
MOVEI C,"-" ;LOAD A MINUS
PUSHJ P,SEND ;PRINT IT
MOVM T1,T1 ;MAKE POSITIVE
RDXOUT: IDIVI T1,(T4) ;FIND THE REMAINDER
HRLM T2,(P) ;PUSH ONTO STACK
SKIPE T1 ;FINISHED?
PUSHJ P,RDXOUT ;NO. RECUR
HLRZ C,(P) ;YES. POP OFF A DIGIT
ADDI C,60 ;CONVERT TO ASCII
PJRST SEND ;PRINT THE DIGIT
OCTOUT: LSHC T1,-3 ;SHIFT OUT THREE BITS
HLLM T2,(P) ;STACK IT
SKIPE T1 ;SKIP IF DONE
PUSHJ P,OCTOUT ;ELSE RECURSE
HLRZ C,(P) ;GET A DIGIT
LSH C,-^D15 ;RIGHT JUSTIFY IT
ADDI C,60 ;MAKE IT ASCII
PJRST SEND ;AND PRINT IT
;SUBROUTINE TO PRINT AC AS SIXBIT
;CALL WITH:
; MOVE T1,WORD-TO-PRINT
; PUSHJ P,SIXOUT
; RETURN IS ALWAYS HERE
SIXOUT: MOVE T2,T1 ;COPY OVER THE ARG
SIXO.1: SETZ T1, ;ZERO OUT T1
JUMPE T2,.POPJ## ;ANYTHING LEFT?
LSHC T1,6 ;SHIFT IN ANOTHER CHAR
MOVEI C,40(T1) ;PUTCHAR IN C
PUSHJ P,SEND
JRST SIXO.1 ;LOOP FOR MORE
SUBTTL PRUSER - Print out user identification
;PRUSER PRINTS OUT THE CURRENT USER'S IDENTIFICATION WHICH CONSISTS
; OF USER NAME AND PPN ON TOPS10 AND USER DIRECTORY NAME ON
; TOPS20
;
;CALL:
; PUSHJ P,PRUSER
; ALWAYS RETURN HERE
IFN FTUUOS,<
PRUSER: MOVE T1,.EQUSR(J) ;GET 1ST HALF OF NAME
PUSHJ P,SIXOUT ;SEND IT
MOVEI C," " ;LOAD A BLANK
MOVE T1,.EQUSR(J) ;AND GET FIRST HALF BACK
TRNN T1,77 ;WAS LAST CHAR A BLANK?
PUSHJ P,SEND ;YES, SEND ONE BLANK
MOVE T1,.EQUSR+1(J) ;GET 2ND HALF
PUSHJ P,SIXOUT ;TYPE IT
MOVEI C," " ;LOAD A BLANK
PUSHJ P,SEND ;SEND IT
MOVE T1,.EQOWN(J) ;GET PPN
PJRST TYPUID ;AND TYPE IT
> ;END IFN FTUUOS
IFN FTJSYS,<
PRUSER: MOVEI T1,.EQOWN(J) ;POINT TO USER NAME
HRLI T1,(POINT 7,0) ;MAKE A BYTE POINTER
PRUS.1: ILDB C,T1 ;LOAD A CHACTER
JUMPE C,.POPJ## ;DONE, RETURN
PUSHJ P,SEND ;SEND IT
JRST PRUS.1 ;AND LOOP
> ;END IFN FTJSYS
SUBTTL PRDEV - Print out current processing device
PRDEV: MOVE T1,J$LDEV(J) ;GET THE DEVICE
PJRST SIXOUT ;AND PRINT IT
SUBTTL PRDTC - Print current date and time
;CALL WITH:
; PUSHJ P,PRDTC
; RETURN HERE ALWAYS
PRDTC: PUSHJ P,PRDATE ;PRINT THE DATE
MOVEI C," " ;LOAD A BLANK
PUSHJ P,SEND ;SEND IT
PJRST PRTIME ;SEND THE TIME AND RETURN
SUBTTL PRDTA - Print an arbitrary date and time
;CALL WITH:
; MOVE T1,[DATE,,TIME]
; PUSHJ P,PRDTA
; RETURN HERE ALWAYS
PRDTA: PUSHJ P,.SAVE1## ;SAVE P1
PUSH P,T1 ;SAVE T1 FOR A WHILE
IFN FTJSYS,<
MOVE P1,T1 ;GET THE DATE
> ;END IFN FTJSYS
IFN FTUUOS,<
HLRZ P1,T1 ;GET THE DATE
MOVX T1,%CNDTM ;GETTAB TO DATE-TIME
GETTAB T1, ;GET IT
HALT
HLRZS T1 ;GET DATE
SUB T1,P1 ;GET THE DIFFERENCE
DATE P1, ;GET TODAY'S DATE
SUB P1,T1 ;SUBTRACT THE DIFFERENCE
> ;END IFN FTUUOS
PUSHJ P,PRDAT1 ;PRINT THE DATE
MOVEI C," " ;LOAD A BLANK
PUSHJ P,SEND ;SEND IT
POP P,P1 ;GET THE TIME BACK
PJRST PRTIM1 ;AND PRINT THE TIME
SUBTTL PRDATE - Print the date
;CALL WITH:
; PUSHJ P,PRDATE
; RETURN HERE
IFN FTUUOS,<
PRDATE: PUSHJ P,.SAVE3## ;SAVE 3 AC'S
DATE P1, ;GET THE DATE
JRST .+2 ;SKIP THE SAVE
PRDAT1: PUSHJ P,.SAVE4## ;SAVE THE PRESERVED AC'S
IDIVI P1,^D31 ;GET THE DAY
MOVEI T1,1(P2) ;ADD AND MOVE
PUSHJ P,TWODIG ;PRINT THE DAY
IDIVI P1,^D12 ;GET THE MONTH
MOVE T1,P2 ;GET MON-1 IN T1
MOVE P2,[POINT 7,MNTAB(T1)] ;LOAD A BYTE POINTER
MOVEI P3,5 ;CHAR COUNT
ILDB C,P2 ;LOAD A CHAR
PUSHJ P,SEND ;SHIP IT
SOJG P3,.-2 ;LOOP OVER WORD
MOVEI T1,^D64(P1) ;ADD YEAR ZERO
PJRST DECOUT ;AND PRINT IT AND RETURN
MNTAB: ASCII /-Jan-/
ASCII /-Feb-/
ASCII /-Mar-/
ASCII /-Apr-/ ;OR IS IT CPU
ASCII /-May-/
ASCII /-Jun-/
ASCII /-Jul-/
ASCII /-Aug-/
ASCII /-Sep-/
ASCII /-Oct-/
ASCII /-Nov-/
ASCII /-Dec-/
> ;END IFN FTUUOS
IFN FTJSYS,<
PRDATE: PUSHJ P,.SAVE1## ;SAVE P1
SETO P1, ;AND SET TO -1
PRDAT1: PUSHJ P,.SAVET## ;SAVE T1-T4
MOVE S2,P1 ;GET DATE TO PRINT
HRROI S1,J$XSFO(J) ;GET PTR TO BLOCK
MOVX T1,1B9 ;DONT PRINT THE TIME
ODTIM ;AND DO IT!!
MOVE T1,[POINT 7,J$XSFO(J)]
PRDA.2: ILDB C,T1 ;GET A CHARACTER
JUMPE C,.POPJ## ;RETURN WHEN DONE
PUSHJ P,SEND ;SEND IT
JRST PRDA.2 ;AND LOOP
> ;END IFN FTJSYS
SUBTTL PRTIME - Print the time
;CALL WITH:
; PUSHJ P,PRTIME
; RETURN HERE
IFN FTUUOS,<
PRTIME: PUSHJ P,.SAVE2## ;GET SOME SCRATCH AC'S
MOVX P1,%CNDTM ;GET UNIVERSAL DATE-TIME
GETTAB P1, ;GET IT
HALT .
PRTIM1: HRRZS P1 ;JUST TIME HALF
MULI P1,^D86400 ;MULIPLY BY SECS/DAY
ASHC P1,^D17 ;DIVIDE BY 2^18 YIELDING SECONDS
IDIVI P1,^D3600 ;MAKE HOURS
PUSHJ P,PRT2 ;PRINT HOURS AS TWO DIGITS
MOVEI C,":" ;PRINT A DELIMITER
PUSHJ P,SEND ; ..
MOVE P1,P2 ;GET REMAINDER
IDIVI P1,^D60 ;DIVIDE OUT THE MINUTES
PUSHJ P,PRT2 ; ..
MOVEI C,":" ; DELIMIMIT THE HOURS
PUSHJ P,SEND ; FROM THE SECONDS
MOVE P1,P2 ;GET THE SECONDS
PRT2: MOVE T1,P1 ;SETUP FOR DECOUT
;FALL INTO TWODIG
;SUBROUTION TO PRINT AT LEASE 2 DECMAL DIGITS
;CALL WITH:
; MOVE T1,NUMBER-T0-PRINT
; PUSHJ P,TWODIG
; RETURN HERE
;
TWODIG: MOVEI C,"0" ;ALWAYS PRINT 2 DIGITS
CAIGE T1,12 ;IF LESS TAN 10
PUSHJ P,SEND
PJRST DECOUT ;PRINT N AS DECMAL
> ;END IFN FTUUOS
IFN FTJSYS,<
PRTIM1: SKIPA S2,P1 ;GET ARBITRARY TIME
PRTIME: SETO S2, ;GET CURRENT TIME
HRROI S1,J$XSFO(J) ;POINT TO THE BLOCK
MOVX T1,1B0 ;AND FORMAT FLAGS
ODTIM ;AND DO THE JSYS
MOVE T1,[POINT 7,J$XSFO(J)]
PRTI.1: ILDB C,T1 ;GET A CHARACTER
JUMPE C,.POPJ## ;RETURN WHEN DONE
PUSHJ P,SEND ;SEND IT
JRST PRTI.1 ;AND LOOP
> ;END IFN FTJSYS
;SUBROUTINE TO PLACE A CHAR IN ALL THE PROPER BUFFERS
;CALL WITH:
; PUSHJ P,SEND (CHAR IN C, FLAGS IN S)
; RETURN HERE
;ALL AC'S RESPECTED (AT SOME PAIN)
;
SEND: TXNE S,TELOPR ;SHOULD WE GIVE TO OPER?
PUSHJ P,TTYOUT ;YES, GO AHEAD
SLOG: TXNE S,TELLOG ;LOG THIS MESSAGE?
PUSHJ P,CHRLOG ;YES, DO IT
SDEV: TXNN S,TELUSR ;PRINT DIRECTLY?
POPJ P, ;RETURN
OFF S,NOTYPE!FFSEEN ;MAKE IT SEEN
CAIN C,.CHFFD ;IS IT A FORM FEED?
ON S,FFSEEN ;YES, TURN ON A FLAG
PJRST DEVOUT ;PRINT THE CHAR AND RETURN
SUBTTL LOG File Routines
; FNDLOG -- FIND THE LOG FILE AND SET IT UP
; STALOG -- PUT STARTUP MESSAGES IN USERS LOG FILE
; STPLOG -- PUT A TIMESTAMP IN THE LOG FILE
; CHRLOG -- PUT A CHARACTER IN THE LOG FILE
; OPNLOG -- OPEN THE LOG FOR WRITING
; CLSLOG -- CLOSE THE LOG FILE OUT
; RIDLOG -- RELEASE THE LOG FILE
; BUFLOG -- ALLOCATE A BUFFER PAGE FOR LOG
; CLNLOG -- CLEAN-UP LOG BUFFER PAGES
TOPSEG
SUBTTL FNDLOG -- Setup the LOG File
;FNDLOG -- ROUTINE TO FIND THE LOG FILE SPEC, AND SETUP THE
; VARIOUS UUO BLOCKS.
FNDLOG: OFF S,JOBLOG!LOGOPN ;START WITH NO LOG
SETZM J$GNLN(J) ;AND 0 LINES
SETZM J$GINP(J) ;AND NO INTERNAL LOG YET
PUSHJ P,BUFLOG ;GET A BUFFER PAGE
SKIPN T1,J$RLFS(J) ;IS THERE A LOG FILE SPEC
POPJ P, ;NO, RETURN
IFN FTJSYS,<
FNDL.2: ON S,JOBLOG ;THERE IS A LOG FILE
LOAD S2,.FPSIZ(T1),FP.FHD ;GET LENGTH OF FP
ADD S2,T1 ;ADD IN ADR OF FP
MOVEM S2,J$GSTG(J) ;AND SAVE ADDRESS OF NAME
HRRO S2,S2 ;GET POINTER TO STRING
MOVX S1,GJ%SHT!GJ%OLD ;SHORT GTJFN, OLD FILE ONLY
GTJFN ;FIND IT
JRST FNDL.3 ;NOPE!!
MOVEM S1,J$GJFN(J) ;GOT IT, SAVE THE JFN
POPJ P, ;AND RETURN
FNDL.3: MOVX S1,GJ%SHT!GJ%FOU ;SHORT GTJFN, FOR OUTPUT USE
HRRO S2,J$GSTG(J) ;GET THE STRING
GTJFN ;MAKE IT
JRST FNDL.4 ;REALLY SHOULDN'T HAPPEN
MOVEM S1,J$GJFN(J) ;SAVE THE JFN
POPJ P, ;AND RETURN
FNDL.4: OFF S,JOBLOG ;MAKE NO LOG FILE
POPJ P, ;AND RETURN
> ;END IFN FTJSYS
IFN FTUUOS,<
FNDL.2: ON S,JOBLOG ;THERE IS A LOG FILE
LOAD T3,.FPSIZ(T1),FP.FHD ;GET SIZE OF THE FP
LOAD T4,.FPSIZ(T1),FP.FFS ;GET SIZE OF FD
SUBI T4,FDMSIZ ;SUB THE MIN, YIELDING #SFDS
ADD T1,T3 ;AND POINT TO THE FD
MOVEI T2,.RBPRV ;GET SIZE OF UUO BLOCK
MOVEM T2,J$GUUO+.RBCNT(J) ;AND SAVE THE BLOCK SIZE
LOAD T2,.FDNAM(T1) ;GET THE FILE NAME
MOVEM T2,J$GUUO+.RBNAM(J) ;AND SAVE IT
LOAD T2,.FDEXT(T1) ;GET THE EXTENSION
HLLZM T2,J$GUUO+.RBEXT(J) ;AND SAVE IT
MOVSI T2,J$GPAT(J) ;GET ADDRESS OF PATH BLOCK
HRRI T2,J$GPAT+1(J) ;AND MAKE A BLT POINTER
CLEARM J$GPAT(J) ;CLEAR THE FIRST WORD
BLT T2,J$GPAT+7(J) ;AND ZERO THE BLOCK OUT
MOVEI T2,J$GPAT+2(J) ;SETUP TO BLT THE PATH
HRLI T2,.FDPPN(T1) ;T2 HAS A BLT POINTER
ADD T4,J ;T4 HAD NUMBER OF SFDS
BLT T2,J$GPAT+2(T4) ;AND BLT THE PATH
MOVEI T2,J$GPAT(J) ;GET ADDRESS OF PATH BLOCK
SKIPN J$GPAT+3(J) ;IS THERE AN SFD?
MOVE T2,J$GPAT+2(J) ;NO, GET THE PPN
MOVEM T2,J$GUUO+.RBPPN(J) ;AND SAVE IN LOOKUP BLOCK
MOVX T2,FO.PRV+.FOAPP+<LOGF>B17;APPEND AND USE MY PRIVS ON CHN LOGF
MOVEM T2,J$GFLP+.FOFNC(J) ;STORE THE FUNCTION
MOVEI T2,.IOASC ;ASCII MODE
MOVEM T2,J$GFLP+.FOIOS(J) ;STORE IT
LOAD T2,.FDSTR(T1) ;GET THE STRUCTURE
MOVEM T2,J$GFLP+.FODEV(J) ;AND STORE IT
MOVSI T2,J$GBRH(J) ;OBUF,,0
MOVEM T2,J$GFLP+.FOBRH(J) ;SAVE IT
MOVSI T2,1 ;ONE OUTPUT BUFFER
MOVEM T2,J$GFLP+.FONBF(J) ;SAVE IT
MOVEI T2,J$GUUO(J) ;ADDRESS OF LOOKUP BLOCK
MOVEM T2,J$GFLP+.FOLEB(J) ;STORE IT
POPJ P, ;AND RETURN
> ;END IFN FTUUOS
SUBTTL STALOG -- Put startup messages in the log
STALOG: STAMP LPDAT ;PUT IN A DATE STAMP
TELL LOG,%%LSJ ;AND AN INTRO MESSAGE
STAMP LPDAT ;ANOTHER STAMP
MOVE T1,.EQJOB(J) ;GET JOB NAME
LOAD N,.EQSEQ(J),EQ.SEQ ;AND THE SEQUENCE NUMBER
TELL LOG,%%SJS ;AND GIVE JOB INFO
MOVE T1,.EQAFT(J) ;GET REQUEST CREATED TIME
PUSHJ P,PRDTA ;PRINT IT
MOVEI C,"]" ;AND A CLOSE BRACKET
PUSHJ P,SEND ;SEND IT
TELL LOG,CRLF ;SEND A CRLF
POPJ P, ;AND RETURN
SUBTTL CHRLOG -- Type a character in the log file
;CALL WITH THE CHARACTER TO TYPE IN ACCUMULATOR C. ASSUMES THAT
; THE LOG IS OPEN FOR WRITING.
IFN FTUUOS,<
CHRLOG: TXNN S,JOBLOG ;IS THERE A LOG FILE?
JRST CHRL.2 ;NO, USE INTERNAL LOG
SOSG J$GBCT(J) ;ANY ROOM IN THE BUFFER?
PUSHJ P,CHRL.1 ;NO, ADVANCE
IDPB C,J$GBPT(J) ;DEPOSIT A BYTE
POPJ P, ;AND RETURN
CHRL.1: OUT LOGF, ;OUTPUT THE BUFFER
POPJ P, ;AND RETURN
TELL OPR!USR,%%EWL ;ERROR WRITING LOG
OFF S,JOBLOG ;NO MORE LOG FILE
POPJ P, ;AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
CHRLOG: TXNN S,JOBLOG ;IS THERE A LOG?
JRST CHRL.2 ;NO, USE INTERNAL LOG
MOVE S1,J$GJFN(J) ;GET THE JFN
MOVE S2,C ;GET THE CHARACTER
BOUT ;OUTPUT IT
POPJ P, ;AND RETURN
> ;END IFN FTJSYS
;HERE TO PLACE A CHARACTER IN THE INTERNAL LOG
CHRL.2: SOSGE J$GIBC(J) ;IS THERE ROOM?
JRST CHRL.3 ;NO, GET ANOTHER PAGE
IDPB C,J$GIBP(J) ;YES, DEPOSIT THE CHARACTER
POPJ P, ;AND RETURN
CHRL.3: PUSH P,C ;SAVE C
SETZ C, ;AND CLEAR IT
IDPB C,J$GIBP(J) ;TERMINATE WILL A NULL
PUSHJ P,BUFLOG ;GET ANOTHER PAGE
POP P,C ;RESOTRE C
JRST CHRL.2 ;AND TRY AGAIN
SUBTTL STPLOG -- Timestamp the LOG File
;SUBROUTINE TO PUT A TIME STAMP IN THE LOG
;
;CALLED BY THE STAMP LUUO
STPLOG: PUSH P,.JBUUO## ;SAVE THE UUO ON THE STACK
PUSHJ P,OPNLOG ;OPEN THE LOG FILE UP
LDB P2,PS ;SAVE SOME BITS FROM
MOVEI P1,LOG ; THE STATUS AC AND
DPB P1,PS ; PUT IN OUR OWN BITS
PUSHJ P,PRTIME ;PRINT THE TIME
HRRZ T1,0(P) ;GET ADR OF STAMP
MOVE T1,(T1) ;GET THE STAMP
MOVEI C," " ;PRINT A SPACE
PUSHJ P,SEND ;..
PUSHJ P,SIXOUT ;PRINT THE KEY WORD
MOVEI C,11 ;PRINT A TAB
PUSHJ P,SEND ; ..
POP P,0(P) ;CLEAR TOP OF STACK
AOS J$GNLN(J) ;ONE MORE LINE
POPJ P,0 ;AND RETURN
LPMSG: SIXBIT /LPMSG/
LPDAT: SIXBIT /LPDAT/
LPOPR: SIXBIT /LPOPR/
LPERR: SIXBIT /LPERR/
LPSUM: SIXBIT /LPSUM/
SUBTTL OPNLOG -- Open the LOG File
;CALLED TO OPEN THE LOG FILE AND APPEND TO IT
IFN FTUUOS,<
OPNLOG: TXNE S,JOBLOG ;IS THERE A LOG FILE?
TXNE S,LOGOPN ;YES, IS IT OPEN ALREADY?
POPJ P, ;NO LOG, OR ITS OPEN ALREADY - RETURN
MOVE S2,J$GBUF(J) ;GET ADDRESS OF LOG BUFFER
EXCH S2,.JBFF ;FAKE OUT THE MONITOR
MOVEI S1,J$GFLP(J) ;GET ADDRESS OF FILOP BLOCK
HRLI S1,6 ;AND BLOCK LENGTH
FILOP. S1, ;OPEN THE FILE
JRST OPNL.1 ;CAN'T DO IT?
MOVEM S2,.JBFF ;RESTORE JOBFF
ON S,LOGOPN ;ITS OPEN
POPJ P, ;RETURN
OPNL.1: MOVEM S2,.JBFF ;RESTORE JOBFF
PJRST RIDLOG ;CLOSE OFF LOG AND GET RID OF IT
> ;END IFN FTUUOS
IFN FTJSYS,<
OPNLOG: TXNE S,JOBLOG ;IS THERE A LOG FILE
TXNE S,LOGOPN ;WHICH IS NOT OPEN
POPJ P, ;NO
MOVE S1,J$GJFN(J) ;GET THE JFN
MOVX S2,<7B5+OF%APP> ;7 BIT BYTES, APPEND
OPENF ;OPEN IT
PJRST RIDLOG ;LOSE, GET RID OF LOG
ON S,LOGOPN ;FLAG SUCCESS
POPJ P, ;AND RETURN
> ;END IFN FTJSYS
SUBTTL CLSLOG -- Close the LOG File
;ROUTINE TO CLOSE OFF THE LOG FILE, DUMPING ALL BUFFERS ETC.
IFN FTUUOS,<
CLSLOG: CLOSE LOGF, ;CLOSE THE CHANNEL
OFF S,LOGOPN ;CLEAR THE FLAG
POPJ P, ;AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
CLSLOG: TXC S,JOBLOG!LOGOPN ;COMPLEMENT THESE TWO BITS
TXCE S,JOBLOG!LOGOPN ;RE-COMPLEMENT AND TEST
POPJ P, ;NOTHING TO CLOSE
MOVE S1,J$GJFN(J) ;GET THE LOG'S JFN
TXO S1,1B0 ;SET "DON'T" RELEASE THE JFN
CLOSF ;CLOSE THE FILE
JFCL ;IGNORE ANY ERRORS
OFF S,LOGOPN ;CLEAR THE FLAG
POPJ P, ;AND RETURN
> ;END IFN FTJSYS
SUBTTL RIDLOG -- Release the LOG File
;ROUTINE TO RELEASE THE LOG FILE, DUMPING ALL BUFFERS ETC.
IFN FTUUOS,<
RIDLOG: TXNN S,JOBLOG ;IS THERE A LOG?
POPJ P, ;NO, JUST RETURN
RELEAS LOGF, ;RELEASE THE CHANNEL
OFF S,LOGOPN!JOBLOG ;CLEAR THE FLAGS
SETZM J$GNLN(J) ;CLEAR LINE COUNT
POPJ P, ;AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
RIDLOG: TXNN S,JOBLOG ;IS THERE A LOG?
POPJ P, ;NOTHING TO CLOSE
PUSHJ P,CLSLOG ;MAKE SURE ITS CLOSED
MOVE S1,J$GJFN(J) ;GET THE LOG'S JFN
RLJFN ;RELEASE THE JFN
JFCL ;IGNORE ANY ERRORS
OFF S,LOGOPN!JOBLOG ;CLEAR THE FLAGS
SETZM J$GNLN(J) ;CLEAR THE LINE COUNT
POPJ P, ;AND RETURN
> ;END IFN FTJSYS
SUBTTL BUFLOG -- Get a buffer page for LOG
BUFLOG: PUSHJ P,.SAVE1## ;SAVE P1
AOS P1,J$GINP(J) ;INCREMENT BUFFER PAGE COUNT
CAIL P1,^D10 ;WITHIN RANGE?
HALT ;NO, DIE FOR NOW
PUSHJ P,M$ACQP## ;GET A PAGE
PG2ADR AP ;MAKE AN ADDRESS
ADDI P1,-1(J) ;POINT TO LOCATION IN J$GBUF
MOVEM AP,J$GBUF(P1) ;STORE THE ADDRESS
HRLI AP,(POINT 7,0) ;MAKE A BYTE POINTER
MOVEM AP,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 CLNLOG -- Cleanup the LOG File buffers
CLNLOG: PUSHJ P,.SAVE2## ;SAVE P1 AND P2
MOVE P1,J$GINP(J) ;GET NUMBER OF PAGES IN P1
MOVEI P2,J$GBUF(J) ;GET ADR OF ADR OF 1ST PAGE IN P2
CLNL.1: JUMPE P1,.POPJ## ;DONE IF NO MORE PAGES
MOVE AP,0(P2) ;GET ADDRESS OF PAGE
ADR2PG AP ;MAKE A PAGE NUMBER
PUSHJ P,M$RELP## ;RETURN IT
SOJ P1, ;DECREMENT PAGE COUNT
AOJA P2,CLNL.1 ;BUMP POINTER AND LOOP
SUBTTL Utility Routines
; SUSPND -- ROUTINE TO SUSPEND JOB FOR TIME PERIOD
; SNDSTC -- SEND A STATUS CHANGE
; SETHEL -- SETUP A HELLO BLOCK
LOWSEG ;THESE ARE IN THE LOWSEG
SUBTTL SUSPND -- Suspend job for a given length of time
;CALL WITH THE NUMBER OF SECONDS IN S1
IFN FTUUOS,<
SUSPND: IMULI S1,^D1000 ;CONVERT TO MILLISECS
HIBER S1, ;AND SLEEP
HALT
POPJ P, ;AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
SUSPND: IMULI S1,^D1000 ;CONVERT TO MILLISECS
SETOM BLOKED ;WE ARE SLEEPING
SKIPN AWOKEN ;INTERRUPTED SINCE LAST INSTRUCTION?
DISMS ;SLEEP
JFCL ;**DO NOT REMOVE THIS INSTRUCTION**
SUSP.1: SETZM AWOKEN ;WE ARE UP
SETZM BLOKED ;INSURE THAT EVERYONE KNOWS IT
POPJ P, ;AND RETURN
> ;END IFN FTJSYS
SUBTTL Subroutines -- Send a Status Change
;SNDSTC CALLS SETHEL TO SETUP THE HELLO BLOCK, ORS IN THE STATUS
; CHANGE FLAG, AND SENDS IT TO QUASAR.
;SNDSTC WILL TURN OFF THE SCHEDULING BIT IF EITHER RUNB IS OFF OR
; PAUSEB IS ON.
SNDSTC: TXNN S,STARTD ;ARE WE STARTED?
POPJ P, ;NO, WE ARE NOT KNOWN COMPONENT
PUSHJ P,SETHEL ;SET UP THE HELLO BLOCK
MOVX T1,HELSTC ;GET THE STATUS CHANGE FLAG
IORM T1,MSGBLK+HEL.ST ;STORE IT IN
MOVX T1,HELSCH ;LOAD THE BIT
TXNE S,RUNB ;IS RUNB OFF?
TXNE S,PAUSEB ;NO, IS PAUSEB ON?
ANDCAM T1,MSGBLK+HEL.ST ;YES, CLEAR THE BIT
MOVEI T1,MSGBLK ;LOAD ADDRESS OF HELLO BLOCK
PJRST SNDQSR## ;AND SEND IT OFF
SUBTTL Subroutines -- Setup HELLO Block
;SETHEL SETS UP THE ENTIRE HELLO BLOCK EXCEPT FOR THE STATUS WORD.
; IT CORRECTLY SETS THE HELSCH, HELFRZ, HELLLP BITS IN THE STATUS WORD.
SETHEL: MOVX T1,<HEL.SZ,,.QOHEL> ;GET LENGTH,,FUNCTION
MOVEM T1,MSGBLK ;SAVE AS FIRST WORD
MOVX T1,'LPTSPL' ;GET PROGRAM NAME
MOVEM T1,MSGBLK+HEL.NM ;SAVE IT
MOVE T1,J$LSDV(J) ;GET SCHEDULING DEVICE
MOVEM T1,MSGBLK+HEL.SD ;SAVE IT
MOVE T1,J$LDEV(J) ;GET PHYSICAL DEVICE NAME
MOVEM T1,MSGBLK+HEL.PD ;SAVE PROCESSING DEVICE
MOVE T1,J$FSFM(J) ;GET SCHEDULING FORMS
MOVEM T1,MSGBLK+HEL.I1 ;SAVE IT
MOVS T1,J$XMLM(J) ;GET MLIMIT,,0
HRR T1,NXTJOB ;GET MLIMIT,,NXTJOB
MOVEM T1,MSGBLK+HEL.I2 ;SAVE IT
SETZM MSGBLK+HEL.I3 ;CLEAR UNUSED WORD
MOVEI T1,%%.QSR ;START WITH NO FLAGS,,VERSION
TXNE S,FROZE ;ARE FORMS FROZEN?
TXO T1,HELFRZ ;YES, OR IN THE FREEZE BIT
TXNE S,STARTD ;HAS HE SAID START?
TXO T1,HELSCH ;YES, SET SCHEDUABLE BIT
SKIPE J$LLCL(J) ;IS IT A LOWER CASE PRINTER?
TXO T1,HELLLP ;YES, SET THE FLAG
TXO T1,HELRDE ;ALSE, WE CAN HANDLE RDE JOBS
MOVEM T1,MSGBLK+HEL.ST ;STORE IT
MOVE T1,MYSTA ;GET MY STATION NUMBER
STORE T1,MSGBLK+HEL.ST,HELDSN ;STORE AS DEFAULT
POPJ P, ;AND RETURN
SUBTTL Disk File Input Routines
; FILL -- FILL THE INPUT BUFFER
; SETEOF -- CAUSE EOF ON NEXT INPUT
; REWIND -- REWIND THE INPUT FILE
; DSKIN -- READ A BYTE FROM THE INPUT FILE
; SETRMS -- SETUP TO MAKE AN RMS CALL
; RMSERR -- SET AN RMS ERROR
LOWSEG ;THESE ARE IN THE LOWSEG
SUBTTL FILL - Fill the input buffer
;SUBROUTINE TO FILL DISK INPUT BUFFER
;CALL WITH:
; PUSHJ P,FILL
; EOF RETURN
; DATA RETURN
IFN FTUUOS,<
FILL: PUSHJ P,CHKQUE ;SEE IF WE'VE RECEIVED ANY MSGS
SKIPE J$XSBC(J) ;IS THERE A SAVED BYTE COUNT?
JRST FILLB ;YES, XCT FAST BACKSPACE CODE
AOS J$DINF(J) ;INCREMENT BLOCK COUNT
IN DSK, ;READ BLOCK
PJRST .POPJ1## ;SKIP BACK OK
JRST FILL1 ;I/O ERROR
FILLB: PUSHJ P,.SAVE2## ;SAVE P1 AND P2
MOVSI P1,(IN DSK,) ;LOAD THE UUO
HRR P1,J$DBRH(J) ;MAKE BELIEVE WE'RE CHANGING RINGS
XCT P1 ;DO THE UUO
SKIPA ;WIN!!
JRST FILL1 ;LOSE
MOVE P1,J$XSBC(J) ;GET SAVED BYTE COUNT
EXCH P1,J$DBCT(J) ;SAVE IT AS BYTE COUNT, LOAD REAL ONE
SUB P1,J$XSBC(J) ;CALCULATE AN OFFSET
CLEARM J$XSBC(J) ;AND CLEAR THE FLAG
IDIVI P1,5 ;CONVERT TO WORDS
ADDM P1,J$DBPT(J) ;ADD IN WORDS
AOS J$DBPT(J) ;AND MOVE UP ONE MORE
MOVE P1,[440700
350700
260700
170700
100700](P2) ;LOAD THE BYTE OFFSET
HRLM P1,J$DBPT(J) ;STORE IT
PUSHJ P,TAKCHK ;TAKE A CHECKPOINT
PJRST .POPJ1## ;AND RETURN
;"FILL" IS CONTINUED ON THE NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
FILL1: PUSHJ P,.SAVE1## ;SAVE P1
STATZ DSK,IO.EOF ;END OF FILE?
POPJ P, ;YES, TAKE NON-SKIP
GETSTS DSK,N ;NO, GET DEVICE STATUS
MOVE P1,N ;GET STATUS INTO P1
STAMP LPERR ;GIVE A STAMP
TELL LOG,%%IDE ;GIVE A MESSAGE
SKIPE MSGERR ;SHOULD OPR SEE?
TELL OPR,%%IDE ;YES, SHOW HIM
TXZ P1,IO.ERR ;TURN OFF ERROR BITS
SETSTS DSK,(P1) ;AND SET STATUS
SOSLE J$DERR(J) ;TOO MANY??
JRST .POPJ1## ;NO, RETURN OK
TELL LOG,%%FSD
SKIPE MSGERR
TELL OPR,%%FSD
MOVEI P1,1 ;MAKE THIS THE LAST COPY
MOVEM P1,J$XCOP(J) ;AND STORE IT SO WE DON'T REPRINT IT
POPJ P, ;YES, PUNT
> ;END IFN FTUUOS
IFN FTJSYS,<
FILL: PUSHJ P,.SAVET## ;SAVE T1-T4
PUSHJ P,CHKQUE ;SEE IF WE'VE RECEIVED ANY MESSAGES
SKIPE J$DRMS(J) ;IS IT AN RMS FILE?
JRST FILL.3 ;YES, GO A DIFFERENT ROUTE
MOVE S1,J$DBIF(J) ;GET #BYTES LEFT TO READ
JUMPE S1,.POPJ## ;NONE, EOF!!
CAIL S1,1000 ;LESS THAN A FULL PAGE?
JRST FILL.1 ;NO, CONTINUE
SETZM J$DBIF(J) ;YES, CAUSE EOF ON NEXT ONE
JRST FILL.2 ;AND MEET AT THE PASS
FILL.1: MOVNI T1,1000 ;LOAD NEGATIVE NUMBER OF WORDS
ADDM T1,J$DBIF(J) ;AND DECREMENT NUMBER LEFT
MOVN S1,T1 ;AND GET NUMBER BACK
FILL.2: MOVN T1,S1 ;GET NEGATIVE WORD COUNT
HRRZ T2,J$DMOD(J) ;GET BYTES/WORD
IMUL S1,T2 ;CONVERT TO NUMBER OF BYTES
MOVEM S1,J$DBCT(J) ;AND STORE FOR PRINTING LOOP
MOVE S1,J$DJFN(J) ;GET THE JFN
MOVE S2,J$DBUF(J) ;GET POINTER TO THE BUFFER
HRLI S2,(POINT 36,0) ;AND MAKE A BYTE POINTER
SIN ;GET THE DATA
MOVE S1,J$DBUF(J) ;GET ADDRESS OF BUFFER
HLL S1,J$DMOD(J) ;MAKE A BYTE POINTER
MOVEM S1,J$DBPT(J) ;STORE IT
AOS J$DINF(J) ;INCREMENT PAGE COUNT
PJRST .POPJ1## ;AND SKIP BACK
FILL.3: SKIPN J$DBIF(J) ;WAS EOF SET EXTERNALLY?
POPJ P, ;YES, RETURN EOF
PUSHJ P,SETRMS ;SETUP TO CALL RMS
MOVEI AP,J$DRAB(J) ;GET ADDRESS OF THE RAB
$GET <(AP)>,RMSERR ;GET A RECORD
SKIPE J$DRME(J) ;AN ERROR?
POPJ P, ;YES, ASSUME EOF
SKIPGE S1,J$DRFA(J) ;GET FIRST RFA IF SET
$LDRAB S1,RFA ;NOT SET, GET THIS ONE
MOVEM S1,J$DRFA(J) ;SET FIRST RFA
$LDRAB S1,RSZ ;GET THE RECORD SIZE
PJUMPE S1,.POPJ## ;RETURN EOF IF ZERO
MOVEM S1,J$DBCT(J) ;ELSE SAVE BYTE COUNT
$LDRAB S1,RBF ;LOAD ADDRESS OF RECORD
HLL S1,J$DMOD(J) ;MAKE A BYTE POINTER
MOVEM S1,J$DBPT(J) ;STORE IT
PJRST .POPJ1## ;AND RETURN
> ;END IFN FTJSYS
SUBTTL SETEOF - Cause EOF on next input
;SUBROUTINE TO CAUSE "EOF" TO BE RETURNED ON THE NEXT INPUT CHARACTER
;
;CALL:
; PUSHJ P,SETEOF
; ALWAYS RETURN HERE
IFN FTUUOS,<
SETEOF: TXNN S,DSKOPN ;IS THE DISK-FILE OPEN?
POPJ P, ;NO, JUST RETURN
USETI DSK,-1 ;YES, DO THE USETI
IN DSK, ;AND CLEEAR BUFFERS AHEAD
JRST .-1 ;GET ALL BUFFERS
SETOM J$DBCT(J) ;CAUSE THE SOSG TO FAIL
POPJ P, ;AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
SETEOF: SETZM J$DBIF(J) ;0 BYTES LEFT IN THE FILE
SETZM J$DBCT(J) ;0 BYTES LEFT IN CURRENT BUFFER
POPJ P, ;AND RETURN
> ;END IFN FTJSYS
SUBTTL REWIND - Rewind the input file
;REWIND IS CALLED THE REWIND THE INPUT FILE (I.E CAUSE
; SUBSEQUENT READS TO COME FROM THE BEGINNING OF THE
; FILE).
;CALL:
; PUSHJ P,REWIND
; ALWAYS RETURN HERE
IFN FTUUOS,<
REWIND: PUSHJ P,SETEOF ;CLEAR ALL BUFFERING AHEAD
TXNE S,DSKOPN ;IS THE FILE OPEN?
USETI DSK,1 ;YES, REWIND IT
SETOM J$DBCT(J) ;IGNORE CURRENT BUFFER
PUSHJ P,CLRTAB ;CLEAR BACKSPACE TABLE
SETZM J$DINF(J) ;CLEAR INFO WORD
POPJ P, ;AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
REWIND: TXNN S,DSKOPN ;IS THE FILE OPEN?
POPJ P, ;NO, JUST RETURN
SKIPE J$DRMS(J) ;RMS FILE?
JRST REWI.1 ;YES, DO DIFFERENT THINGS
MOVE S1,J$DJFN(J) ;YES, GET THE JFN
SETZ S2, ;SET POINTER TO BYTE 0
SFPTR ;DO IT!!
HALT
SETZM J$DINF(J) ;CLEAR INFO WORD
MOVEI S1,^D36 ;LOAD A 36
LDB S2,[POINT 6,J$DFDB+.FBBYV(J),11]
IDIV S1,S2 ;GET 36/<FILES BYTE SIZE>
MOVE S2,J$DFDB+.FBSIZ(J) ;GET SIZE OF FILE
IDIV S2,S1 ;CONVERT TO # 36BIT BYTES
SKIPE S2+1 ;ANY RESIDUE?
AOS S2 ;YES ADD ANOTHER WORD
MOVEM S2,J$DBIF(J) ;AND INITIALIZE THE COUNTER
SETZM J$DBCT(J) ;AND THE BUFFER
POPJ P, ;AND RETURN
REWI.1: SETOM J$DBIF(J) ;CLEAR EOF INDICATOR
SKIPGE S1,J$DRFA(J) ;GET RFA OF FIRST RECORD
POPJ P, ;FIRST TIME THRU, JUST RETURN
$STRAB S1,RFA ;STORE THE RFA
MOVX S1,RB$RFA ;FIND BY RFA
$STRAB S1,RAC ;STORE NEW RECORD ACCESS
PUSHJ P,SETRMS ;SETUP TO CALL RMS
MOVEI AP,J$DRAB(J) ;LOAD ADDRESS OF RAB
$FIND <(AP)>,RMSERR ;FIND THE RECORD
MOVX S1,RB$SEQ ;SEQUENTIAL ACCESS
$STRAB S1,RAC ;STORE IT
POPJ P, ;AND RETURN
> ;END IFN FTJSYS
SUBTTL DSKIN - Read a byte from the input file
;DSKIN IS CALLED TO READ THE NEXT BYTE FROM THE INPUT FILE. IN
; MOST CASES EACH ROUTINE PERFORMS THE SOSG LOOP ITSELF FOR
; THE SAKE OF EFFICIENCY SINCE THE PUSHJ/POPJ PAIR TO CALL
; THIS ROUTINE ON EVERY CHARACTER IS EXPENSIVE. HOWEVER, IN
; THE CASES WHERE EFFICIENCY IS NOT AN ISSUE, THIS ROUTINE CAN
; BE USED.
;RETURNS WITH NEXT BYTE IN ACCUMULATOR "C".
;
;CALL:
; PUSHJ P,DSKIN
; RETURN HERE ON EOF
; RETURN HERE NORMALLY
DSKIN: SOSLE J$DBCT(J) ;COUNT DOWN WORDS
JRST DSKI.1 ;SOME LEFT
PUSHJ P,FILL ;REFILL
POPJ P,
DSKI.1: ILDB C,J$DBPT(J) ;GET A CHAR
JRST .POPJ1## ;RETURN
SUBTTL SETRMS - RMSERR - RMS Interface Routines
IFN FTJSYS,<
;CALL SETRMS BEFORE EXECUTING ANY RMS MACRO TO CLEAR THE ERROR INDICATOR
SETRMS: SETZM J$DRME(J) ;CLEAR THE ERROR FLAG
POPJ P, ;AND RETURN
;RMSERR SHOULD BE THE ERROR ADDRESS ON ALL RMS MACRO CALLS. RMS WILL
; CALL RMSERR ON AN ERROR. ON RETURN FROM AN RMS CALL, J$DRME
; WILL BE -1 IF AN ERROR OCCURED, AND S1 WILL CONTAIN THE ERROR
; CODE.
RMSERR: SETOM J$DRME(J) ;SET THE ERROR
POPJ P, ;AND RETURN
> ;END IFN FTJSYS
SUBTTL Forms MOUNT Routines
;SUBROUTINE TO ASK OPR TO CHANGE OUTPUT FORMS
;CALL WITH:
; PUSHJ P,MOUNT
; RETURN HERE WITH DEVICE READY
TOPSEG ;PUT THIS IN THE HISEG
MOUNT: SKIPGE FMNEW ;HAVE WE RE-READ LPFORM.INI?
PUSHJ P,FRMINI ;YES, REINIT FORMS PARAMETERS
SETZM FMNEW ;CLEAR THE FLAG
MOVE T1,J$FORM(J) ;GET CURRENT FORMS
MOVEM T1,J$FPFM(J) ;SAVE AS OLD FORMS TYPE
MOVE T1,.EQLM1(J) ;GET FORMS TYPE
MOVEM T1,J$FSFM(J) ;SAVE AS SCHEDULED TYPE
CAMN T1,J$FORM(J) ;SAME AS CURRENTLY MOUNTED?
POPJ P, ;YES, RETURN
MOVEM T1,J$FORM(J) ;SAVE NEW FORMS TYPE
XOR T1,J$FPFM(J) ;XOR WITH OLD ONES
TXZ T1,FRMSK2 ;ZAP INSIGNIFICANT BITS
JUMPE T1,MOUNT0 ;THE SAME, DON'T TELL OPR
MOVE T1,J$FORM(J) ;LOAD FORMS NAME AGAIN
TELL OPR,MOUNTM ;ASK OPR TO MOUNT 'EM
ON S,MNTBIT ;FLAG THAT WE WAIT
MOUNT0: PUSHJ P,FRMINI ;INITIALIZE FORMS
TXNN S,MNTBIT ;DO WE WAIT FOR OPR?
POPJ P, ;NO, JUST RETURN
MOUNT1: SKIPE J$LHNG(J) ;IS THE DEVICE OFF-LINE?
JRST MOUNT2 ;YES, FORGET THE FORMFEED
PUSHJ P,SENDFF ;SEND A FORMFEED
PUSHJ P,OUTDMP ;AND DUMP IT OUT
MOUNT2: OFF S,RUNB ;TURN OFF RUN FLAG
TELL OPR,STAR ;AND TYPE A STAR
MOVEI T1,<AUTTIM>-1 ;LOAD NUMBER OF SLEEPS
MOUNT3: JUMPE T1,MOUNT4 ;TIMEOUT IF ZERO
MOVEI S1,^D60 ;1 MINUTE
PUSHJ P,SUSPND ;DO IT
SKIPN TTYFLG ;DID OPR TYPE SOMETHING?
SOJA T1,MOUNT3 ;DECREMENT COUNT AND LOOP
PUSHJ P,CHKOPR ;WAIT FOR A GO COMMAND
PJRST LODVFU ;LOAD THE VFU AND RETURN
MOUNT4: TELLN OPR,WAITED ;I TRIED!!
PUSHJ P,FREEZE ;FREEZE FORMS
JRST REQUE ;AND REQUE IT
WAITED: ASCIZ /[Automatically requeuing job and Freezing forms]
/
SUBTTL Special Forms Handler
FRMINI: PUSHJ P,SETDFF ;SET DEFAULT PARAMTERS
SKIPN C,FMADR ;IS THERE AN LPFORM.INI?
POPJ P, ;NO, JUST RETURN
HRLI C,440700 ;YES, MAKE A BYTE POINTER
MOVEM C,FMBPT ;AND SAVE IT
PUSHJ P,FRMIN1 ;DO EVERYTHING
PJRST LODVFU ;LOAD THE VFU AND RETURN
FRMIN1: PUSHJ P,FH$SIX ;GET THE FORMS NAME
POPJ P, ;EOF!!
CAMN T1,J$FORM(J) ;MATCH??
JRST FRMIN2 ;YES!!
FRMI1A: PUSHJ P,FH$EOL ;NO, FIND NEXT LINE
POPJ P, ;EOF!!
JRST FRMIN1 ;AND LOOP
FRMIN2: CAIN C,"/" ;BEGINNING OF SWITCH?
JRST FRMIN5 ;YES, LOCATOR IS "ALL"
CAIN C,":" ;BEGINNING OF LOCATOR?
JRST FRMIN3 ;YES, GO GET IT
CAIN C,.CHLFD ;EOL?
JRST FRMIN1 ;YES, GO THE NEXT LINE
PUSHJ P,FH$CHR ;ELSE, GET A CHARACTER
POPJ P, ;EOF
JRST FRMIN2 ;AND LOOP
FRMIN3: PUSHJ P,FH$SIX ;GET A LOCATOR
POPJ P, ;EOF!!
JUMPE T1,FRMI3A ;MAYBE PAREN??
JRST FRMIN4 ;AND DO THE LIST
FRMI3A: CAIN C,"/" ;A SWITCH?
JRST FRMIN5 ;YES!
CAIE C,"(" ;A LIST?
JRST FRMIN9 ;NO, ERROR
FRMIN4: HLRZ T2,T1 ;GET THE FIRST THREE CHARS
CAIN T2,'ALL' ;IS IT "ALL"?
JRST FRMIN5 ;YES, STOP CHECKING
CAIN T2,'LOC' ;IS IT LOCAL?
SKIPGE J$LREM(J) ;YES, ARE WE?
SKIPA ;NO, NO
JRST FRMIN5 ;YES, YES!
CAIN T2,'REM' ;DOES IT SAY "REMOTE"?
SKIPL J$LREM(J) ;YES, ARE WE REMOTE
SKIPA ;NO!!!
JRST FRMIN5 ;YES!!
CAIE T2,'LPT' ;IS IT "LPT"
JRST FRMI4B ;NO, TRY ONE LAST THING
CAMN T1,J$LDEV(J) ;COMPARE TO OUR DEVNAM
JRST FRMIN5 ;MATCH!!
CAMN T1,J$LGNM(J) ;NO, TRY GIVEN NAME
JRST FRMIN5 ;WIN!!
FRMI4B: CAIN C,.CHLFD ;BREAK ON EOL?
JRST FRMIN1 ;YES, GET NEXT LINE
CAIE C,"/" ;IS IT A SLASH?
CAIN C,")" ;NO, CLOSE PAREN?
JRST FRMI1A ;YES, GET THE NEXT LINE
PUSHJ P,FH$SIX ;ELSE, GET THE NEXT LOCATOR
POPJ P, ;EOF, RETURN
JUMPE T1,FRMIN9 ;BAD FORMAT
JRST FRMIN4 ;AND LOOP AROUND
;GET HERE IF THIS LINE IS FOR US
FRMIN5: CAIN C,.CHLFD ;WAS THE LAST CHARACTER A LINEFEED?
POPJ P, ;YES, RETURN
CAIN C,"/" ;ARE WE AT THE BEGINNING OF A SWITCH?
JRST FRMI5A ;YES, DO IT!
PUSHJ P,FH$CHR ;NO, GET A CHARACTER
POPJ P, ;EOF!!
JRST FRMIN5 ;AND LOOP AROUND
FRMI5A: PUSHJ P,FH$SIX ;GET THE SWITCH
POPJ P, ;EOF!!
JUMPN T1,FRMIN6 ;JUMP IF WE'VE GOT SOMETHING
CAIN C,.CHLFD ;EOL?
POPJ P, ;YES, RETURN
JRST FRMIN5 ;ELSE, KEEP TRYING
FRMIN6: MOVE T4,T1 ;SAVE SWITCH NAME FOR LATTER
HLLZS T1 ;GET FIRST THREE CHARACTERS OF SWITCH
MOVSI T2,-F$NSW ;MAKE AOBJN POINTER
FRMIN7: HLLZ T3,FFNAMS(T2) ;GET A SWITCH NAME
CAMN T3,T1 ;MATCH??
JRST FRMIN8 ;YES, DISPATCH
AOBJN T2,FRMIN7 ;NO, LOOP
MOVE T4,T1 ;GET SWITCH NAME
TELL OPR,[ASCIZ /Unrecognized switch + in LPFORM.INI ignored
/]
JRST FRMIN5 ;AND LOOP
FRMIN8: HRRZ T3,FFNAMS(T2) ;GET DISPATCH ADDRESS
PUSHJ P,(T3) ;GO!!
JRST FRMIN5 ;AND LOOP
FRMIN9: TELLN OPR,[ASCIZ /Bad format in LPFORM.INI
/]
POPJ P, ;AND RETURN
SUBTTL Forms Switch Subroutines
S$BANN: PUSHJ P,FH$DEC ;GET DECIMAL ARGUMENT
MOVEM T1,J$FBAN(J) ;STORE IT
POPJ P, ;AND RETURN
S$TRAI: PUSHJ P,FH$DEC ;GET DECIMAL ARGUMENT
MOVEM T1,J$FTRA(J) ;STORE IT
POPJ P, ;AND RETURN
S$HEAD: PUSHJ P,FH$DEC ;GET A DECIMAL ARGUMENT
MOVEM T1,J$FHEA(J) ;STORE IT
POPJ P, ;AND RETURN
S$LINE: PUSHJ P,FH$DEC ;GET DECIMAL ARGMENT
MOVEM T1,J$FLIN(J) ;STORE IT
POPJ P, ;AND RETURN
S$WIDT: PUSHJ P,FH$DEC ;GET DECIMAL ARGUMENT
MOVEM T1,J$FWID(J) ;SAVE IT
MOVEI T2,3 ;ASSUME WIDTH CLASS 3
MOVEM T2,J$FWCL(J) ;SAVE WIDTH CLASS
CAIG T1,F$CL2 ;LE CLASS 2 LIMIT?
SOS J$FWCL(J) ;YES, DECREMENT
CAIG T1,F$CL1 ;LE CLASS 1 LIMIT
SOS J$FWCL(J) ;YES, DECREMENT AGAIN!
POPJ P, ;AND RETURN
S$RIBB: PUSHJ P,FH$SIX ;GET SIXBIT ARGUMENT
POPJ P, ;EOF
TELL OPR,[ASCIZ /Ribbon: +
/]
MOVEM T1,J$FRIB(J) ;SAVE IT
POPJ P, ;AND RETURN
S$DRUM:
S$CHAI: PUSHJ P,FH$SIX ;GET SIXBIT ARG
POPJ P, ;EOF!
TELL OPR,[ASCIZ /Drum (chain): +
/]
MOVEM T1,J$FDRU(J) ;SAVE IT
POPJ P, ;AND RETURN
S$NOTE: MOVEI T1,J$FNBK(J) ;ADDRESS OF NOTE BLOCK
MOVEM T1,J$FNOT(J) ;IS THE ADDRESS OF THE NOTE
MOVE T1,[POINT 7,J$FNBK+2(J)]
CLEAR T2, ;T1 IS POINTER, T2 IS COUNTER
MOVE C,[ASCII /[NOTE/]
MOVEM C,J$FNBK(J)
MOVE C,[ASCII /: /]
MOVEM C,J$FNBK+1(J)
S$NOT1: PUSHJ P,FH$CHR ;GET A CHARACTER
JRST S$NOT2 ;EOF, FINISH UP!!
CAIGE C,40 ;MAKE SURE ITS GREATER THAN SPACE
JRST S$NOT2 ;ITS NOT!, FINISH UP
CAIN C,"/" ;ALSO STOP ON SLASH
JRST S$NOT2 ;IT IS!!
IDPB C,T1 ;DEPOSIT IT
CAIGE T2,^D49 ;LOOP FOR 50 CHARACTERS
AOJA T2,S$NOT1 ;INCR AND LOOP
S$NOT2: MOVEI T2,"]" ;CLOSE BRACKET
IDPB T2,T1 ;DEPOSIT IT
MOVEI T2,.CHCRT ;LOAD A CARRIAGE RETURN
IDPB T2,T1 ;DEPOSIT IT
MOVEI T2,.CHLFD ;LOAD A LINEFEED
IDPB T2,T1 ;DEPOSIT IT
CLEAR T2, ;LOAD A NULL
IDPB T2,T1 ;DEPOSIT IT
TELLN OPR,J$FNBK(J) ;AND TYPE IT TO THE OPERATOR
POPJ P, ;AND RETURN
S$PAUS: SETOM J$FPAU(J) ;SET THE PAUSE FLAG
POPJ P, ;AND RETURN
S$WHAT: SETOM J$FWHA(J) ;SET WHAT FLAG
POPJ P, ;AND RETURN
S$ALCN: PUSHJ P,FH$DEC ;GET DECIMAL ARG
MOVEM T1,J$FALC(J) ;STORE IT
POPJ P, ;RETURN
S$ALSL: PUSHJ P,FH$DEC ;GET DECIMAL ARG
MOVEM T1,J$FALS(J) ;SAVE IT
POPJ P, ;AND RETURN
S$ALIG: PUSHJ P,FH$SIX ;GET SIXBIT ARGUMENT
POPJ P, ;EOF
MOVEM T1,J$FALI(J) ;SAVE IT
POPJ P, ;AND RETURN
S$VFU:
S$TAPE: PUSHJ P,FH$SIX ;GET SIXBIT ARGUMENT
POPJ P, ;EOF
MOVEM T1,J$FTAP(J) ;SAVE IT
MOVE T2,J$FORM(J) ;GET FORMS NAME
CAMN T2,NORMAL ;IS IT NORMAL?
MOVEM T1,D$TAPE ;YES, MAKE THIS THE DEFAULT
POPJ P, ;AND RETURN
SUBTTL LODVFU -- Load the Vertical Forms Unit
LODVFU: MOVE T1,J$FTAP(J) ;GET VFU TYPE
CAMN T1,J$FLVT(J) ;SAME AS CURRENT ONE?
POPJ P, ;YES, RETURN
SKIPE J$LDVF(J) ;NO, DOES DEVICE HAVE A DAVFU?
JRST LODV.0 ;YES, AUTO-LOAD
MOVE T1,J$FTAP(J) ;GET DESIRED TAPE
MOVE T2,T1 ;IN BOTH T1 AND T2
EXCH T2,J$FLVT(J) ;MAKE IT THE CURRENT ONE
SKIPN T2 ;IF PREVIOUS WAS NULL
CAME T1,D$TAPE ; AND THIS IS THE DEFAULT
SKIPA ; THEN
POPJ P, ;DON'T TYPE A MESSAGE
TELL OPR,[ASCIZ /Please put VFU Tape + in $
/]
ON S,MNTBIT ;CAUSE A WAIT
POPJ P, ;AND RETURN
LODV.0: TELL OPR,%%LVF ;TELL OPR WE ARE LOADING
PUSHJ P,OUTWON ;WAIT FOR ONLINE
;AND FALL INTO OS DEPENDENT CODE
IFN FTUUOS,<
MOVE T1,[2,,T2] ;ARG POINTER
MOVX T2,.DFRDS ;READ DEVICE STATUS
MOVEI T3,LPT ;FOR CHANNEL LPT
DEVOP. T1, ;DO IT
JRST NODAVF ;ASSUME NO DAVFU
TXNE T1,DF.LVE ;CURRENT VFU IN ERROR?
JRST LODV.9 ;YES, DONT SEND A FF
TXZ S,FFSEEN ;CLEAR FFSEEN
PUSHJ P,SENDFF ;SEND THE FORMFEED
PUSHJ P,OUTDMP ;AND FORCE IT OUT
LODV.9: PUSHJ P,OUTFLS ;FLUSH OUTPUT BUFFERS
MOVX T1,.IOASL ;LOAD ASCII MODE
MOVSI T2,'SYS' ;AND LOAD DEVICE
MOVEI T3,J$XVFB(J) ;AND ADDRRES OF BUFFER RING HEADER
OPEN VFC,T1 ;OPEN SYS
HALT . ;THIS REALLY SHOULDN'T HAPPEN
MOVE T1,J$FTAP(J) ;GET TAPE NAME
MOVSI T2,'VFU' ;AND EXTENSION
SETZB T3,T4 ;AND CLEAR THE REST
LOOKUP VFC,T1 ;FIND THE FILE
JRST NOVFU ;LOSE, TELL HIM
MOVE T1,[2,,T2] ;ARGS FOR DEVOP
MOVX T2,.DFENV ;ENABLE VFU LOAD
MOVEI T3,LPT ;FOR I/O CHANNEL
DEVOP. T1, ;DO IT
JRST NODAVF ;ASSUME NO DAVFU
PUSHJ P,M$ACQP## ;GET A PAGE
PUSH P,AP ;SAVE NUMBER FOR LATER
PG2ADR AP ;MAKE AN ADDRESS
EXCH AP,.JBFF ;AND FAKE OUT THE MONITOR
INBUF VFC,2 ;FOR BUFFERS
MOVEM AP,.JBFF ;RESTORE JOBFF
LODV.1: SOSGE J$XVFB+.BFCNT(J) ;COUNT DOWN
JRST LODV.2 ;GET ANOTHER BUFFER
ILDB C,J$XVFB+.BFPTR(J) ;GET A BYTE
PUSHJ P,DEVOUT ;OUTPUT IT
JRST LODV.1 ;AND LOOP
LODV.2: IN VFC, ;GET A BUFFER
JRST LODV.1 ;SUCCESS, BACK TO LOOP
PUSHJ P,OUTDMP ;FORCE OUT THE BUFFERS
MOVE T1,[2,,T2] ;LOAD ARG POINTER
MOVX T2,.DFDVL ;DISABLE VFU LOAD
MOVEI T3,LPT ;AND CHANNEL NUMBER
DEVOP. T1, ;DO IT!
JRST NODAVF ;LOSE
RELEAS VFC, ;RELEASE VFU CHANNEL
POP P,AP ;GET SCRATCH PAGE BACK
PUSHJ P,M$RELP## ;RELEASE IT
MOVE T1,J$FTAP(J) ;GET TAPE NAME
MOVEM T1,J$FLVT(J) ;SAVE AS TYPE LOADED
POPJ P, ;AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
OFF S,FFSEEN ;CLEAR FFSEEN
PUSHJ P,SENDFF ;SEND A FORM-FEED
PUSHJ P,OUTDMP ;AND FORCE IT OUT
MOVE T1,[GJBLK,,GJBLK+1] ;SETUP A BLT POINTER
SETZM GJBLK ;CLEAR THE FIRST WORD
BLT T1,GJBLK+7 ;ZERO THE BLOCK
MOVX T1,GJ%OLD ;GET THE FLAGS
MOVEM T1,GJBLK+.GJGEN ;STORE THEM
MOVE T1,DJFN ;GET I/O JFN
MOVEM T1,GJBLK+.GJSRC ;SAVE 'EM
MOVE T1,DDEV ;GET DEFAULT DEVICE
MOVEM T1,GJBLK+.GJDEV ;SAVE IT
MOVE T1,DVFU ;AND THE DEFAULT EXTENSION
MOVEM T1,GJBLK+.GJEXT ;SAVE IT
MOVE T3,[POINT 6,J$FTAP(J)] ;POINT TO THE NAME IN 6BIT
MOVE T4,[POINT 7,T1] ;POINT TO RESULT IN ASCII
SETZB T1,T2 ;CLEAR DESTINATION WORDS
LODV.1: ILDB S1,T3 ;GET A CHARACTER
JUMPE S1,LODV.2 ;NULL MEANS DONE
ADDI S1,"A"-'A' ;ELSE CONVERT TO ASCII
IDPB S1,T4 ;AND DEPOSIT IT
TLNE T3,770000 ;DONE?
JRST LODV.1 ;NO, LOOP AROUND
LODV.2: MOVEI S1,GJBLK ;POINT TO BLOCK
HRROI S2,T1 ;POINT TO STRING
GTJFN ;GET THE JFN
JRST NOVFU ;LOSE
MOVE T3,S1 ;COPY THE JFN OVER
MOVE S1,J$LJFN(J) ;GET THE LPT JFN
MOVX S2,.MOLVF ;GET LOAD VFU FUNCTION
MOVEI T1,T2 ;ADDRESS OF ARG BLOCK
MOVEI T2,2 ;LENGTH OF ARG BLOCK
MTOPR ;LOAD THE VFU
MOVE T1,J$FTAP(J) ;GET THE VFU TYPE
MOVEM T1,J$FLVT(J) ;SAVE AS CURRENTLY LOADED
POPJ P, ;AND RETURN
> ;END IFN FTJSYS
;HERE IF VFU FILE THAT WE ARE LOOKING FOR IS NOT AROUND
NOVFU: MOVE T1,J$FTAP(J) ;TYPE WE TRIED TO LOAD
CAMN T1,D$TAPE ;IS IT THE DEFAULT
JRST NOVF.1 ;YES, GIVE UP
TELL OPR,%%CFV ;CAN'T FIND VFU
JRST REQUE ;AND REQUE THE JOB
IFN FTUUOS,<
NOVF.1: TELL OPR,%%CFD ;CANT LOAD DEFAULT
MOVE T1,[2,,T2] ;ARGS FOR DEVOP
MOVEI T2,.DFLLV ;LOAD HARDWARE VFU
MOVEI T3,LPT ;FOR CHANNEL
DEVOP. T1, ;DO IT
JRST NOVF.2 ;LOSE
MOVX T1,FRMNOR ;GET NAME OF NORMAL
MOVEM T1,J$FLVT(J) ;STORE IT
POPJ P, ;AND RETURN
NOVF.2: TELL OPR,%%ELV ;ERROR?
JRST DOREST ;RESET, I GUESS
;HERE WHEN DEVOP FAILS...CLEAR DAVFU FLAG AND RETURN
NODAVF: SETZM J$LDVF(J) ;CLEAR THE FLAG
POPJ P, ;AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
NOVF.1: TELL OPR,%%CFD ;GIVE A MESSAGE
JRST DOREST ;AND DIE GRACEFULLY
> ;END IFN FTJSYS
SUBTTL I/O Subroutines for LPFORM.INI
;ROUTINE TO RETURN A SIXBIT WORD IN T1
;RETURNS WITH WORD IN T1. SKIPS NORMALLY, NON-SKIP ON EOF.
FH$SIX: CLEAR T1, ;CLEAR FOR RESULT
MOVE T2,[POINT 6,T1] ;POINTER FOR RESULT
FH$SX1: PUSHJ P,FH$CHR ;GET A CHARACTER
POPJ P, ;EOF!!
CAIL C,"A" ;CHECK FOR ALPHA
CAILE C,"Z"
SKIPA ;ITS NOT!!
JRST FH$SX2 ;IT IS, DEPOSIT IT
CAIL C,"0" ;CHECK FOR NUMBER
CAILE C,"9"
PJRST .POPJ1## ;NO REASONABLE
FH$SX2: SUBI C,40 ;CONVERT TO SIXBIT
TLNE T2,770000 ;GET SIX YET?
IDPB C,T2 ;NO, DEPOSIT ANOTHER
JRST FH$SX1 ;AND LOOP AROUND
;ROUTINE TO RETURN 1 CHARACTER IN ACCUMULATOR C
FH$CHR: MOVE C,@FMBPT ;GET THE WORD
TRNE C,1 ;IS THERE AN LSN?
AOS FMBPT ;YES, BUMP
ILDB C,FMBPT ;GET A CHARACTER
JUMPE C,.POPJ## ;RETURN WHEN DONE
CAIE C,.CHTAB ;CONVERT TABS
CAIN C,.CHCRT ;AND CARRIAGE RETURNS
MOVEI C,40 ;INTO SPACES
CAIE C,.CHFFD ;CONVERT FORM FEEDS
CAIN C,.CHVTB ;AND VERTICAL TABS
MOVEI C,.CHLFD ;INTO LINEFEED
CAIL C,141 ;CHECK LOWER CASE
CAILE C,172 ;141-172
PJRST .POPJ1## ;ITS NOT
SUBI C,40 ;YUP, CONVERT TO UPPER
PJRST .POPJ1## ;AND SKIP BACK
;ROUTINE TO SEARCH FOR EOL IN LPFORM.INI
FH$EOL: PUSHJ P,FH$CHR ;GET A CHARACTER
POPJ P, ;EOF!!
CAIE C,.CHLFD ;EOL?
JRST FH$EOL ;NO, LOOP
PJRST .POPJ1## ;YES, RETURN!
;ROUTINE TO PICK UP A DECIMAL NUMBER
FH$DEC: CLEAR T1, ;PLACE TO ACCUMULATE RESULT
FH$DE1: PUSHJ P,FH$CHR ;GET A CHARACTER
POPJ P, ;EOF
CAIL C,"0" ;CHECK THE RANGE
CAILE C,"9" ;0-9
POPJ P, ;RETURN
IMULI T1,12 ;SHIFT A PLACE
ADDI T1,-"0"(C) ;ADD IN A DIGIT
JRST FH$DE1 ;AND LOOP AROUND
;SETDFF -- ROUTINE TO SET UP DEFAULT FORMS PARAMETERS
SETDFF: HRLZI T3,-F$NSW ;GET NEGATIVE SWITCH TABLE LEN
MOVEI T1,J$FCUR(J) ;POINT TO CURRENT FORMS PARAMS
SETDF1: MOVE T2,FFDEFS(T3) ;GET A DEFAULT
MOVEM T2,(T1) ;STORE IT
AOJ T1, ;INCREMENT STORE COUNTER
AOBJN T3,SETDF1 ;AND LOOP
;NOW COMPUTE THE WIDTH CLASS
SETDF2: MOVEI T1,3 ;START AT THREE
MOVEM T1,J$FWCL(J) ;STORE IT
MOVE T1,J$FWID(J) ;GET THE WIDTH
CAIG T1,F$CL2 ;LE CLASS 2 LIMIT?
SOS J$FWCL(J) ;YES, SOS ONCE
CAIG T1,F$CL1 ;LE CLASS 1 LIMIT
SOS J$FWCL(J) ;YES, SOS AGAIN
;SETUP DEFAULT ALIGN NAME AND CLEAR FLAG WORD
SETDF3: MOVE T1,J$FORM(J) ;FORMS NAME
MOVEM T1,J$FALI(J) ;SAVE IT
POPJ P, ;AND RETURN
SUBTTL SUBROUTINE TO SAVE ALL ACS
LOWSEG
;SUBROUTINE TO SAVE ACS 1 TO 16
;AC 0=S AND IS GLOBAL ACCROSS ALL ROUTINES
;AC 17=P AND SHOULD NOT BE PUSHED
;ACS ARE RESTORED AUTOMATICLY UPPON EXIT FROM A ROUTINE
; CALLING SAVALL AND .POPJ1## RETURNS ARE HANDLED CORRECTLY
;CALL WITH:
; PUSHJ P,SAVALL
; RETURN HERE
;***WARNING*** THIS USES SPACE ON THE PDL VERY QUICKLY AND SHOULD
; BE USED WITH CARE
SAVALL: EXCH 1,(P) ;PUT AC1 ON PDL
MOVEM 16,15(P) ;SAVE AC16 ON PDL
HRRZI 16,1(P) ;DESTAINATION
HRLI 16,2 ;SOURCE
BLT 16,14(P) ;STORE THE AC'S
ADD P,[15,,15] ;UPDATE BOTH HALVES OF P
MOVE 16,(P) ;PUT AC16 BACK
PUSHJ P,(1) ;GO DO YOUR THING
JRST .+2 ;NON-SKIP RETURN
AOS -16(P) ;CAUSE SKIP RETURN
HRLZI 16,-15(P) ;FROM HERE
HRRI 16,1 ; TO HERE
BLT 16,16 ;PUT BACK AC'S
SUB P,[16,,16] ;UPDATE BOTH HALVES OF P
POPJ P, ;RETURN
SUBTTL Output Device Monitor Interface Routines
; OUTGET -- GET THE OUTPUT DEVICE AND OPEN IT
; OUTOUT -- OUTPUT AND ADVANCE BUFFERS
; OUTERR -- OUTPUT DEVICE ERROR RECOVERY
; OUTWON -- WAIT FOR DEVICE TO COME ON-LINE
; OUTEOJ -- END OF JOB DEVICE HANDLING
; OUTDMP -- FORCE OUT ALL BUFFERS AND WAIT
; OUTFLS -- FLUSH ALREADY BUFFERED OUTPUT
TOPSEG
SUBTTL OUTGET -- OPEN the output device
;THIS ROUTINE OPENS THE SPECIFIED OUTPUT DEVICE, AND SETS UP A BUFFER RING
IFN FTUUOS,<
OUTGET: MOVE T1,J$LGNM(J) ;GET THE GIVEN NAME
DEVNAM T1, ;GET ITS PHYSICAL NAME
JRST OUTG.4 ;LOSE?
MOVEM T1,J$LDEV(J) ;AND SAVE IT
MOVEM T1,J$LSDV(J) ;AND AS SCHEDULING DEVICE
MOVX T1,.IOASC+IO.SFF+UU.PHS+UU.AIO
;ASCII+SUPRESS FF+PHONLY+NBIO
MOVE T2,J$LDEV(J) ;OUTPUT DEVICE NAME
MOVSI T3,J$LBRH(J) ;BUFFER HEADER
OPEN LPT,T1 ;INIT THE DEVICE
JRST OUTG.3 ;LOSE GIVE ERROR
MOVE T1,[2,,T2] ;ARG POINTER
MOVX T2,.DFHCW ;HARDWARE CHARACTERISTICS WORD
MOVEI T3,LPT ;LOAD LPT CHANNEL #
DEVOP. T1, ;READ THE CHARS
JRST OUTG.4 ;SHOULDN'T HAPPEN
TXNE T1,DF.LCP ;IS IT A LOWER-CASE PRINTER?
SETOM J$LLCL(J) ;YES, SET THE FLAG
LDB T1,[POINTR(T1,DF.VFT)] ;GET VFU TYPE
CAIN T1,.DFVTD ;IS IT A DAVFU?
SETOM J$LDVF(J) ;YES, SET THE FLAG
MOVEI T1,LPT ;LOAD LPT CHANNEL #
DEVTYP T1, ;GET THE DEVICE TYPE WORD
JRST OUTG.4 ;THIS SHOULDN'T HAPPEN
TXNE T1,TY.SPL ;IS IT SPOOLED?
JRST OUTG.5 ;YES, TELL HIM
MOVEI T1,LPT ;NO, GET THE CHANNEL
WHERE T1, ;GET THE LOCATION
SETZ T1, ;ASSUME STATION 0
TLZ T1,-1 ;CLEAR STATION FLAGS
CAME T1,CNTSTA ;IS IT THE CENTRAL STATION?
SETOM J$LREM(J) ;NO, SET REMOTE FLAG
IFN FTDPM,<
MOVE S1,J$LBUF(J) ;GET ADDRESS OF BUFFER PAGE
EXCH S1,.JBFF ;SAVE IT AS JOBFF
OUTBUF LPT,1 ;MAKE ONE BUFFER
MOVEM S1,.JBFF ;RESTORE S1
SETZM J$LHNG(J) ;CLEAR THE HUNG FLAG
PJRST INTCNL ;CONNECT LPT TO PSISER
> ;END IFN FTDPM
IFE FTDPM,<
SKIPGE J$LREM(J) ;SKIP IF LOCAL PRINTER
JRST OUTG.2 ;SETUP REGULAR BFRS FOR REMOTE
MOVE T1,J$LBUF(J) ;GET ADDRESS OF BUFFER PAGE
SUBI T1,BUFSIZ ;BACK UP ONE BUFFER
SETZ T2, ;CLEAR A COUNTER
OUTG.1: ADDI T1,BUFSIZ ;POINT TO NEXT BUFFER
MOVEI S1,BUFSIZ+1(T1) ;GET LINK TO NEXT BUFFER
HRLI S1,BUFSIZ-2 ;AND NUMBER DATAWORDS+1
MOVEM S1,1(T1) ;AND STORE IT AWAY IN BUFFER
CAIGE T2,BUFNUM-1 ;GOT THEM ALL?
AOJA T2,OUTG.1 ;NO, LOOP AROUND
MOVNI T2,BUFSPC ;LOAD -BUFSPC
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
SETZM J$LHNG(J) ;CLEAR THE HUNG FLAG
PJRST INTCNL ;CONNECT LPT TO PSI AND RETURN
OUTG.2: MOVE S1,J$LBUF(J) ;GET ADR OF BUFFER PAGE
EXCH S1,.JBFF ;SWAP IT WITH JOBFF
OUTBUF LPT,2 ;GET TWO BUFFERS
MOVEM S1,.JBFF ;RESTORE JOBFF
SETZM J$LHNG(J) ;CLEAR HUNG FLAG
PJRST INTCNL ;AND CONNECT TO INTERRUPTS
> ;END IFE FTDPM
OUTG.3: TELL OPR,%%DNA ;GIVE A MESSAGE
JRST LPTSPL ;AND RESET THE WORLD
OUTG.4: MOVE T1,J$LGNM(J) ;GET THE GIVEN NAME
TELL OPR,%%DDE ;DEVICE DOESN'T EXIST
JRST LPTSPL ;AND RESET THE WORLD
OUTG.5: TELL OPR,%%DIS ;DEVICE IS SPOOLED
JRST LPTSPL ;AND RESET THE WORLD
> ;END IFN FTUUOS
IFN FTJSYS,<
OUTGET: MOVE T1,J$LGNM(J) ;GET GIVEN NAME
MOVEM T1,J$LDEV(J) ;SAVE AS REAL NAME
LSH T1,6 ;SHIFT OFF POSSIBLE "P"
MOVEM T1,J$LSDV(J) ;SAVE A SCHEDULING DEVICE
MOVE T3,[POINT 6,J$LDEV(J)] ;POINT TO DEVICE NAME
MOVE T4,[POINT 7,J$LSTG(J)] ;PLACE TO STORE IT AS A STRING
OUTG.1: ILDB T2,T3 ;GET A CHARACTER
JUMPE T2,OUTG.2 ;DONE IT NULL
ADDI T2,40 ;ELSE CONVERT TO ASCII
IDPB T2,T4 ;STORE IN STRING
TLNE T3,770000 ;DONE?
JRST OUTG.1 ;NO, LOOP
OUTG.2: MOVEI T2,":" ;LOAD A COLON
IDPB T2,T4 ;STORE IT
MOVEI T2,0 ;LOAD A NULL
IDPB T2,T4 ;STORE IT TOO
MOVX S1,GJ%FOU!GJ%SHT ;LOAD GTJFN FLAGS
HRROI S2,J$LSTG(J) ;POINT TO THE STRING
GTJFN ;AND GET A JFN
JRST OUTG.4 ;NO SUCH DEVICE?
MOVEM S1,J$LJFN(J) ;WIN, SAVE THE JFN
MOVX S2,OF%WR+OF%OFL+7B5 ;OPEN FOR WRITING 7 BIT BYTES
OPENF ;OPEN IT
JRST OUTG.4 ;GO HANDLE THE ERROR
MOVE S1,J$LBUF(J) ;GET THE BUFFER ADDRESS
HRLI S1,(POINT 7,0) ;MAKE A POINTER TO IT
MOVEM S1,J$LBPT(J) ;AND SAVE THE POINER
MOVEM S1,J$LIBP(J) ;AND AS INITIAL POINTER
MOVEI S1,BUFCHR ;LOAD A BYTE COUNT
MOVEM S1,J$LBCT(J) ;AND SAVE IT
MOVEM S1,J$LIBC(J) ;AND AS INITIAL COUNT
SETZM J$LHNG(J) ;CLEAR THE HUNG FLAG
PUSHJ P,INTCNL ;CONNECT LPT TO INTERRUPTS
PUSHJ P,INTOFF ;CONO PIOFF FOR A SEC
MOVE S1,J$LJFN(J) ;GET LPT JFN
MOVX S2,.MORST ;GET FUNCTION TO READ STATUS
MOVEI T1,T2 ;LOAD ADDRESS OF ARG BLOCK
MOVEI T2,3 ;LOAD LENGTH OF ARG BLOCK
MTOPR ;GET THE DEVICE STATUS
ERJMP OUTG.3 ;NONE, JUST RETURN
TXNE T3,MO%LCP ;IS IT A LOWER CASE PRINTER?
SETOM J$LLCL(J) ;YES, SET THE FLAG
TXNN T3,MO%LVU ;IS IT NOT OPTICAL VFU
SETOM J$LDVF(J) ;YES, SET THAT
TXNN T3,MO%OL ;IS IT OFF LINE?
JRST OUTG.3 ;NO, CONTINUE
SETOM J$LHNG(J) ;YES, SET THE FLAG
TELL OPR,%%DOL ;AND TELL THE OPERATOR
OUTG.3: PJRST INTON ;CONO PION AND RETURN
OUTG.4: TELL OPR,%%DNA ;DEVICE NOT AVAILABLE
JRST LPTSPL ;AND RESET EVERYTHING
> ;END IFN FTJSYS
SUBTTL OUTOUT -- Routine to output a buffer
LOWSEG
IFN FTUUOS,<
OUTOUT: SKIPE TTYFLG ;ANY TTY ACTIVITY?
PUSHJ P,CHKOPR ;YUP, GO CHECK IT
PUSHJ P,OUTWON ;WAIT FOR DEVICE TO COME ON-LINE
SETOM J$LIOA(J) ;SET IOACT
OUT LPT, ;DUMP THE BUFFER
JRST OUTO.2 ;SUCCESS, CLEAN UP AND RETURN
SETZM J$LIOA(J) ;CLEAR IOACT
PJRST OUTERR ;GO HANDLE THE ERROR
OUTO.2: SETZM J$LIOA(J) ;CLEAR IOACT
SETZM J$LHNG(J) ;CLEAR THE HUNG FLAG
POPJ P, ;AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
OUTOUT: SKIPE TTYFLG ;ANY TTY ACTIVITY?
PUSHJ P,CHKOPR ;YES, GO CHECK IT
PUSH P,T1 ;SAVE T1
SKIPGE T1,J$LBCT(J) ;GET # CHARS LEFT
SETZ T1, ;IF .LT. 0, MAKE IT 0
SUB T1,J$LIBC(J) ;LESS INITIAL YIELD -VE COUNT
MOVE S1,J$LJFN(J) ;GET THE JFN
MOVE S2,J$LIBP(J) ;GET THE INITIAL BP
JUMPE T1,OUTO.1 ;JUMP IF NOTHING TO OUTPUT
SETOM J$LIOA(J) ;SET I/O ACT
SOUT ;AND DUMP THE BUFFER
ERCAL OUTERR ;GO HANDLE THE ERROR
OUTO.1: SETZM J$LIOA(J) ;CLEAR I/O ACT
MOVEI S1,BUFCHR ;GET CHARS/BUFFER
MOVEM S1,J$LBCT(J) ;SAVE AS BUFFER COUNT
MOVEM S1,J$LIBC(J) ;AND AS INITIAL COUNT
MOVE S1,J$LBUF(J) ;GET ADDRESS OF BUFFER
HRLI S1,(POINT 7,0) ;MAKE IT A BYTE POINTER
MOVEM S1,J$LBPT(J) ;SAVE AS BUFFER POINTER
MOVEM S1,J$LIBP(J) ;AND INITIAL POINTER
POP P,T1 ;RESTORE T1
POPJ P, ;AND FINALLY RETURN
;DEBRK TO HERE IF SOUT WAS INTERRUPTED
OUTINT: MOVEM S2,J$LIBP(J) ;SAVE THE CURRENT POINTER
MOVMM T1,J$LIBC(J) ;SAVE MAGNITUDE OF CHARS LEFT TO PRINT
SETZM J$LBCT(J) ;BUFFER IS FULL
POP P,T1 ;PHASE THE STACK
JRST OUTOUT ;AND RESTART THE SOUT
> ;END IFN FTJSYS
SUBTTL OUTERR -- Handle Output Device Errors
IFN FTUUOS,<
OUTERR: STATZ LPT,IO.ERR ;SOMETHING'S WRONG
JRST OUTE.1 ;YES, GIVE THE ERROR
SKIPE J$LHNG(J) ;IS THE DEVICE OFF LINE?
JRST OUTOUT ;YES, GO BACK AND TRY AGAIN
PUSH P,S1 ;NO, SAVE S1
MOVEI S1,0 ;OUTPUT NOT DONE
PUSHJ P,SUSPND ;AND WAIT FOR IO DONE
POP P,S1 ;RESTORE S1
JRST OUTOUT ;AND TRY AGAIN
OUTE.1: PUSHJ P,.SAVET## ;SAVE SOME AC'S
GETSTS LPT,N ;GET ERROR BITS
TRC N,IO.ERR ;TEST FOR ALL FOUR ERROR BITS
TRCE N,IO.ERR ;BEING SET.
JRST OUTE.2 ;AND THEY ARE NOT
MOVE T1,[2,,T2] ;PREPARE FOR DEVOP. UUO
MOVEI T2,.DFRES ;READ EXTENDED ERROR STATUS
MOVEI T3,LPT ;GET CHANNEL NUMBER
DEVOP. T1,
HALT .
CAIN T1,IOVFE% ;VFU ERROR?
JRST OUTE.3 ;YES
MOVE N,T1
OUTE.2: TELL OPR,%%ULE ;UNEXPECTED ERROR
JRST OUTE.4 ;AND GO TELL THE USER
OUTE.3: TELL OPR,%%VFE ;TELL OPR WE GOT A VFU ERROR
OUTE.4: PUSHJ P,OUTDIE ;SEE IF TOO MANY ERRORS
GETSTS LPT,N ;GET I/O STATUS
TRZ N,IO.ERR ;CLEAR ERROR FLAGS
SETSTS LPT,(N) ;GET RESET THE STATUS
STAMP LPMSG
MOVE N,J$RNCP(J) ;GET NUMBER OF COPIES PRINTED
AOS N ;MAKE INTO CURRENCT COPY NUMBER
TELL LOG,%%RLE ;RECOVERABLE LPT ERROR
STAMP LPMSG
TELL LOG,%%RLE1
SETZM J$FLVT(J) ;FORCE A RELOAD
TXNN S,DSKOPN ;ARE WE IN A FILE?
PJRST LODVFU ;NO, LOAD THE VFU AND RETURN
PUSHJ P,CHKSEG ;REMEMBER STATE OF HISEG
PUSHJ P,GETSPL ;GET THE HISEG
MOVEI N,5 ;PREPARE TO BACKSPACE 5 PAGES
PUSHJ P,IBACK ;BACKSPACE 5 PAGES
PJRST LODVFU ;LOAD THE VFU AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
OUTERR: SETZM J$LIOA(J) ;NO LONGER IOACTIVE
PUSHJ P,.SAVET## ;SAVE SOME ACS
PUSHJ P,INTOFF ;CONO PIOFF
MOVE S1,J$LJFN(J) ;GET LPT JFN
MOVX S2,.MORST ;READ STATUS FUNCTION
MOVEI T1,T2 ;ADDRESS OF AFG BLOCK
MOVEI T2,3 ;LENGTH OF ARG BLOCK
SETZ N, ;IN CASE THE MTOPR FAILS
MTOPR ;GET THE STATUS
ERJMP OUTE.1 ;FAIL, DIE
TXNE T3,MO%LVF!MO%RLD ;IS IT RECOVERABLE?
JRST OUTE.2 ;YES, GO HANDLE IT
MOVE N,T3 ;COPY STATUS OVER FOR MESSAGE
OUTE.1: TELL OPR,%%ULE ;UNRECOVERABLE ERROR
JRST OUTE.3 ;AND CONTINUE
OUTE.2: SETZM J$LHNG(J) ;CLEAR "HUNG" FLAG
TXNE T3,MO%OL ;IS IT ON-LINE?
SETOM J$LHNG(J) ;NO, SET "HUNG" FLAG
PUSHJ P,INTON ;TURN PI ON AGAIN
MOVEI T1,%%VFE ;ASSUME VFU ERROR
TXNE T3,MO%RLD ;RELOAD FRONT END?
MOVEI T1,%%FER ;YES, LOAD THAT MSG INSTEAD
TELL OPR,(T1) ;AND TELL HIM
OUTE.3: PUSHJ P,OUTDIE ;SEE IF TOO MANY ERRORS
STAMP LPMSG ;STAMP THE LOG
MOVE N,J$RNCP(J) ;GET COPIES PRINTED
AOS N ;GET COPY NUMBER
TELL LOG,%%RLE ;RECOVERABLE LPT ERROR
STAMP LPMSG ;ANOTHER STAMP
TELL LOG,%%RLE1 ;AND MORE TEXT
MOVEI N,5 ;LOAD NUMBER OF PAGES
TXNE S,DSKOPN ;SKIP THIS IF WE ARE PRINTING HDRS
PUSHJ P,IBACK ;TO BACKSPACE
PJRST OUTWON ;AND WAIT FOR IT
> ;END IFN FTJSYS
;HERE TO CHECK FOR TOO MANY LPT ERRORS
OUTDIE: SOSL J$LERR(J) ;COUNT DOWN ERRORS
POPJ P, ;STILL ALIVE
TELL OPR,%%TML ;TOO MANY
JRST DOREST ;AND DIE
SUBTTL OUTWON -- Wait for on-line
OUTWON: SKIPN J$LHNG(J) ;IS IT OFF LINE?
POPJ P, ;NO, JUST RETURN
MOVEI S1,^D60 ;YES, LOAD A WAIT TIME
PUSHJ P,SUSPND ;AND WAIT
PJRST CHKOPR ;CHECK THE OPR
SUBTTL OUTEOJ -- End of job device handling
IFN FTUUOS,<
OUTEOJ: PUSHJ P,OUTDMP ;DUMP ALL BUFFERS
MTEOF. LPT, ;WRITE A TAPE MARK
POPJ P, ;AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
OUTEOJ: PUSHJ P,OUTDMP ;DUMP ALL BUFFERS
MOVE S1,J$LJFN(J) ;GET THE JFN
MOVX S2,.MOEOF ;GET THE TAPE MARK CODE
MTOPR ;WRITE A TAPE MARK
ERJMP .+1 ;IGNORE THE ERROR
POPJ P, ;AND RETURN
> ;END IFN FTJSYS
SUBTTL OUTDMP -- Dump out buffers and wait
IFN FTUUOS,<
OUTDMP: PUSHJ P,OUTOUT ;FORCE THE LAST BUFFER
MOVEI S1,LPT ;GET THE CHANNEL
WAIT S1, ;WAIT FOR BUFFERS TO EMPTY
POPJ P, ;AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
OUTDMP: PUSHJ P,OUTOUT ;DUMP THE INTERNAL BUFFERS
MOVE S1,J$LJFN(J) ;GET THE LPT JFN
MOVX S2,.MONOP ;AND NO-OP FUNCTION
MTOPR ;DO IT
ERCAL OUTERR ;I/O ERROR?
POPJ P, ;AND RETURN
> ;END IFN FTJSYS
SUBTTL OUTFLS -- Flush already buffered output
;OUTFLS IS CALLED TO FLUSH OUTPUT TO THE PRINTER WHICH HAS ALREADY BEEN
; BUFFERED (AND POSSIBLE SENT TO THE PRINTER).
IFN FTUUOS,<
OUTFLS: TXC S,STARTD!BUSY!DSKOPN ;FLIP 3 BITS
TXCE S,STARTD!BUSY!DSKOPN ;SEE IF ALL 3 WERE ON
POPJ P, ;THEY WEREN'T, RETURN
MOVEI S1,LPT ;LOAD THE CHANNEL NUMBER
RESDV. S1, ;RESET THE CHANNEL
JFCL ;??
PJRST OUTGET ;AND REINIT THE LPT
> ;END IFN FTUUOS
IFN FTJSYS,<
OUTFLS: TXC S,STARTD!BUSY!DSKOPN ;FLIP 3 BITS
TXCE S,STARTD!BUSY!DSKOPN ;SEE IF ALL 3 WERE ON
POPJ P, ;THEY WEREN'T, RETURN
PUSH P,T1 ;SAVE AN AC
MOVE S1,J$LJFN(J) ;GET OUTPUT JFN
MOVX S2,.MOFLO ;LOAD FLUSH FUNCTION
MOVEI T1,0 ;AND ZERO ARGUMENTS
MTOPR ;AND FLUSH
POP P,T1 ;RESTORE T1
MOVE S1,J$LIBC(J) ;INITIAL WORDS IN BUFFER
MOVEM S1,J$LBCT(J) ;RESET BUFFER COUNT
MOVE S1,J$LIBP(J) ;GET INITIAL POINTER
MOVEM S1,J$LBPT(J) ;AND SAVE IT
POPJ P, ;RETURN
> ;END IFN FTJSYS
SUBTTL LPT CONTROL ROUTINES
LOWSEG
;CONTROL CHARACTER TABLE
NCLRFF==(1B0) ;DON'T CLEAR FORMFEED FLAG
SUPRCH==(1B1) ;SUPPRESSABLE CHARACTER
CHTAB: XWD 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
XWD NCLRFF,DEVOUT ;(11) THIS IS A TAB
XWD SUPRCH,DOLF ;(12) THIS IS A LINE FEED
XWD SUPRCH+3,DOFRAC ;(13) THIS SKIPS 1/3 PAGE (VERT TAB)
XWD SUPRCH+NCLRFF,DOFORM ;(14) THIS IS A FORM-FEED
XWD NCLRFF,FIXNBR ;(15) CARRIAGE RETURN
EXP CHKARO ;(16) CONTROL-N
EXP CHKARO ;(17) CONTROL-O
XWD SUPRCH+2,DOFRAC ;(20) THIS SKIPS 1/2 PAGE
XWD SUPRCH+30,DOFRAC ;(21) THIS SKIPS 2 LINES (DC1)
XWD SUPRCH+20,DOFRAC ;(22) THIS SKIPS 3 LINES (DC2)
XWD SUPRCH+1,FIXNBR ;(23) THIS SKIPS 1 LINE (DC3)
XWD SUPRCH+6,DOFRAC ;(24) THIS SKIPS 1/6 OF A PAGE (DC4)
EXP CHKARO ;(25) CONTROL-U
EXP CHKARO ;(26) CONTROL-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
;SUBROUTINE TO SET UP FOR LPTIN AND LPTOUT
;CALL WITH:
; PUSHJ P,FILOOUT
; RETURN HERE
;
FILOUT: PUSHJ P,.SAVE3## ;SAVE P1 AND P2
LOAD T1,.FPINF(E),FP.FSP ;GET SPACING CODE
SKIPE T1 ;SKIP IF ZERO
SOS T1 ; ELSE CONVERT TO # OF LF TO APPEND
MOVEM T1,J$XSPC(J) ;AND SAVE IT
MOVE T1,J$FLIN(J) ;START AT TOP OF PAGE
MOVEM T1,J$XPOS(J) ;SAVE IT
MOVEI T1,LPTERR ;NUMBER OF LPT ERROR TO ALLOW
MOVEM T1,J$LERR(J) ;SET IT UP
PUSHJ P,SETLST ;SET UP TEST
PUSHJ P,SETPFT ;SETUP FILE TYPE
PUSHJ P,CLRSEG ;CLEAR THE HISEG
JRST (T1) ;DISPATCH
;RETURN HERE ON EOF
FILDON: TXNN S,FFSEEN ;ARE SER AT THE TOP OF A PAGE?
AOS J$APRT(J) ;NO, CHARGE HIM FOR THE REST
PJRST GETSPL ;GET THE HISEG AND RETURN
;SUBROUTINE TO COMPILE CODE TO TEST EACH LINE FOR A MATCH AGAINST
; THE /REPORT VALUE.
;CALL WITH:
; PUSHJ P,SETLST
; RETURN HERE
;
TOPSEG
SETLST: MOVEI N,J$XCOD-1(J) ;SET UP PDP TO COMPILED CODE
SKIPN .FPFR1(E) ;WAS /REPORT SPECIFIED?
JRST STLST3 ;NO, ALL LINES MATCH
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 N,SETLSA ;COMPILE A PUSHJ
PUSH N,SETLSB ;WE HAVE AN ERROR RETURN THEN
STLST4: HLL T1,SETLSC ;PLACE CHAR IN CAIE
PUSH N,T1 ;COMPILE THE CAIE
PUSH N,SETLSD ;COMPILE THE JRST TO FLUSH7
SOJG T4,STLST2 ;LOOP FOR WHOLE STRING
STLSC: PUSH N,SETLSA ;GET NEXT CHAR
PUSH N,SETLSB ; FOR TOP LEVEL
STLST3: PUSH N,[JRST ASCLIN];MATCH IN ASCII FORMAT
POPJ P, ;RETURN
;THE INSTRUCTIONS WHICH ARE GENERATED:
SETLSA: PUSHJ P,DSKIN
SETLSB: POPJ P,
SETLSC: CAIE C,0
SETLSD: JRST FLUSH7
LOWSEG
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)
;THE DETERMINATION IS DONE IN THE ABOVE ORDER
TOPSEG ;DO THIS IN THE HISEG
SETPFT: LOAD S1,.FPINF(E),FP.FFF ;GET /FILE
LOAD S2,.FPINF(E),FP.FPF ;GET /PRINT
OFF S,ARROW!SUPRES ;CLEAR SOME INITIAL FLAGS
ON S,NEWLIN!FCONV ;AND SET SOME OTHERS
MOVEI T1,LPTOCT ;ASSUME /PRINT:OCTAL
CAIN S2,%FPLOC ;IS IT?
POPJ P, ;YES, RETURN
MOVEI T1,LPTCOB ;NO, ASSUME /FILE:COBOL
CAIN S1,.FPFCO ;IS IT?
POPJ P, ;YES, RETURN
CAIN S2,%FPLAR ;/PRINT:ARROW?
ON S,ARROW ;YES, LIGHT A FLAG
CAIN S2,%FPLSU ;/PRINT:SUPPRESS?
ON S,SUPRES ;YES, LIGHT A BIT
MOVEI T1,LPTFOR ;ASSUME /FILE:FORTRAN
CAIN S1,.FPFFO ;IS IT?
POPJ P, ;YES, RETURN
MOVEI T1,LPTASC ;ASSUME STANDARD ASCII
SKIPE .FPFR1(E) ;UNLESS /REPORT WAS SPECIFIED
MOVEI T1,LPTRPT ;USE REPORT ROUTINE
POPJ P, ;AND RETURN
LOWSEG ;BACK DOWN IN LOWSEG
SUBTTL LPTASC -- Print Regular ASCII on LPT
IFE FTDPM,<
LPTASC: SOSG J$DBCT(J) ;ANYTHING LEFT TO READ IN
JSP C,GETMOR ;NO, GET ANOTHER BUFFER
ILDB C,J$DBPT(J) ;GET A CHARACTER
CAIGE C,40 ;PRINTABLE ASCII?
JRST LPTA.3 ;NO, GO HANDLE SPECIAL CHARS
OFF S,FFSEEN ;CLEAR A FLAG
TXNE S,NOTYPE ;IS NOTYPE ON?
JRST LPTASC ;YES, DON'T TYPE ANYTHING
LPTA.1: SOSGE J$LBCT(J) ;ANY ROOM IN BUFFER?
JRST LPTA.2 ;NO, FILL IT
IDPB C,J$LBPT(J) ;YES, DEPOSIT IN BUFFER
JRST LPTASC ;AND GET ANOTHER
LPTA.2: PUSHJ P,OUTOUT ;GET A BUFFER
JRST LPTA.1 ;AND LOOP
LPTA.3: PUSHJ P,CHKSP ;GO HANDLE SPECIAL CHARS
JRST LPTASC ;AND LOOP AROUND
> ;END IFE FTDPM
IFN FTDPM,<LPTASC=LPTRPT> ;DO IT THE SLOW WAY
SUBTTL LPTFOR -- Process FORTRAN data files
LPTFOR: SOSG J$DBCT(J) ;AND CHARACTERS LEFT
JSP C,GETMOR ;NO, GET MORE DATA
ILDB C,J$DBPT(J) ;GET ONE
JUMPE C,LPTFOR ;IGNORE NULLS
TXZE S,FCONV ;CHECK FOR CTL CHAR
JRST FORCNV ;GO DO IT
CAIN C,.CHLFD ;LINEFEED?
TXOA S,FCONV ;FLAG NEXT CHAR AS CTL CHAR
PUSHJ P,LPTOUT ;OTHERWISE PRINT IT
JRST LPTFOR ;AND LOOP AROUND AGAIN.
FORCNV: MOVSI T1,-NFORCH ;MAKE AN AOBJN POINTER
FORC.1: HLRZ T2,FORTAB(T1) ;GET CHAR FROM TABLE
CAMN C,T2 ;MATCH?
JRST FORC.2 ;YES, GO TRANSLATE
AOBJN T1,FORC.1 ;NO, LOOP
MOVEI C,.CHLFD ;DIDN'T FIND A MATCH, SO LOAD
PUSHJ P,LPTOUT ; A LINEFEED, SEND IT, AND
JRST LPTFOR ; CONTINUE ON
FORC.2: HRRZ C,FORTAB(T1) ;GET TRANS CHAR AND REPEAT COUNT
LDB T1,[POINT 9,C,26] ;GET REPEAT COUNT IN T1
ANDI T1,177 ;AND DOWN TO CHARACTER
FORC.3: PUSHJ P,LPTOUT ;SEND THE CHARACTER
SOJG T1,FORC.3 ;AND LOOP
JRST LPTFOR ;AND CONTINUE
SUBTTL LPTRPT -- Process REPORT files
LPTRPT: SOSG J$DBCT(J) ;ANYTHING LEFT TO READIN?
JSP C,GETMOR ;NO, GET ANOTHER BUFFER FULL
ILDB C,J$DBPT(J) ;GET A CHARACTER
PUSHJ P,LPTOUT ;DO ALL THE CHECKING
JRST LPTRPT ;AND GET ANOTHER
SUBTTL LPTOCT -- Give an Octal Dump
LPTOCT: 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,DSKIN ;GET THE NEXT WORD
JRST FILDON ;DONE!!
MOVE N,C ;COPY WORD
OFF S,FFSEEN ;FLAG MIDDLE OF FORM
MOVE P1,[POINT 3,N] ;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,14 ;PRINT A FORM FEED
ON S,FFSEEN ;FLAG TOP OF FORM
AOS J$APRT(J) ;COUNT 1 PAGE AGAINST QUOTA
PUSHJ P,FIXQTA ; ..
JRST OCT1 ;PRINT NEXT PAGE
SUBTTL LPTCOB -- Process COBOL Sixbit Files
LPTCOB: OFF S,FFSEEN ;CAUSE A FORM FEED AT END
PUSHJ P,DSKIN ;GET THE FIRST WORD OF THE FILE
JRST FILDON ;NULL FILE
HLRZ T1,C ;COPY THE FIRST 3 LETERS
CAIE T1,'HDR' ;IS IT A HDR
JRST COBOL4 ;NO--NORMAL INPUT
MOVEI T1,15 ;FLUSH TAPE HEADER
PUSHJ P,DSKIN ;GET A WORD
JRST FILDON ;EOF
SOJG T1,.-2 ;LOOP FOR MORE
COBOL1: PUSHJ P,DSKIN ;GET A WORD
JRST FILDON ;TEH LAST WORD HAS COME
COBOL4: ANDI C,7777 ;MASK TO 12 BITS
JUMPLE C,COBOL5 ;IGNORE 0 COUNTS FOR OBVIOUS REASON
MOVEI P1,(C) ;COPY THE COUNT
MOVEI P2,-1(P1) ;GET COUNT-1 IN P2
SUB P2,J$FWID(J) ;ROUND DOWN TO A LINE
IDIV P2,J$FWID(J) ;CONVERT TO # LINES
MOVNS P2 ;NEGATE IT
ADDM P2,J$XPOS(J) ;AND DECREMENT POSITION
COBOL2: PUSHJ P,DSKIN ;GET A DATA WORD
JRST FILDON ;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 N,C ;COPY WORD
MOVE P2,[POINT 6,N] ;POINT TO WORD
COBOL3: ILDB C,P2 ;AND GET THE CHARACTER
MOVEI C,40(C) ;MAKE ASCII
PUSHJ P,DEVOUT ;PRINT
SOJG T1,COBOL3 ;LOOP FOR NEXT CHAR
SUBI P1,6 ;COUNT 6 MORE CHARS
JUMPG P1,COBOL2 ;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: PUSHJ P,FILL ;SKIP TO NEXT RECORD FOR ISAM
JRST FILDON ;END OF FILE
AOS J$DBCT(J) ;WILL BE RESET BY SOSLE AT DSKIN:
JRST COBOL1 ;LOOP FOR NEXT RECORD
SUBTTL Character Interrogation Routines
;SUBROUTINE TO PLACE A CHAR ON THE LINE PRINTER
;CALL WITH:
; PUSHJ P,LPTOUT
; RETURN HERE (EOF SET IF OVER LIMIT)
;
ASCLIN: PUSHJ P,ISEOL ;END OF LINE?
JRST .+2 ;NO--SKIPA
ON S,NEWLIN ;YES--LOOK FOR CODE
LPTOUT: CAIGE C,40 ;VISABLE ASCII
JRST CHKSP ;NO--SEE IF SPACE
LPTOU1: TXZE S,NEWLIN ;AND THIS IS A NEW LINE
JRST J$XCOD(J) ;SEE IF REPORT LINE MATCHES
OFF S,FFSEEN ;CLEAR FORM FEED FLAG
PJRST DEVOUT ;PRINT IT
CHKSP: MOVE N,CHTAB(C) ;GET THE DISPATCH
TLNN N,NCLRFF ;CLEAR FORMFEED FLAG?
OFF S,FFSEEN ;YES
TXNE S,SUPRES ;IN SUPPRESS MODE?
TLNN N,SUPRCH ;YES, IS THIS CHARACTER SUPPRESSABLE?
JRST (N) ;DISPATCH THE CHARACTER NORMALLY
JRST DOSUP ;SUPPRESS THE CHARACTER
;ROUTINE TO GET THE NEXT BUFFER FULL OF DATA FROM THE INPUT FILE.
;CALL WITH:
; JSP C,GETMOR
; RETURN HERE IF MORE DATA AVAILABLE
;
; BRANCHES TO FILDON AT EOF
GETMOR: PUSH P,C ;SAVE THE RETURN ADDRESS
PUSHJ P,FILL ;GET A BUFFER FULL
SKIPA ;EOF!!
POPJ P, ;RETURN
POP P,C ;RESTORE C
JRST FILDON ;AND FINISH UP
;HERE TO THROW AWAY A LINE
FLUSH7: PUSHJ P,DSKIN ;GET A BYTE
POPJ P, ;EOF, RETURN
PUSHJ P,ISEOL ;END OF LINE?
JRST FLUSH7 ;NO--LOOP FOR REST OF LINE
FLUSH8: PUSHJ P,DSKIN ;GET A BYTE
POPJ P, ;EOF, DONE
PUSHJ P,ISEOL ;GOT EOL CHARACTER?
JRST J$XCOD(J) ;NO, BEGINNING A NEW LINE
JRST FLUSH8 ;YES, LOOP AGAIN
ISEOL: CAIL C,12 ;C .GT. 12?
CAILE C,24 ;C .GT. 24?
POPJ P, ;NO--NOT END OF LINE
CAILE C,15 ;C .LE. 15?
CAIL C,20 ;C .GE. 20?
AOS (P) ;YES--CAUSE SKIP RETURN
POPJ P, ;NO--PLAIN RETURN
;HERE ON A LINE FEED
DOLF: MOVE T1,J$XSPC(J) ;NUMBER OF ADDITIONAL LINE FEEDS
SETO N, ;START WITH 1 LINE
DOLF1: SOJL T1,CNTDWN ;ANY MORE?
MOVEI C,.CHLFD ;LOAD A LINE-FEED
PUSHJ P,DEVOUT ;YES--GIVE IT
SOJA N,DOLF1 ;AND SUBTRACT FROM QUOTA
;HERE TO PROCESS A FORM FEED
DOFORM: TXOE S,FFSEEN
POPJ P, ;DO NOT PRINT BLANK PAGES
MOVN N,J$XPOS(J) ;THIS TAKES ALL WE HAVE ON PAGE
SKIPL N ;WAS VPOS NEGATIVE?
CLEAR N, ;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
TXOE S,FFSEEN
POPJ P, ;ONLY 1 LINE FEED IN A ROW
SETO N,
JRST CNTDWN ;CHARGE FOR THE LINE
;HERE TO DO ARROW MODE STUFF IF NEEDED
CHKARO: TXNN S,ARROW ;ARROW MODE?
JRST DEVOUT ;NO--JUST PRINT
DOARO: PUSH P,C ;SAVE C
MOVEI C,"^" ;LOAD A ^
PUSHJ P,DEVOUT ;PRINT THE ^
POP P,C ;RESTORE C
MOVEI C,100(C) ;MAKE INTO REAL LETTER
PJRST DEVOUT ;PRINT
;HERE IF SPECIAL CHAR MOVES A FIXED # OF LINES (EXCEPT LINE FEED)
FIXNBR: HLRZS N ;GET 0,,NUMBER OF LINES
ANDI N,777 ;AND OUT FLAGS
MOVNI N,(N) ;MAKE -VE SO WE CAN DO ADDM'S
JRST CNTDWN ;AND COUNT THEM DOWN
;HERE IF SPECIAL CHARACTER SKIPS A FRACTION OF A PAGE
DOFRAC: HLRZS N ;GET 0,,FRACTION
ANDI N,777 ;AND OUT FLAGS
MOVE T1,J$FLIN(J) ;GET CURRENT PAGE SIZE
IDIVI T1,(N) ;FIND THE RIGHT PART
MOVE T2,J$XPOS(J) ;GET CURRENT POSITION
JUMPLE T2,[MOVN N,J$XPOS(J) ;COPY VPOS
SUBI N,3 ;SUBTRACT 3
JRST CNTDWN];AND CHARGE HIM
IDIVI T2,(T1) ;GET RESIDUE MOD SKIPSIZE
MOVN N,T3 ;AND MAKE IT NEGATIVE
JRST CNTDWN ;GO CHECK QUOTA
;HERE TO ADJUST QUOTA
CNTDWN: ON S,NEWLIN ;SET NEWLINE FLAG
ADDB N,J$XPOS(J) ;REDUCE VERTICAL POSITION
PJUMPG N,DEVOUT ;JUMP IF STILL ON PAGE
CAIN C,23 ;WAS IT A DC3?
CAMG N,[-3] ;YES, GIVE HIM 3 EXTRA LINES
JRST CNTDW1 ;OFF PAGE ANYWAY
PJRST DEVOUT ;HE WINS!!
CNTDW1: MOVE N,J$FLIN(J) ;BACK TO TOP OF PAGE
MOVEM N,J$XPOS(J) ;SAVE POSITION
AOS J$APRT(J) ;ONE MORE PRINTED
AOS T1,J$RNPP(J) ;GET PAGE NUMBER
IFN FTUUOS,<
IDIVI T1,TABSIZ ;MOD TABSIZ IN T2
ADD T2,J ;POINT INTO JOB-INFO PAGE
HRRZ T1,J$DINF(J) ;GET DISK BLOCK NUMBER
MOVEM T1,J$XPTB(T2) ;AND SAVE IT
MOVE T1,J$DBCT(J) ;GET BYTE COUNT
HRLM T1,J$XPTB(T2) ;SAVE OFFSET INTO BLOCK
> ;END IFN FTUUOS
MOVEI N,3 ;LOAD A 3
CAIN C,23 ;GET HERE VIA DC3?
ADDM N,J$XPOS(J) ;YES, GIVE HIM 3 XTRA LINES
TXNN S,NOTYPE ;IS BACKSPACE OR FORWARD IN PROGRESS?
JRST FIXQTA ;NO, SKIP DESTINATION CHECK
MOVEI C,.CHFFD ;LOAD A FORM-FEED
MOVE T1,J$RNPP(J) ;GET THE PAGE NUMBER
CAME T1,J$XDPG(J) ;HAVE WE HIT DESTINATION?
JRST FIXQTA ;NO, CONTINUE ON
OFF S,NOTYPE ;YES, START PRINTING AGAIN
PUSHJ P,TAKCHK ;BUT TAKE A CHECKPOINT FIRST
FIXQTA: MOVE N,J$RLIM(J) ;GET LIMIT
SUB N,J$APRT(J) ;GET AMOUNT PRINTED
JUMPL N,XCEED ;THAT DOES IT
PJRST DEVOUT ;AND PRINT THE POOR CHARACTER
;SENDFF - ROUTINE TO SEND A FF IF FFSEEN IS OFF
;
SENDFF: MOVEI C,.CHFFD ;LOAD A FF
TXON S,FFSEEN ;IS FFSEEN ON?
PUSHJ P,DEVOUT ;NO, SEND IT
POPJ P, ;RETURN
;SUBROUTINE TO OUTPUT ONE CHAR ON SELECTED DEVICE
;CALL WITH:
; PUSHJ P,DEVOUT
; RETURN HERE (HALTS IF ERROR)
;
LOWSEG
DEVOUT: TXNE S,NOTYPE ;IS NOTYPE ON?
POPJ P, ;YES, JUST RETURN
DEVO.1: SOSGE J$LBCT(J) ;DECREMENT THE BYTE COUT
JRST DEVO.2 ;LOSE, GO DUMP THE BUFFER
IDPB C,J$LBPT(J) ;DEPOSIT A BYTE
IFN FTDPM,<
SKIPGE J$XHIP(J) ;HEADER IN PROGRESS?
POPJ P, ;YES, JUST RETURN
CAIG C,24 ;IS IT BETWEEN
CAIGE C,12 ; 12 AND 24?
POPJ P, ;NO, RETURN
PJRST OUTOUT ;YES, DUMP IT
> ;END IFN FTDPM
POPJ P, ;RETURN
DEVO.2: PUSHJ P,OUTOUT ;DUMP THE BUFFER
JRST DEVO.1 ;AND TRY AGAIN
;HERE WHEN USER IS OVER HIS PRINT OUT QUOTA
XCEED: TELL USR,CRLF ;GIVE A CRLF
TELL USR,CRLF ;AND ANOTHER
STAMP LPERR ;GIVE A STAMP
TELL USR!LOG,%%PLE ;INFORM EVERYONE
SKIPE MSGERR ;TELL OPR?
TELL OPR,%%PLE ;YES
ON S,ABORT ;HE HAS LOST
PJRST SETEOF ;FORCE AN EOF AND RETURN
SUBTTL ROUTINES TO GENERATE HEADERS AND TRAILERS
;JOB HEADERS AND TRAILERS
TOPSEG
JOBTRL: TXZN S,BANDUN ;HAVE WE PRINTED A BANNER?
POPJ P, ;NO, JUST RETURN
MOVEI T4,TRLMSG ;ADDRESS OF END TEXT
TXZE S,RQB ;CLEAR REQUE AND SKIP IF NOT SET
MOVEI T4,[ASCIZ /*REQUEUE*/] ;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
ON S,BANDUN ;HEADER SEQUENCE HAPPENED
MOVEI T4,HDRMSG ;ADDRESS OF START TEXT
PUSHJ P,GIVHDR ;GO SET THE LINE
JRST BANNER ;AND GO PRINT THE BANNER PAGES
GIVHDR: MOVE T3,J$FWCL(J) ;LOAD THE WIDTH CLASS
PUSH P,J$LBPT(J) ;SAVE BYTE POINTER
PUSH P,J$LBCT(J) ;SAVE REAL COUNT
SETOM J$XHIP(J) ;SET HEADER IN PROGRESS
MOVE T1,[POINT 7,J$XHBF(J)]
MOVEM T1,J$LBPT(J) ;AND SETUP A DUMMY BYTE-POINTER
MOVEI T1,^D1000
MOVEM T1,J$LBCT(J) ;PREVENT AN OUTPUT
TELLN USR,(T4) ;PRINT THE RIGHT THING
MOVE T1,.EQJOB(J) ;LOAD THE JOB NAME
TELL USR,JBHDR1 ;TYPE USER ID AND JOB NAME
LOAD N,.EQSEQ(J),EQ.SEQ ;GET THE SEQUENCE NUMBER
TELL USR,JBHDR4 ;YES PRINT IT
CAIN T3,1 ;IS IT WIDTH CLASS 1?
TELL USR,CRDC3 ;YES, GIVE A CRLF
TELL USR,JBHDR5 ;PRINT THE DATE
CAIN T3,2 ;IS IT WIDTH CLASS2?
TELL USR,CRDC3 ;YES, GIVE A CRLF
TELL USR,JBHDR8 ;TYPE "MONITOR"
TELLN USR,LPCNF ;PRINT THE MONITOR NAME
TELLN USR,(T4) ;PRINT A WORD
SETZ T1, ;MAKE SURE THAT THERE
IDPB T1,J$LBPT(J) ; IS A NULL AT THE END
POP P,J$LBCT(J) ;RESTORE THE REAL
POP P,J$LBPT(J) ; HEADER
CLEARM J$XHIP(J) ;CLEAR HEADER IN PROGRESS FLAG
POPJ P, ;AND RETURN
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
PUSHJ P,BNUNAM ;SETUP THE USER NAME
BANN.1: PUSHJ P,SENDFF ;SEND A FORM FEED
SETZM J$XPOS(J) ;AND SET 0 POSITION
MOVEI T1,2 ;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
TELL USR,CRDC3 ;ONE BLANK
MOVEI P1,J$XHUN(J) ;POINT TO THE BLOCK
HRL P1,J$XHUW(J) ;AND THE NUMBER OF WORDS
MOVEI P2,1 ;GET THE BLOCKSIZE
PUSHJ P,PPICT ;PRINT A PICTURE
TELL USR,CRDC3 ;A BLANK
TELL USR,CRDC3 ;ANOTHER BLANK
MOVEI T1,3 ;COUNT'EM
ADDM T1,J$XPOS(J) ;...
SKIPN .EQNOT(J) ;IS THERE A NOTE?
PJRST PLINES ;NO, SKIP TO END OF PAGE AND RTN
PUSHJ P,PLPBUF ;PRINT A LINE
PUSHJ P,PLPBUF ;AND ANOTHER
PUSHJ P,PLPBUF ;AND A THIRD
PUSHJ P,PLPBUF ;AND A FOURTH
MOVX T1,'NOTE: ' ;LOAD THE TITLE
MOVEM T1,J$XHNO(J) ;SAVE IT
DMOVE T1,.EQNOT(J) ;GET THE NOTE
DMOVEM T1,J$XHNO+1(J) ;STORE IT
MOVEI P1,J$XHNO(J) ;POINT TO THE BLOCK
HRLI P1,3 ;AND THE NUMBER OF WORDS
MOVEI P2,1 ;AND THE BLOCKSIZE
MOVE S1,J$FWCL(J) ;GET THE WIDTH CLASS
CAIE S1,3 ;IS IT 3?
ADD P1,[-1,,1] ;NO, RE-ADJUST THE POINTER
PUSHJ P,PPICT ;AND PRINT A PICTURE
PJRST PLINES ;GO TO EOP AND RETURN
;HERE TO FORMAT THE USER NAME
IFN FTUUOS,<
BNUNAM: DMOVE S1,.EQUSR(J) ;GET USER NAME
DMOVEM S1,J$XHUN(J) ;SAVE IT
MOVEI T1,2 ;ASSUME 2 WORDS
SKIPN S2 ;UNLESS THE SECOND WORD IS NULL
MOVEI T1,1 ;THEN 1 WORD
MOVEM T1,J$XHUW(J) ;SAVE IT
POPJ P, ;RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
BNUNAM: SETZB S1,S2 ;CLEAR S1 AND S2
DMOVEM S1,J$XHUN(J) ;CLEAR 2 WORDS IN BLOCK
MOVEM S1,J$XHUN+2(J) ;AND CLEAR THE 3RD WORD
MOVE S1,[POINT 7,.EQOWN(J)] ;POINT TO OWNER'S NAME
MOVE S2,[POINT 6,J$XHUN(J)] ;AND THE DESTINATION
MOVEI T1,0 ;AND CLEAR A COUNTER
BNUN.1: ILDB T2,S1 ;GET A CHARACTER
JUMPE T2,BNUN.2 ;DONE ON NULL
SUBI T2,40 ;ESLE, CONVERT TO 6BIT
SKIPGE T2 ;MAKE SURE ITS OK
MOVEI T2,0 ;ELSE MAKE IT A SPACE
IDPB T2,S2 ;STORE IT
CAIGE T1,^D17 ;CHECK FOR MAX
AOJA T1,BNUN.1 ;AND LOOP
BNUN.2: MOVE T2,J$FWCL(J) ;GET THE WIDTH CLASS
CAIE T2,3 ;IS IT 3?
CAIG T1,^D10 ;NO, SO IF GT 10 CHARS
SKIPA
MOVEI T1,^D10 ;MAKE IT 10 CHARS
MOVE T3,T1 ;GET NUMBER CHARS
ADDI T3,5 ;ROUND UP
IDIVI T3,6 ;CONVERT TO WORDS
MOVEM T3,J$XHUW(J) ;AND SAVE IT
POPJ P, ;AND RETURN
> ;END IFN FTJSYS
SUBTTL TRAILR -- Routine to Print a Trailer
TRAILR: PUSHJ P,.SAVE3## ;SAVE P1 - P3
MOVE P3,J$FTRA(J) ;AND THE NUMBER OF TRAILERS
PJUMPE P3,OUTEOJ ;RETURN IF ZERO
TRAI.1: PUSHJ P,SENDFF ;SEND A FORMFEED
SETZM J$XPOS(J) ;CLEAR THE VERTICAL POSITION
PUSHJ P,TRAI.3 ;PRINT THE INTERNAL LOG
PUSHJ P,PLINES ;PRINT TILL END OF PAGE
SOJG P3,TRAI.1 ;LOOP UNTIL DONE
PJRST OUTEOJ ;AND DUMP BUFFERS AND RETURN
;HERE TO PRINT THE INTERNAL LOG
TRAI.3: SKIPN J$GNLN(J) ;ANYTHING IN THE INTERNAL LOG?
POPJ P, ;NO, RETURN
PUSHJ P,PLPBUF ;YES, PRINT A LINE
PUSHJ P,PLPBUF ;AND ANOTHER LINE
MOVEI C,.CHTAB ;LOAD A TAB
MOVE T1,J$FWCL(J) ;GET THE WIDTH CLASS
PUSHJ P,DEVOUT ;PRINT A TAB
SOJG T1,.-1 ;PRINT N OF THEM
TELLN USR,[ASCIZ /* * * L P T S P L R u n L o g * * */]
TELL USR,CRDC3 ;AND AN EOL
TELL USR,CRDC3 ;AND ANOTHER EOL
MOVEI T1,0 ;LOAD A NULL
IDPB T1,J$GIBP(J) ;AND TERMINATE THE STRING
MOVE T2,J ;COPY OVER J
MOVE T3,J$GINP(J) ;GET NUMBER OF PAGES
TRAI.4: MOVE T1,J$GBUF(T2) ;GET ADR OF BUFFER
TELLN USR,(T1) ;PRINT IT
SOSLE T3 ;DECREMENT COUNT
AOJA T2,TRAI.4 ;AND LOOP IF NOT DONE
TELL USR,CRDC3 ;AND A BLANK LINE
TELL USR,CRDC3 ;AND ANOTHER ONE
TELL USR,CRDC3 ;AND ANOTHER
MOVE T1,J$GNLN(J) ;GET NUMBER OF LOG LINES
ADDI T1,5 ;AND IN THE OVERHEAD
ADDB T1,J$XPOS(J) ;AND ACCUMULATE VERTICAL POSITION
IDIV T1,J$FLIN(J) ;DID WE OVERFLW A PAGE?
PJUMPE T1,.POPJ## ;RETURN IF NOT
MOVEM T1,J$XPOS(J) ;ELSE, SAVE CURRENT POSITION
SETZM J$GNLN(J) ;AND DON'T PRINT IT AGAIN
SOJA P3,.POPJ## ;AND RETURN
;UTILITY ROUTINES
PLPBUF: TELLN USR,J$XHBF(J) ;SEND A LINE
MOVE T4,J$FWCL(J) ;GET THE WIDTH CLASS
CAIN T4,3 ;IS IT 3?
TELL USR,[BYTE (7)15,23,0]
TELL USR,[BYTE (7)15,23,23,23,0]
MOVEI T4,4 ;WE PRINT 4 LINES
ADDM T4,J$XPOS(J) ;ADD TO COUNT
POPJ P,
PPICT: MOVEI T4,^D18 ;GET A LINE COUNT
CAIN P2,1 ;IS IT BLOCKSIZE = 1?
MOVEI T4,^D11 ; THEN ITS ONLY 11 LINES
ADDM T4,J$XPOS(J) ;INCREMENT LINE COUNT
PJRST PICTURE ;AND PRINT THE PICTURE
PLINES: MOVE T2,J$FLIN(J) ;GET LINES/PAGE
ADDI T2,2 ;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
TELL USR,[BYTE(7)15,23,0]
SOJA T2,PEOP1 ;AND LOOP
PEOP2: TELL USR,STARS ;PRINT THE STARS
POPJ P, ;AND RETURN
SUBTTL HEAD -- Generate File-header pages
HEAD: PUSHJ P,.SAVE3## ;SAVE SOME ACS
PUSHJ P,SENDFF ;SEND A FORMFEED
LOAD P1,.FPINF(E),FP.NFH ;GET THE NO HEADER BIT
SKIPN P1 ;SKIP IF WE DON'T WANT HEADERS
SKIPN P3,J$FHEA(J) ;GET NUMBER OF PICTURE PAGES
POPJ P, ;RETURN
PUSHJ P,.+3 ;PRINT THE HEADER
SOJG P3,.-1 ;LOOP FOR THE WHOLE WORKS
POPJ P, ;RETURN
MOVEI P1,J$DRNM(J) ;GET ADR OF REF NAME
HRLI P1,2 ;GET NUMBER OF WORDS
MOVE P2,J$DRBS(J) ;LOAD THE BLOCKSIZE
PUSHJ P,PICTURE ;AND DO THE FILE NAME
MOVEI P1,J$DREX(J) ;GET ADR OF REF EXT
HRLI P1,2 ;NUMBER OF WORDS
MOVE P2,J$DRBS(J) ;AND THE BLOCKSIZE
PUSHJ P,PICTURE ;AND DO THE EXTENSION
RHEAD: TELLN USR,J$XHBF(J) ; ..
TELL USR,CRLF ; ..
MOVE P1,J$FWCL(J) ;LOAD THE WIDTH CLASS
TELL USR,[ASCIZ /File: ^ Created: /]
IFN FTUUOS,<
MOVE T1,J$DUUO+.RBTIM(J) ;GET CREATION TIME
> ;END IFN FTUUOS
IFN FTJSYS,<
MOVE T1,J$DFDB+.FBCRV(J) ;GET CREATION DATE OF FILE
> ;END IFN FTJSYS
PUSHJ P,PRDTA ;AND PRINT IT
CAIE P1,3 ;WIDTH CLASS 3?
TELL USR,[BYTE (7) 15,12,11,0] ;NO
IFN FTJSYS,<
SKIPE J$DRMS(J) ;IS IT AN RMS FILE?
TELL USR,[ASCIZ / (RMS Format File) /]
> ;END IFN FTJSYS
TELL USR,[ASCIZ / Printed: @
/]
TELL USR,[ASCIZ .QUEUE Switches: .]
LOAD T2,.FPINF(E),FP.FPF ;GET PAPER FORMAT
MOVE T1,FMTAB-1(T2) ;GET THE WORD
SKIPE T2 ;DONT PRINT IF FORCED TO BE NULL
TELL USR,[ASCIZ . /PRINT:+.]
LOAD T2,.FPINF(E),FP.FFF ;GET FILE FORMAT
MOVE T1,FFMTAB-1(T2) ;GET THE WORD
SKIPE T2 ;SKIP IF NULL /FILE:
TELL USR,[ASCIZ . /FILE:+ .]
LOAD N,.FPINF(E),FP.FCY ;GET NUMBER OF COPIES
TELL USR,[ASCIZ ./COPIES:# .]
CAIE P1,3 ;WIDTH CLASS 3?
TELL USR,[BYTE (7) 15,12,11,0] ;NO
LOAD N,.FPINF(E),FP.FSP ;GET THE SPACING
TELL USR,[ASCIZ ./SPACING:# .]
MOVE N,J$RLIM(J) ;GET HIS LIMIT
TELL USR,[ASCIZ ./LIMIT:# .]
MOVE T1,J$FORM(J) ;GET FORMS TYPE
TELL USR,[ASCIZ ./FORMS:+
.]
LOAD T1,.FPINF(E),FP.DEL ;GET DELETE BIT
SKIPE T1 ;DELETE FILE?
TELL USR,[ASCIZ /
File: ^ will be DELETED after printing
/]
MOVE N,J$XPG1(J) ;GET STARTING PAGE
SOJLE N,SENDFF ;JUST RETURN IF 0 OR 1
ADDI N,1 ;RESTORE THE NUMBER
TELL USR,[ASCIZ /
*****Printing will start at page # *****
/]
PJRST SENDFF ;SEND A FORM FEED
FMTAB: SIXBIT /ARROW/
SIXBIT /ASCII/
SIXBIT /OCTAL/
SIXBIT /SUPRES/
FFMTAB: SIXBIT /ASCII/
SIXBIT /FORT/
SIXBIT /COBOL/
SUBTTL PICTUR -- Routine to print block letters
;SUBROUTINE TO PRINT BLOCK LETTERS
;CALL WITH:
; MOVE P1,[XWD # WORDS,ADR OF FIRST WORD]
; MOVEI P2,BLOCKSIZE OF CHARACTER
; PUSHJ P,PICTUR
; RETURN IS HERE
;
;THIS ROUTINE IS STOLEN FROM BOB CLEMENTS. I WISH TO THANK
;BOB FOR HIS CLEAR COMMENTS ON IT'S USE IN PRINTR.
;
PICTUR: PUSHJ P,.SAVE3## ;SAVE P1-P3
MOVNI T3,43 ;NUMBER OF BITS IN MAP
HLRZ P3,P1 ;GET NUMBER OF WORDS
SKIPN P3 ;SKIP IF NON-ZERO
MOVEI P3,1 ;ELSE ASSUME 1
HRRZI T1,-1(P1) ;GET ADR OF 1ST WORD -1
ADD T1,P3 ;GET ADR OF LAST WORD
IMULI P3,6 ;CONVERT WORDS TO CHARACTERS
MOVEM P3,J$XPCS(J) ;AND SAVE NUMBER OF SIGNIFICANT CHARS
MOVE P3,(T1) ;LOAD LAST WORD INTO P3
MOVEI T1,77 ;AND LOAD A SIXBIT MASK
PICTR0: TDNE P3,T1 ;MASK A CHARACTER
JRST PICTR1 ;ITS SIGNIFICANT
SOS J$XPCS(J) ;ITS NOT SIGNIFICANT
LSH T1,6 ;SHIFT THE MASK
JUMPN T1,PICTR0 ;AND LOOP FOR 6 POSITIONS
PICTR1: MOVEM P2,J$XPCB(J) ;SAVE THE BLOCKSIZE
PICTR2: MOVE P2,J$XPCB(J) ;LOAD THE BLOCKSIZE
PUSHJ P,PIC1 ;PRINT A PATTERN
SOJG P2,.-1 ;N TIMES
ADDI T3,5 ;POSITION TO NEXT PATTERN
JUMPL T3,PICTR2 ;AND LOOP
TELL USR,CRLF ;4 CRLFS WHEN DONE
TELL USR,CRLF
TELL USR,CRLF
TELL USR,CRLF
POPJ P, ;AND RETURN
;HERE TO PRINT A WHOLE ROW
PIC1: PUSHJ P,.SAVE3## ;SAVE P1-P3
HRRZ N,P1 ;GET ADDR OF FIRST WORD
HRLI N,440600 ;MAKE A BYTE POINTER
MOVE P2,J$XPCS(J)
;HERE TO DO 1 CHAR
PIC2: ILDB T2,N ;GET A CHAR
ADDI T2,40 ;MAKE ASCII
MOVE T1,CHRTAB-40(T2);GET PATTERN
ROT T1,43(T3) ;DIAL A BIT
MOVNI T4,5 ;SET UP COUNT
PIC3: MOVEI C,40 ;ASSUME IT IS A BLANK
JUMPGE T1,.+2 ;WERE WE RIGHT
MOVE C,T2 ;OF COURSE NOT
PUSHJ P,TELL3 ;PRINT 3 WIDE
ROT T1,1 ;GET NEXT BIT
AOJL T4,PIC3 ;COUNT DOWN WIDTH
MOVEI C,40 ;SET UP FOR SPACE
SOJLE P2,TCRLF ;IF NO MORE SIG CHARS, PRINT CRLF(ED.142)
PUSHJ P,TELL3 ;NO. PRINT 6 BLANK
PUSHJ P,TELL3 ; COL. BETWEEN LETTERS
JRST PIC2 ;DO ANOTHER LETTER
TCRLF: TELL USR,CRLF ;PRINT A BLANK LINE
POPJ P, ;RETURN
TELL3: MOVE P3,J$XPCB(J) ;LOAD BLOCK SIZE
PUSHJ P,DEVOUT ;PRINT THE CHAR
SOJG P3,.-1 ;LOAD FOR N CHARACTERS
POPJ P, ;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,06,06,00,06,06,00 ;:
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 ;_
SUBTTL INITIALIZATION
LOWSEG
LPTSPL: JRST NOTCCL ;SKIP IF NORMAL START
IFN FTUUOS,<
OUTSTR %%CCL ;NO CCL ENTRY
> ;END IFN FTUUOS
IFN FTJSYS,<
HRROI S1,%%CCL ;NO CCL ENTRY
PSOUT ;TYPE HIM
> ;END IFN FTJSYS
NOTCCL: RESET ;CLEAR ALL ACTIVE I/O
JRST LPTINI ;AND GO TO THE HISEG
TOPSEG
LPTINI: MOVE P,[IOWD PDSIZE,PDL]
SETO S1, ;TELL CSPQSR THAT I AM DOING THINGS MYSELF
PUSHJ P,CSPINI## ;INITIALIZE THE QUASAR INTERFACE
MOVEM S1,LPTPID ;SAVE MY PID
MOVEM S2,QRYFLG ;SAVE LOC TO SETOM
PUSHJ P,INTINI ;INITIALIZE THE INTERRUPT SYSTEM
SETZ S, ;CLEAR FLAG AC
SETZM XITFLG ;CLEAR EXIT PENDING FLAG
SETZM RSTFLG ;CLEAR RESET PENDING FLAG
SETOM MSGERR ;SET MESSAGE ON ERRORS
SETZM MSGFIL ;CLEAR MESSAGE ON FILES
SETZM MSGJOB ; ON JOBS
SETZM FMADR ;NO LPFORM.INI FILE
SETOM ACTFLG ;TURN ACCOUNTING ON
IFE ACCTSW,<
SETZM ACTFLG ;UNLESS HE DOESN'T WANT IT
> ;END IFE ACCTSW
MOVE T1,[PUSHJ P,UUOL] ;SETUP CALL TO UUO HANDLER
MOVEM T1,.JB41## ;STORE IN LOC 41
IFN FTUUOS,<
MOVX T2,<-2,,.GTDEV> ;GET THE HISEG DEVICE
GETTAB T2, ;GET IT
MOVSI T2,'DSK' ;DEFAULT IS DSK
MOVX T3,<-2,,.GTPRG> ;GET HISEG PROGRAM NAME
GETTAB T3, ; ..
MOVE T3,['LPTSPL'] ;GIVE THE DEFAULT
MOVX T4,<-2,,.GTPPN> ;GET THE HISEG PPN
GETTAB T4, ; ..
GETPPN T4, ;SAY SOMETHING
MOVEM T2,SEGBLK ;SAVE DEVICE
MOVEM T3,SEGBLK+1 ;SAVE FILE NAME
MOVEM T4,SEGBLK++4 ;SAVE DIRECTORY
SETZM SEGBLK+5 ;AND DON'T CALL CORE0
MOVE T1,[%CNTIC] ;GET GETTAB ADR
GETTAB T1, ;GET THE CLOCK FREQUENCY
MOVEI T1,^D60 ;ASSUME JIFSEC=60
MOVEM T1,JIFSEC ;AND STORE IT
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
MOVEI T1,.GTLOC ;LOCATION OF CENTRAL SITE
GETTAB T1, ;GETTAB IT
CLEAR T1, ;NO WHERE!!
HRRZM T1,CNTSTA ;HERE!!
HRROI T1,.GTLOC ;LOCATION OF ME
GETTAB T1, ;GET IT
SETZ T1, ;ASSUME 0
HRRZM T1,MYSTA ;AND STORE IT
HRLZS T1 ;PUT STATION IN LH
ADD T1,[100,,2] ;BUILD OPERATOR NUMBER
HRROI T2,.GTPPN ;GETTAB TO MY PPN
GETTAB T2, ;DO IT
JFCL ;IGNORE THE ERROR
MOVE T3,SEGBLK+1 ;GET PROGRAM NAME
CAME T1,T2 ;AM I REMOTE OPERATOR
SETNAM T3, ;NO, TURN OFF JACCT
> ;END OF IFN FTUUOS
IFN FTJSYS,<
SETZM CNTSTA ;CLEAR CENTRAL STATION
SETZM MYSTA ;CLEAR MY STATION
SETZM BLOKED ;CLEAR SLEEP FLAG
SETZM AWOKEN ;CLEAR AWOKEN FLAG
SETZM TTYRUN ;TTY PROCESS IS NOT RUNNING
SETZM TTYFLG ;AND NO LINE AVAILABLE
MOVX S1,'SYSVER' ;NAME OF GETTAB FOR SYSNAME
SYSGT ;GET IT
HRLZ T1,S2 ;GET TABLE#,,0
MOVEI T2,6 ;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
> ;END OF IFN FTJSYS
;HERE TO STARTUP A NEW CONTEXT FOR A LINE-PRINTER TO RUN IN
MOVEI S1,3 ;LOAD HOW MANY PAGES WE NEED
PUSHJ P,M$AQNP## ;GET 2 PAGES
PG2ADR AP ;CONVERT TO AN ADDRESS
MOVEM AP,JOBPAG ;AND SAVE IT
MOVE J,AP ;SETUP J
ADDI AP,J$$BEG ;POINT TO SECOND PAGE
HRLS AP ;GET ADR,,ADR
ADDI AP,1 ;GET ADR,,ADR+1
SETZM J$$BEG(J) ;CLEAR THE FIRST WORD
BLT AP,J$$END(J) ;CLEAR THE WHOLE PAGE
MOVEI T1,2000(J) ;GET ADDRESS OF BUFFER PAGE
MOVEM T1,J$LBUF(J) ;AND STORE IT
MOVE T1,NORMAL ;LOAD NAME OF NORMAL FORMS
MOVEM T1,J$FORM(J) ;SAVE AS CURRENTLY MOUNTED FORMS
MOVEM T1,J$FPFM(J) ;SAVE AS PREVIOUSLY MOUNTED FORMS
MOVEM T1,J$FSFM(J) ;SAVE AS SCHEDULING TYPE
CLEARM NXTJOB ;CLEAR OPR NEXT COMMAND
MOVX T1,MAXLIM ;GET INITIAL MLIMIT
MOVEM T1,J$XMLM(J) ;AND STORE IT
PUSHJ P,OPNFRM ;OPEN UP LPFORM.INI
TELL OPR,STAR ;FLASH A STAR
PUSHJ P,INTON ;TURN ON THE INTERRUPT SYSTEM
INILP: PUSHJ P,COMIN ;DO THE COMMAND
TXNN S,STARTD ;DID HE TYPE START?
JRST INILP ;NO, TRY AGAIN
JRST MAIN
SUBTTL OPNFRM -- Routine to read LPFORM.INI
;OPNFRM ATTEMPTS TO OPEN UP SYS:LPFORM.INI. IF THE FILE EXISTS,
; IT IS READ INTO CORE AND CLOSED AGAIN.
IFN FTUUOS,<
OPNFRM: MOVEI T1,.IODMP ;SET UP AND OPEN FORMS CHN
MOVSI T2,'SYS' ;ASCII ON SYS
SETZ T3, ;NO BUFFERS
OPEN FRM,T1 ;OPEN THE CHANNEL
JRST OPNF.1 ;NO FILE
MOVE T1,['LPFORM'] ;LOAD THE FILENAME
MOVSI T2,'INI' ;AND THE EXTENSION
SETZB T3,T4 ;CLEAR OTHER WORDS
LOOKUP FRM,T1 ;AND LOOK IT UP
JRST OPNF.1 ;LOSE
MOVE AP,FMADR ;GET THE WORD
ADR2PG AP ;CONVERT ADDRESS (IF ONE IS THERE)
SKIPN AP ;SKIP IF WE ALREADY HAVE A PAGE
PUSHJ P,M$ACQP## ;GET A PAGE
PG2ADR AP ;CONVERT TO ADR
MOVEM AP,FMADR ;AND SAVE IT
SOS T1,AP ;GET ADR-1
HRLI T1,-1000 ;IOWD 1000,ADR
SETZ T2, ;AND SET END OF LIST
INPUT FRM,T1 ;READ THE FILE
RELEAS FRM, ;RELEASE THE CHANNEL
SETOM FMNEW ;FLAG THE RE-READ
POPJ P, ;AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
OPNFRM: PUSHJ P,.SAVE1## ;SAVE P1
MOVX S1,<GJ%OLD!GJ%SHT> ;SHORT GETJFN OLD FILE ONLY
HRROI S2,[ASCIZ /SYS:LPFORM.INI/]
GTJFN
JRST OPNF.1 ;FILE NOT THERE
MOVE P1,S1 ;SAVE THE JFN IN P1
HRRZS S1 ;GET 0,,JFN
MOVX S2,<OF%RD+44B5> ;READ 36BIT BYTES
OPENF ;OPEN THE FILE
JRST OPNF.1 ;NO FILE
MOVE AP,FMADR ;GET THE WORD
ADR2PG AP ;CONVERT ADDRESS (IF ONE IS THERE)
SKIPN AP ;SKIP IF WE ALREADY HAVE A PAGE
PUSHJ P,M$ACQP## ;GET A PAGE
PG2ADR AP ;CONVERT TO AN ADDRESS
MOVEM AP,FMADR ;AND SAVE IT
MOVE S1,P1 ;GET THE JFN
MOVSI S2,(POINT 36,0) ;GET LH OF BYTE POINTER
HRRI S2,(AP) ;AND RIGHT HALF
MOVNI T1,1000 ;READ 1000 WORDS
SIN ;GET IT!!
CLOSF ;AND CLOSE THE FILE
JFCL ;IGNORE THE ERROR
SETOM FMNEW ;FLAG THE RE-READ
POPJ P, ;RETURN
> ;END IFN FTJSYS
OPNF.1: TELL OPR,%%FPM ;GIVE AN ERROR
MOVE AP,FMADR ;GET THE ADDRESS
ADR2PG AP ;CONVERT TO A PAGE NUMBER
SKIPE AP ;SKIP IF NOTHING THERE
PUSHJ P,M$RELP## ;ELSE RELEASE IT
SETZM FMADR ;CLEAR THE FLAG
POPJ P, ;AND RETURN
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
; INTTTY INTERRUPT ROUTINE -- TTY INPUT DONE
; INTDEV INTERRUPT ROUTINE -- LPT OFF-LINE
LOWSEG
;INTERRUPT SYSTEM DATABASE
IFN FTUUOS,<
VECTOR: BLOCK 0 ;BEGINNING OF INTERRUPT VECTOR
VECIPC: BLOCK 4 ;IPCF INTERRUPT BLOCK
VECTTY: BLOCK 4 ;TTY INPUT DONE INTERRUPT BLOCK
VECDEV: BLOCK 4 ;DEVICE INTERRUPT BLK
ENDVEC==.-1 ;END OF INTERRUPT VECTOR
> ;END IFN FTUUOS
IFN FTJSYS,<
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 3,INTIPC ;IPCF INT - LEVEL 3
XWD 3,INTDEV ;DEV OFF LINE INT - LEVEL 3
XWD 3,INTTTY ;TTY I/O INT - LEVEL 3
BLOCK ^D33 ;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
DEVACS: BLOCK T4+1 ;SAVE SOME ACS ON DEVICE INTERRUPTS
> ;END IFN FTJSYS
IFN FTUUOS,<
INTINI: MOVE S1,[VECTOR,,VECTOR+1] ;SETUP A BLT POINTER
SETZM VECTOR ;CLEAR THE FIRST WORD
BLT S1,ENDVEC ;CLEAR THE WHOLE THING
MOVEI S1,VECTOR ;LOAD ADDRESS OF INTERRUPT VECTOR
PIINI. S1, ;AND INITIALIZE THE SYSTEM
HALT
MOVEI S1,INTIPC ;GET ADDRESS OF IPCF INT RTN
MOVEM S1,VECIPC+.PSVNP ;SAVE IN VECTOR
MOVEI S1,INTTTY ;GET ADDRESS OF TTY INT RTN
MOVEM S1,VECTTY+.PSVNP ;SAVE IN VECTOR
MOVEI S1,INTDEV ;GET ADDRESS OF DEV OFF LINE INT RTN
MOVEM S1,VECDEV+.PSVNP ;AND SAVE IT
HRREI T1,.PCIPC ;IPCF CONDITION CODE
MOVSI T2,<VECIPC-VECTOR> ;VECTOR OFFSET
SETZ T3, ;RESERVED WORD
MOVX S1,PS.FAC+T1 ;ADD THE CONDTION
PISYS. S1, ;DO IT!!
HALT
MOVSI T1,'TTY' ;DEVICE CONDTION FOR TTY
MOVE T2,[<VECTTY-VECTOR>,,PS.RID] ;VECTOR OFFSET,,I/O RESON
SETZ T3, ;CLEAR T3
MOVX S1,PS.FAC+T1 ;ADD CONDITION
PISYS. S1, ;DO IT!!
HALT
POPJ P, ;AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
INTINI: MOVX S1,.FHSLF ;LOAD MY FORK HANDLE
MOVE S2,[LEVTAB,,CHNTAB] ;LOAD INTERUPT INFO ADDRESSES
SIR ;SETUP INTERRUPT SYSTEM ADDRESSES
MOVX S1,.FHSLF ;LOAD MY FORK HANDLE
MOVX S2,1B0!1B1!1B2 ;CHANNELS 1 2 AND 3
AIC ;ACTIVATE THE CHANNELS
MOVX S1,CR%MAP ;SIGNAL TO USE "MY MAP"
CFORK ;AND CREATE A FORK TO DO IT
HALT
MOVEM S1,TTYFRK ;SAVE THE FORK HANDLE
MOVX S2,SC%SUP!SC%FRZ ;CAPABILITIES FOR THE FORK
MOVE T1,S2 ;CAPABILITIES TO ENABLE
EPCAP ;ENABLE THE PROCESS CAPABILITIES
MOVX T1,.MUPIC ;FUNCTION TO CONN PID TO INT CHN
MOVE T2,LPTPID ;GET THE PID
MOVEI T3,0 ;GET THE INTERRUPT CHANNEL
MOVEI S1,3 ;ARG BLOCK LENGTH
MOVEI S2,T1 ;ARG BLOCK ADDRESS
MUTIL ;DO IT
HALT ;AND DIE
POPJ P, ;AND RETURN
> ;END IFN FTJSYS
IFN FTUUOS,<
INTOFF: MOVX S1,PS.FOF ;TURN OFF
PISYS. S1, ; THE INTERRUPT SYSTEM
HALT
POPJ P, ;AND RETURN
INTON: MOVX S1,PS.FON ;TURN ON
PISYS. S1, ; THE INTERRUPT SYSTEM
HALT
POPJ P, ;AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
INTOFF: MOVE S1,TTYFRK ;GET TTY FORK HANDLE
FFORK ;FREEZE IT
MOVX S1,.FHSLF ;GET FORK HANDLE
DIR ;DISABLE INTERRUPTS
POPJ P, ;AND RETURN
INTON: MOVX S1,.FHSLF ;GET FORK HANDLE
EIR ;ENABLE INTERRUPTS
MOVE S1,TTYFRK ;LOAD TTY FORK HANDLE
RFORK ;RESUME IT
POPJ P, ;AND RETURN
> ;END IFN FTJSYS
IFN FTUUOS,<
INTCNL: MOVEI T1,LPT ;USE CHANNEL AS CONDTION
MOVE T2,[<VECDEV-VECTOR>,,PS.RDO+PS.ROD+PS.ROL] ;OFFSET,,REASON
SETZ T3, ;ZERO T3
MOVX S1,PS.FAC+T1 ;ADD CONDITION
PISYS. S1, ;TO THE INTERRUPT SYSTEM
HALT
POPJ P, ;AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
INTCNL: MOVE S1,J$LJFN(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
MTOPR ;DO IT
ERJMP .+1 ;IGNORE THE ERROR
POPJ P, ;AND RETURN
> ;END IFN FTJSYS
;INTERRUPT ROUTINES
INTIPC: SETOM @QRYFLG ;SET FLAG FOR CSPQSR
JRST INTJEN ;AND DISMISS
INTTTY: SETOM TTYFLG ;SET INTERRUPT FLAG
IFN FTJSYS,<
SETZM TTYRUN ;INTERRUPT MEANS PROCESS HALTED
> ;END IFN FTJSYS
JRST INTJEN ;AND DISMISS
IFN FTUUOS,<
INTJEN: DEBRK. ;DISMISS THE INTERRUPT
HALT
HALT
> ;END IFN FTUUOS
IFN FTJSYS,<
INTJEN: PUSH P,S1 ;SAVE S1
MOVEI S1,OUTINT ;LOAD AN ADDRESS
SKIPE J$LIOA(J) ;INTERRUPTED OUT OF SOUT?
MOVEM S1,LEV3PC ;YES, SAVE IT
SETZM J$LIOA(J) ;CLEAR IOACTIVE
MOVEI S1,SUSP.1 ;LOAD RETURN ADDRESS
SETOM AWOKEN ;FLAG THAT WE SHOULD WAKEUP
SKIPE BLOKED ;WERE WE SLEEPING
MOVEM S1,LEV3PC ;YES, SET RETURN ADDRESS
SETZM BLOKED ;NO LONGER BLOCKED
POP P,S1 ;RESTORE S1
DEBRK ;DISMISS THE INTERRUPT
HALT
HALT
> ;END IFN FTJSYS
;HERE ON DEVICE OFF-LINE (ON-LINE) INTERRUPTS
IFN FTUUOS,<
INTDEV: PUSH P,S ;SAVE S
HRRZ S,VECDEV+.PSVFL ;GET I/O REASON FLAGS
ANDCAM VECDEV+.PSVFL ;AND CLEAR THEM OUT
TXNN S,PS.ROL!PS.ROD ;ON-LINE OR OUTPUT DONE?
JRST INTD.1 ;NO, DO OFF-LINE STUFF
SETZM J$LHNG(J) ;YES, CLEAR OFF-LING
POP P,S ;NO, RESTORE S
JRST INTJEN ;AND DISMISS
INTD.1: SKIPN J$LHNG(J) ;WAS THE DEVICE HUNG BEFORE?
JRST INTD.2 ;NO, TAKE A DIFFERENT PATH
MOVEI S,OUTWON ;YES, SETUP TO WAIT FOR THE
EXCH S,VECDEV+.PSVOP ; DEVICE TO COME BACK ONLINE
EXCH S,0(P) ; THEN CONTINUE ON WHEREVER
JRST INTJEN ; WE WERE.
INTD.2: TELL OPR,%%DOL ;DEVICE OFF LINE
MOVEI S,OUTERR ;LOAD ADR OF ERROR ROUTINE
SKIPN J$LIOA(J) ;ARE WE IOACTIVE?
MOVEI S,OUTWON ;NO, JUST WAIT FOR ON-LINE
SETOM J$LHNG(J) ;SET OFFLINE FLAG
EXCH S,VECDEV+.PSVOP ;SETUP PC TO DEBRK TO
EXCH S,0(P) ;SETUP RETURN ADDRESS
JRST INTJEN ;AND DISMISS THE INTERRUPT
> ;END IFN FTUUOS
IFN FTJSYS,<
INTDEV: MOVEM S,DEVACS ;SAVE AC 0
MOVE S,[1,,DEVACS+1] ;SETUP TO SAVE THE REST
BLT S,DEVACS+T4 ;AND DO IT
MOVE S1,J$LJFN(J) ;GET THE LPT JFN
MOVX S2,.MORST ;READ-STATUS FUNCTION
MOVEI T1,T2 ;AND ADDRESS OF ARGS
MOVEI T2,3 ;LENGTH OF ARG BLOCK
MTOPR ;READ THE STATUS
TXNE T3,MO%OL ;IS IT OFF-LINE?
JRST INTD.1 ;YES, DO SOME WORK
SETZM J$LHNG(J) ;NO, CLEAR THE HUNG FLAG
JRST INTD.3 ;AND RESTORE SOME STUFF
INTD.1: MOVX S,BUSY ;LOAD THE BUSY BIT
TDNN S,DEVACS+S ;WAS IT SET?
JRST INTD.2 ;NO, NO MESSAGE
SKIPN J$LHNG(J) ;WAS IT HUNG BEFORE TOO?
TELL OPR,%%DOL ;NO, FIRST TIME THRU
INTD.2: SETOM J$LHNG(J) ;AND SET THE FLAG
INTD.3: MOVSI T4,DEVACS ;SETUP TO RESTORE ACS
BLT T4,T4 ;DO IT
JRST INTJEN ;AND DO THE JEN
> ;END IFN FTJSYS
;SUB-PROCESS TO READ FROM TTY. THE FOLLOWING ROUTINE IS EXECUTED
; BY AN INFERIOR FORK TO READ INPUT FROM THE TELETYPE. WHEN
; A LINE HAS BEEN TYPED, LPTSPL IS INTERRUPTED ON CHANNEL 2
; AND THIS FORK HALTS
IFN FTJSYS,<
TTYRD: HRROI S1,TTYBUF ;LOAD POINTER TO BUFFER
MOVX S2,RD%BRK!RD%BEL!RD%RAI+<30*5>
RDTTY ;AND WAIT FOR A LINE
HALT
MOVX S1,.FHSUP ;MY SUPERIORS HANDLE
MOVX S2,1B2 ;AND MASK
IIC ;GENERATE AN INTERRUPT
HALTF ;STOP
;THE FOLLOW ROUTINE IS CALLED TO START UP THE TTY FORK.
TTYSTA: SKIPE TTYRUN ;RUNNING ALREADY?
POPJ P, ;YES, JUST RETURN
SETZM TTYFLG ;NO, CLEAR THE LINE FLAG
PUSH P,S1 ;SAVE S1
PUSH P,S2 ;SAVE S2
MOVE S1,TTYFRK ;GET FORK HANDLE
MOVEI S2,TTYRD ;AND STARTING ADDRESS
SETOM TTYRUN ;SET THE FLAG
SFORK ;START IT GOING
POP P,S2 ;RESTORE S2
POP P,S1 ;RESTORE S1
POPJ P, ;AND RETURN
> ;END IFN FTJSYS
SUBTTL MESSAGES
;THE FIRST CHAR OF EACH MESSAGE IS THE PRIORITY THE SECOND IS THE
;INITIAL LENGTH CODE. THE FOLLOWING CHARACTORS HAVE A SPECIAL MEANING:
;
; # PRINT N AS DECMAL
; & PRINT N AS OCTAL
; @ PRINT THE DATE AND TIME
; ^ PRINT THE CURRENT FILE NAME
; ] PRINT THE IDENTIFICATION OF CURRENT USER
; ; CHANGE LENGTH CODE (NEW CODE AFTER ;)
; + PRINT T1 AS A SIXBIT WORD
; $ PRINT CURRENT PROCESSING DEVICE
;***WARNING*** This page is in upper and lower case and
; should not be edited with TECO unless you have a Full char
; set TTY. If it is neccessary to edit on a KSR33 or
; similar TTY use an editor which will indicate lower case
; for example SOS (DECUS 10-16)
;
DEFINE TEXT,<
XLIST
WHAT6: ASCIZ \Printed:#/\
WHAT7: ASCIZ /# pages
/
WHAT8: ASCIZ \, Copy:#/\
WHAT9: ASCIZ /#, /
WHAT12: ASCIZ /page:#
/
WHAT10: ASCIZ \File:^/\
WHAT11: ASCIZ /+/
WHATB7: ASCIZ /BACKSPACE in progress
/
BADNMS: ASCIZ / BAD Decmal number
/
BADSW: ASCIZ /Bad Switch
/
CURMS1: ASCIZ /Current defaults:
MLIMIT:#
/
CURMS2: ASCIZ /NEXT Job is sequence !##
/
;USER ERROR MESSAGES
%%RBO: ASCIZ /![LPTRBO Job Requeued By the Operator!]
/
%%OCL: ASCIZ /![LPTOCL Operator changed limit to # pages!]
/
%%KBO: ASCIZ /?LPTKBO Job Killed By the Operator
/
%%CBU: ASCIZ /?LPTCBU Job Cancelled on Request by user: /
%%PLE: ASCIZ /?LPTPLE Page Limit Exceeded
/
%%ORC: ASCIZ /![LPTORC Operator restarted copy !## of ^!]
/
%%OSC: ASCIZ /![LPTOSC Operator skipped copy !## of ^!]
/
%%OSF: ASCIZ /![LPTOSF Operator skipped file ^!]
/
%%CPT: ASCIZ /![LPTCPT Checkpoint Taken during file ^, copy #, /
%%CPT1: ASCIZ /page #!]
/
%%BSF: ASCIZ /![LPTBSF Backspacing File ^, # pages!]
/
%%FSF: ASCIZ /![LPTFSF Forward Spacing File ^, # pages!]
/
%%JBR: ASCIZ /![LPTJBR Job Being Restarted after /
%%JBR1: ASCIZ /system failure!]
/
%%JBR2: ASCIZ /requeue by the operator!]
/
%%RLE: ASCIZ /![LPTRLE Recoverable Lineprinter Error during copy # of file ^!]
/
%%RLE1: ASCIZ /![ Backspacing 5 pages and continuing!]
/
;OPERATOR MESSAGES
%%FAF: ASCIZ /![LPTFAF Type '+' forms are frozen!]
/
%%WFF: ASCIZ /![LPTWFF Waiting for + forms to be mounted!]
/
%%WFS: ASCIZ /![LPTWFS Waiting for a START command!]
/
%%LIR: ASCIZ /![LPTLIR LPTSPL is RESET on $!]
/
%%SIS: ASCIZ /![LPTSIS Spooler is STOP'ed or PAUSE'ing!]
/
%%LWP: ASCIZ /![LPTLWP LPTSPL will PAUSE at end of job!]
/
%%CPC: ASCIZ /![LPTCPC Clearing pending EXIT, RESET, and PAUSE commands!]
/
%%DIS: ASCIZ /?LPTDIS Device $ is spooled
/
%%DDE: ASCIZ /?LPTDDE Device + does not exist
/
%%CCL: ASCIZ /%LPTCCL CCL entry is not supported
/
%%URC: ASCIZ /%LPTURC + is an Unrecognized Command
/
%%CFA: ASCIZ /?LPTCFA Can't Find Align File: +
/
%%ICA: ASCIZ /?LPTICA Illegal Command Argument # Ignored
/
%%ICAS: ASCIZ /?LPTICA Illegal command argument + ignored
/
%%CAF: ASCIZ /?LPTCAF Can't Access File ^, code & - /
%%CFV: ASCIZ /?LPTCFV Cannot Find VFU '+' for $, requeuing job
/
;OPERATOR MESSAGES CONTINUED
%%LAS: ASCIZ /%LPTLAS LPTSPL is Already START'ed on $
/
%%STF: ASCIZ /![LPTSTF Starting File ^!]
/
%%FPF: ASCIZ /![LPTFPF Finished Printing File ^!]
/
%%SJS: ASCIZ /![LPTSJS Starting Job +, Seq !##, request created at /
%%LWE: ASCIZ /![LPTLWE LPTSPL will EXIT at end of job!]
/
%%LWR: ASCIZ /![LPTLWR LPTSPL will RESET at end of job!]
/
%%LII: ASCIZ /![LPTLII LPTSPL is idle on $!]
/
%%DNA: ASCIZ /?LPTDNA Device $ is not available
/
%%DOL: ASCIZ /%LPTDOL Device $ is Off-Line
/
%%TFM: ASCIZ /![LPTTFM Type '+' forms are mounted!]
/
%%LVF: ASCIZ /![LPTLVF Loading VFU '+' in $!]
/
%%FPM: ASCIZ /%LPTFPM Forms Parameter File LPFORM.INI is Missing
/
%%FHB: ASCIZ /![LPTFHB Type '+' forms have been requested!]
/
MOUNTM: ASCIZ .Mount '+' forms then type GO
.
IFN FTUUOS,<
%%EWL: ASCIZ /%LPTEWL Error Writing LOG File, status &
/
%%FSD: ASCIZ \?LPTFSD File Skipped due to I/O errors, status &
\
%%IDE: ASCIZ /%LPTIDE Input Data Error & in file ^, output may be incorrect
/
%%CFD: ASCIZ /%LPTCFD Cannot Find Default VFU file for $
Loading hardware VFU as default
/
%%ELV: ASCIZ /?LPTELV Error Loading VFU in $, Resetting
/
> ;END IFN FTUUOS
IFN FTJSYS,<
%%CFD: ASCIZ /?LPTCFD Cannot find default VFU file for $, reseting
/
%%FER: ASCIZ /%LPTFER Front-End was reloaded, recovering on $
/
> ;END IFN FTJSYS
%%ULE: ASCIZ /%LPTULE Unexpected Lineprinter Error on $, status &
/
%%VFE: ASCIZ /?LPTVFE VFU Error on $, Please re-align the forms
/
%%TML: ASCIZ /?LPTTML Too Many Lineprinter Errors on $, resetting
/
IFN FTUUOS,<
STAR: ASCIZ !/!
EXCLPT: ASCIZ /!!/
> ;END IFN FTUUOS
IFN FTJSYS,<
STAR: ASCII /LPTSP/
BYTE (7) "L",76,0
EXCLPT=STAR
> ;END IFN FTJSYS
DEFINE INTRO(V,E),<
ASCIZ /![LPTLSJ LPTSPL version V(E) running on $, @!]
/>
%%LSJ: INTRO(\LPTVER,\LPTEDT)
STARS: ASCII "00000000000000000000000000000000000000000000000000"
ASCII "00000000000000000000000000000000000000000000000001"
ASCII "111111111111111111111111111111"
BYTE (7)61,61,23,15,15
ASCII "00000000011111111112222222222333333333344444444445"
ASCII "55555555566666666667777777777888888888899999999990"
ASCII "000000000111111111122222222223"
BYTE (7)63,63,23,15,15
ASCII "12345678901234567890123456789012345678901234567890"
ASCII "12345678901234567890123456789012345678901234567890"
ASCII "123456789012345678901234567890"
BYTE (7)61,62,23,0 ; 12<DC3><NULL>
JBHDR1: ASCIZ /User ] Job + /
JBHDR4: ASCIZ /Seq. # /
JBHDR5: ASCIZ /Date @ /
JBHDR8: ASCIZ /Monitor /
HDRMSG: ASCIZ / *START* /
TRLMSG: ASCIZ / **END** /
CRLF: BYTE (7) .CHCRT,.CHLFD,00,00,00
CRDC3: BYTE (7) .CHCRT,23,00,00,00
LIST
SALL> ;CLOSE TEXT MACRO
TOPSEG ;PUT MESSAGES IN HISEG
TEXT
LOWSEG
VAR
LIT
LPTEND::END LPTSPL