Trailing-Edge
-
PDP-10 Archives
-
AP-4172F-BM
-
3a-sources/d60spl.mac
There are 2 other files named d60spl.mac in the archive. Click here to see a list.
TITLE D60SPL -- Spooler for DN61/DN64
SUBTTL D.A. Lewine - L.S. Samberg/LSS 13 Nov 77 (+JBS/MM 14-Sep-77)
; ADDED DN60 FEATURES 24-MAY-77 /JBS
; Digital Equipment Corp., Maynard, MA.
;ASSEMBLY AND LOADING INSTRUCTIONS
;
; .COMP D60SPL
; .LOAD /REL D60SPL
; .SSAVE D60SPL
SEARCH QSRMAC ;SEARCH GALAXY PARAMETERS
PROLOGUE(LPTSPL)
IFN FTJSYS,<
SEARCH RMSSYM
SEARCH ACTSYM
> ;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==103 ;MAJOR VERSION NUMBER
LPTMIN==0 ;MINOR VERSION NUMBER
LPTEDT==2304 ;EDIT LEVEL
LPTWHO==1 ;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
;COPYRIGHT (C) 1977, 1978 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
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.
;
;2277 DN60 additions -- LCG Advanced Software Group
;
;2300 MAKE THIS VERSION 103. FIX A BUG WHICH CAUSED LPTSPL TO REQUIRE
; THAT LPFORM.INI EXIST. INSERT CODE FOR USAGE ACCOUNTING ON THE -20.
;2301 improve performance by using "Input Permission was Requested"
; bit from the DN60.
;
;2302 CORRECT USAGE JSYS DATA TO PROVIDE USER NAME IN .USNM2
;
;2303 If the .EQ has no account string filled in, use the account
; string from the first file printed for the job (on -20).
;2304 LINE-SEQUENCE NUMBERS IN LPFORM.INI DON'T WORK BECAUSE THE
; TAB WAS NOT BEING EATEN UP.
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
;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
;
; PARAMETERS
;
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
SYSPRM D60SPL,-1,-1 ;DN60 SUPPORT
IFN D60SPL,<
SEARCH QPRM ;ABSORB QMANGR SYMBOLS BECAUSE
; D60SPL IS ALSO AN UNKNOWN
; COMPONENT
IFN FTJSYS,<
.REQUIRE C11SIM ;LOAD THE CAL11. UUO SIMULATOR
>
IF1,<
PRINTX ...WITH DN60 SUPPORT
>>
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 (ONLY ON TOPS-10)
DEFINE LOWSEG,<IFE <FTJSYS&D60SPL>,<
IFN SEG,<
XLIST
LIT
LIST
SALL
RELOC>
SEG==0>>
IFN D60SPL,<
;RELOC TO LOWSEG FOR VARIABLES (TOPS-20)
DEFINE VARSEG,<
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
VARSEG ;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
; PASSWORD:SS PASSWORD (USED ONLY FOR 'NORMAL' FORMS)
; (D60SPL ONLY)
;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
IFN D60SPL,<FF PASSWORD,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
F$CL3==^D120 ;WIDTH CLASS THREE IS F$CL2 TO F$CL3
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
IFN D60SPL,<
BIT S,IHGTLP, ;(14) I HAVE GOT THE LINE PRINTER
BIT S,INCMND, ;(15) PROCESSING A COMMAND
>
IFE D60SPL,<
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
IFE D60SPL,<
BIT S,XXX, ;(27)
>
IFN D60SPL,<
BIT S,FILOPN, ;(27) DISK FILE OPEN
>
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 D60SPL,<
LP J$LD60,1 ;-1 IF DN60
>
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
; (OPR MSG BUFFER IN D60SPL)
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$ADTM,1 ;DATE,,TIME
LP J$ARTM,1 ;RUNTIME USED
LP J$APRT,1 ;# PAGES PRINTED
LP J$ADRD,1 ;DISK FILE READS
> ;END IFN FTJSYS
LP J$ASEQ,1 ;REMEMBER SEQUENCE NUMBER
LP J$APRI,1 ;REMEMBER EXTERNAL PRIORITY
LP J$AFXC,1 ;FILES * COPIES
;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
IFN D60SPL,<
MSGLIN: BLOCK 1 ;-1 ON MESSAGE LINE (ACTIVITY)
>
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
IFN D60SPL,<
.MYSTA:: ;THIS LOCATION IS REFERENCED BY D60QMR
>
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
IFE D60SPL,<
SKIPE RSTFLG ;NO, WHAT ABOUT A RESET
JRST DOREST ;YUP!
>
IFN D60SPL,<
SKIPN RSTFLG ;HAVE WE BEEN ASKED TO RESET?
JRST SLP3 ;NO.
PUSHJ P,DOREST ;YES, SAY "GOODBY" TO QUASAR
TELL OPR,%%LIR ;PRINT OPR AWARENESS MESSAGE
JRST LPTSPL ;REINITIALIZE EVERYTHING
SLP3: SKIPN J$LD60(J) ;ARE WE ON A DN60?
JRST SLP4 ;NO.
MOVE T1,D60FGS ;YES, GET FLAGS
TRNN T1,D60SSU ;ARE WE SIGNED OFF?
TXNN S,RUNB ;AND RUNNABLE?
SKIPA ;NO.
ON S,PAUSEB ;YES, DON'T TRY TO RUN.
SLP4:
>
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
IFN D60SPL,<
SKIPN S1,D60DLY ;ARE WE ASKED TO DELAY?
JRST SLP2 ;NO.
PUSHJ P,SUSPND ;YES, WAIT A WHILE.
SKIPN @QRYFLG ;WERE WE STOPPED BY IPCF INTERRUPT?
SKIPE TTYFLG ;OR TYPEIN?
SKIPA ;YES.
SETZM D60DLY ;NO, DELAY HAS BEEN DONE.
PUSHJ P,SNDSTC ;SEND STATUS IN CASE CHANGED
;
; FALL INTO SLP2
;
> ;END OF IFN D60SPL
;
; CONTINUATION OF MAIN LOOP
;
SLP2:
IFN D60SPL,<
PUSHJ P,CHKOP0 ;PERFORM OPERATOR COMMANDS
TXNN S,RUNB ;DID OPERATOR CLEAR "RUN"?
JRST SLP1 ;YES, WAIT AND TRY AGAIN
PUSHJ P,CHKQU0 ;NO, ANY MESSAGES FOR US?
>
IFE D60SPL,<
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
IFN D60SPL,<
PUSHJ P,QIDLE ;DO IDLE-TIME CHECKS
MOVEI S1,^D20 ;60 SECONDS
>
IFE D60SPL,<
MOVEI S1,^D60 ;60 SECONDS
>
PUSHJ P,SUSPND ;GO WAIT
IFE D60SPL,<
JRST SLP0 ;AND LOOP
>
IFN D60SPL,<
JRST MAIN ;AND LOOP
>
SUBTTL Job Setup
SETJOB:
IFN D60SPL,<
SKIPE D60DLY ;IS A DELAY REQUESTED?
JRST SETJ.2 ;YES, GO BACK AND DO IT.
SKIPN J$LD60(J) ;ON A DN60?
JRST SETJ.3 ;NO.
MOVE T1,D60FGS ;YES, GET FLAGS
TRNN T1,D60SSU ;ARE WE SIGNED ON?
JRST SETJ.2 ;NO, REQUEUE THIS JOB.
SETJ.3: PUSHJ P,OUTGET ;INIT THE OUTPUT DEVICE
JRST SETJ.2 ;IT IS NOT AVAILABLE
>
;
; ;CONTINUED ON NEXT PAGE
;
;
; HERE WHEN WE HAVE A JOB TO DO, AND WE OWN THE PRINTER.
;
ON S,BUSY ;WE'VE GOT A JOB!!
IFE D60SPL,<
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
IFN D60SPL,<
JRST DOJOB ;DO THE JOB
>
; HERE IF THE OUTPUT DEVICE IS NOT AVAILABLE
IFN D60SPL,<
SETJ.2: SETZM J$RNFP(J) ;CLEAR OUT THE CHECKPOINT VALUES
SETZM J$RNCP(J)
SETZM J$RNPP(J)
MOVEI T1,1 ;DELAY FOR THREE SECONDS
MOVEM T1,D60DLY
PUSHJ P,SNDSTC ;SEND 'DELAYING' STATUS
PUSHJ P,DOREQ ;REQUEUE THE CURRENT JOB
PUSHJ P,CLNLOG ;EMPTY INTERNAL LOG
JRST MAIN ;DO THINGS AGAIN.
>
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
; SUBROUTINE TO BUMP TO NEXT FILE
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
IFN D60SPL,<
TXNE S,IHGTLP ;FORGET IT IF NO PRINTER
>
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,COPY ;DO THE COPY LOOP
IFN D60SPL,<
TXNE S,IHGTLP ;HAVE WE LOST THE PRINTER?
>
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
IFN D60SPL,<
POPJ P, ;OUTPUT ERROR
>
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
AOS J$AFXC(J) ;INCREMENT FILES*COPIES
OFF S,NOTYPE!DSKOPN ;CLEAR SOME FLAGS
IFN D60SPL,<
TXNE S,IHGTLP ;QUIT IF NO PRINTER
>
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
IFE D60SPL,<
MOVEI T1,MSGBLK ;LOAD ADDRESS
TXNN S,RQB ;DON'T SEND REL IF WE HAVE REQ'D
PUSHJ P,SNDQSR## ;SEND IT
>
IFN D60SPL,<
TXNN S,IHGTLP ;HAVE WE THE PRINTER?
JRST ENDJ.1 ;NO, SKIP MOST OF THIS.
>
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
;CONTINUED ON NEXT PAGE
;
; CONTINUATION OF ENDJOB. HERE WHEN THE TRAILER IS COMPLETE.
;
ENDJ.1:
IFE D60SPL,<
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
IFE D60SPL,<
TELL OPR,[ASCIZ /Finished /]
>
IFN D60SPL,<
MOVEI T1,[ASCIZ /Finished /]
TXNE S,RQB ;DIFFERENT MESSAGE IF REQUEUED
MOVEI T1,[ASCIZ /Requeued /]
TELL OPR,(T1)
>
PUSHJ P,WHAT ;JOB ID
;
; HERE TO DO THE FINAL CLEANUP OF THE JOB.
;
ENDJ.2:
IFN D60SPL,<
PUSHJ P,OUTCLS ;CLOSE OUTPUT DEVICE
JFCL ;ERROR WILL REQUEUE
MOVEI T1,MSGBLK ;LOAD ADDRESS
TXNN S,RQB ;DON'T SEND REL IF WE HAVE REQ'D
PUSHJ P,SNDQSR## ;SEND IT
PUSHJ P,CLNLOG ;BE SURE INTERNAL LOG IS EMPTY
>
OFF S,BUSY!RQB ;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.
IFE D60SPL,<
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 D60SPL,<
TXNE S,INCMND ;ALREADY DOING A COMMAND?
POPJ P, ;YES, WAIT UNTIL IT'S DONE
>
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:
IFN D60SPL,<
ON S,INCMND ;MARK WE ARE IN A COMMAND
>
PUSHJ P,COMIN ;DO ONE COMMAND
IFN D60SPL,<
OFF S,INCMND ;COMMAND IS COMPLETE
>
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
;
; SUBROUTINE TO CHECK FOR A MESSAGE FROM QUASAR
;
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
IFN D60SPL,<
ON S,FILOPN ;FLAG THAT FILE IS OPEN
>
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
HRROI S2,.EQACT(J) ;POINT TO THE ACCOUNT STRING
SKIPN .EQACT(J) ;IS THERE AN ACCOUNT STRING?
GACTF ;NO, GET ONE
JFCL ;IGNORE ERROR
JFCL ;RETURN #1
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
IFE D60SPL,<
PJRST .TRUE## ;WIN RETURN
>
IFN D60SPL,<
JRST OPIN.4 ;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
IFE D60SPL,<
PJRST .TRUE## ;AND RETURN TRUE
>
IFN D60SPL,<
JRST OPIN.4 ;WIN RETURN
>
;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
;
; HERE TO GIVE THE WIN RETURN.
;
OPIN.4: TXO S,FILOPN ;MARK INPUT FILE OPEN
PJRST .TRUE## ; AND RETURN 'TRUE'.
;
> ;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
IFN D60SPL,<
TXNE S,FILOPN ;IF FILE IS OPEN...
>
RENAME DSK,T1 ;DELETE IT
JFCL ;IGNORE THIS
POPJ P, ;AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
DELFIL:
IFN D60SPL,<
TXNN S,FILOPN ;IS FILE STILL OPEN?
POPJ P, ;NO, DONT CLOSE IT AGAIN.
>
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
IFE D60SPL,<
OFF S,DSKOPN ;TURN OFF THE OPEN FLAG
>
IFN D60SPL,<
OFF S,DSKOPN!FILOPN ;TURN OFF THE OPEN FLAGS
>
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
IFE D60SPL,<
OFF S,DSKOPN ;CLEAR THE OPEN FLAG
POPJ P, ;AND RETURN
>
IFN D60SPL,<
JRST CLSF.2 ; AND FINISH UP
>
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
IFN D60SPL,<
CLSF.2: OFF S,DSKOPN!FILOPN ;CLEAR THE OPEN FLAGS
>
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
IFN D60SPL,<
CAILE S1,3 ;MAX OF THREE
MOVEI S1,3 ; ...
>
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
IFN D60SPL,<
CAILE S1,3 ;GREATER THEN THREE?
MOVEI S1,3 ;YES, MAKE IT THREE.
>
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
;CONTINUED ON NEXT PAGE
;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
; 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: MOVX S1,.FHSLF ;GET FORK HANDLE
RUNTM ;GET MY RUNTIME
MOVNM S1,J$ARTM(J) ;REMEMBER IT NEGATED
LOAD S1,.EQSEQ(J),EQ.SEQ ;GET SEQUENCE NUMBER
STORE S1,J$ASEQ(J) ;STORE IT
GTAD ;GET TIME AND DATE
STORE S1,J$ADTM(J) ;STORE IT
LOAD S1,.EQSEQ(J),EQ.PRI ;GET EXTERNAL PRIORITY
STORE S1,J$APRI(J) ;STORE IT
SETZM J$AFXC(J) ;CLEAR OUT FILES * COPIES
SETZM J$ADRD(J) ;CLEAR DISK READS COUNTER
SETZM J$APRT(J) ;CLEAR PAGES PRINTED
POPJ P, ;RETURN
> ;END IFN FTJSYS
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
MOVX S1,.USENT ;WRITE AN ENTRY
MOVEI S2,ACTLST ;POINT TO THE LIST
USAGE ;DO THE JSYS
ERCAL [TELL OPR,[ASCIZ /?LPTUJF USAGE JSYS FAILED
/]
POPJ P,]
POPJ P, ;AND RETURN
ACTLST: USENT. (.UTOUT,1,1)
USJNO. (-1)
USTAD. (-1)
USTRM. (-1)
USLNO. (-1)
USPNM. (<SIXBIT/D60SPL/>,US%IMM)
USPVR. (%LPT,US%IMM)
USAMV. (-1)
USNOD. (-1)
USACT. (<POINT 7,.EQACT(J)>)
USSRT. (J$ARTM(J))
USSDR. (J$ADRD(J))
USSDW. (0,US%IMM)
USJNM. (.EQJOB(J))
USQNM. (<SIXBIT /LPT/>,US%IMM)
USSDV. (J$LDEV(J))
USSSN. (J$ASEQ(J))
USSUN. (J$APRT(J))
USSNF. (J$AFXC(J))
USCRT. (.EQAFT(J))
USSCD. (J$ADTM(J))
USFRM. (.EQLM1(J))
USDSP. (<SIXBIT/NORMAL/>,US%IMM)
USTXT. (<-1,,[ASCIZ / /]>)
USPRI. (J$APRI(J))
USNM2. (<POINT 7,.EQOWN(J)>)
0 ;END OF LIST
> ;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,< IFE D60SPL,<
C ALIGN,ALIGN,0
> ;END OF IFE D60SPL
> ;END IFN FTUUOS
IFN D60SPL,<
C SET,D60SET,0
C SIGNON,D60SON,0
C SIGNOFF,D60SOF,0
> ;END OF IFN D60SPL
> ;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
IFN D60SPL,<
;LKNAME -- LOOKUP NAME IN TABLE ALLOWING FOR UNIQUE ABBREVIATIONS
;ALWAYS CHECK FOR EXACT MATCH FIRST.
;CALL: MOVE T1,[IOWD LENGTH,START OF TABLE]
; MOVE T2,NAME
; PUSHJ P,LKNAME
; ERROR RETURN IF UNKNOWN OR DUPLICATE
; AND WITH T1.LT.0 IF NOT MATCH, .GT.0 IF SEVERAL MATCHES
; SKIP RETURN IF FOUND WITH T1 POINTING TO ENTRY
; AND WITH LH(T1)=0 IF ABBREVIATION, OR T1.LT.0 IF EXACT MATCH
;USES T3, T4
;PRESERVES T2
LKNAME: JUMPGE T1,[SETOM T1 ;FLAG UNKNOWN
POPJ P,] ;ERROR RETURN
PUSH P,P1 ;SAVE P1
PUSH P,P2 ; AND P2
PUSH P,T1 ;SAVE ARGUMENT
MOVE T3,T2 ;SET ARG TO MASK MAKER
PUSHJ P,MAKMSK ;MAKE MASK
MOVE T2,T3 ;RESTORE NAME
MOVE P1,T1 ;SAVE FOR MATCHING
POP P,T1 ;RECOVER ARGUMENT
SETOM P2 ;SET ABBREVIATION MATCH COUNTER
AOS T1 ;POSITION POINTER
NAME1: MOVE T3,(T1) ;FETCH TABLE ENTRY
TLNE T3,(3B1) ;NOTE THAT * IS 12 IN SIXBIT
JRST NAME2 ;NOT FORCED MATCH
LSH T3,6 ;SEE IF IT MATCHES
XOR T3,T2 ;EVEN IN AN ABBR.
TRZ T3,77 ;CLEAR LAST CHAR SINCE WE DON'T KNOW IT
AND T3,P1 ; ..
JUMPE T3,NAME4 ;YES--GIVE MATCH RETURN
JRST NAME3 ;NO--LOOP
NAME2: XOR T3,T2 ;SEE IF EXACT MATCH
JUMPE T3,NAME4 ;YES--A WINNER
AND T3,P1 ;SEE IF A SUITABLE ABBREVIATION
JUMPN T3,NAME3 ;NO--LOOP BACK FOR MORE
MOVE T4,T1 ;SALT AWAY THE LOCATION JUST IN CASE
AOS P2 ;YES--COUNT
NAME3: AOBJN T1,NAME1 ;ADVANCE--LOOP IF NOT DONE YET
HRRZ T1,T4 ;RESTORE LOCATION OF A WINNER
JUMPE P2,NAME4 ;DONE--JUMP IF ONE ABBREVIATION
MOVE T1,P2 ;GIVE FLAG TO CALLER
POP P,P2 ;RESTORE P2
POP P,P1 ; AND P1
POPJ P, ;NONE OR TWO, SO FAIL
; SUBROUTINE LKNAME CONTINUED
; HERE ON SUCCESS
NAME4: POP P,P2 ;RESTORE P2
POP P,P1 ; AND P1
AOS (P) ;SKIP RETURN
POPJ P, ;RETURN.
;MAKMSK -- MAKE MASK CORRESPONDING TO NON-BLANKS IN SIXBIT WORD
;CALL: MOVE T3,WORD
; PUSHJ P,MAKMSK
;RETURN WITH MASK IN T1
;USES T2
MAKMSK: MOVEI T1,0 ;CLEAR MASK
MOVSI T2,(77B5) ;START AT LEFT END
MAKMS1: TDNE T3,T2 ;SEE IF SPACE HERE
IOR T1,T2 ;NO--IMPROVE MASK
LSH T2,-6 ;MOVE RIGHT ONE CHAR
JUMPN T2,MAKMS1 ;LOOP UNTIL DONE
POPJ P, ;RETURN
> ;END OF IFN D60SPL
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
IFE D60SPL,<
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
> ;END OF IFE D60SPL
IFN D60SPL,<
MOVE T2,T1 ;PUT COMMAND NAME IN T2
MOVE T1,[IOWD DISPL,COMTAB] ;POINT TO COMMAND TABLE
PUSHJ P,LKNAME ;SEARCH THE TABLE
JRST NOCOM ;NO MATCH
HRRZ T2,T1 ;MATCH, GET POINTER TO TABLE ENTRY
SUBI T2,COMTAB ;COMPUTE OFFSET
>
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:
IFN D60SPL,<
MOVE T1,T2 ;GET COMMAND NAME
>
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
IFE D60SPL,<
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
;
; HERE TO READ THE DEVICE NAME
;
STAR.3: PUSHJ P,SIXIN ;GET A DEVICE NAME
MOVX T1,DEFLPT ;USE THE DEFAULT
MOVEM T1,J$LGNM(J) ;SAVE AS GIVEN NAME
IFE D60SPL,<
PUSHJ P,OUTGET ;OPEN THE DEVICE
>
IFN D60SPL,<IFN FTUUOS,<
MOVE T1,J$LGNM(J) ;GET ARG TO "START"
DEVNAM T1, ;GET ITS PHYSICAL NAME
JRST STAR.8 ;NONE.
MOVEM T1,J$LDEV(J) ;STORE PHYSICAL NAME
MOVEM T1,J$LSDV(J) ; AND DEFAULT SCHEDULING DEVICE
SETZM J$LD60(J) ;FLAG US AS NOT ON A DN60
JRST STAR.4 ;CONTINUE.
;
; HERE IF THE DEVICE HAS NO PHYSICAL NAME
;
STAR.8: MOVE T1,J$LGNM(J) ;GET START ARGUMENT
CAME T1,[SIXBIT /DN61/] ;SPECIAL ARGUMENT?
JRST STAR.E ;NO, NO SUCH DEVICE.
PUSHJ P,D60STR ;YES, SPECIAL COMMAND FORM
POPJ P, ;ERROR.
JRST STAR.7 ;COMPLETE START COMMAND
; (NO "=" CONSTRUCTION)
;
> ;END OF IFN FTUUOS
IFN FTJSYS,<
MOVE T1,J$LGNM(J) ;GET ARG TO "START"
CAME T1,[SIXBIT /DN64/] ;IS IT DN64?
JRST STAR.9 ;NO.
PUSHJ P,D60STR ;YES, SPECIAL COMMAND FORM
POPJ P, ;ERROR
JRST STAR.7 ;COMPLETE START COMMAND
; (NO "=" CONSTRUCTION)
;
; HERE IF NOT "DN64"
;
STAR.9: MOVEM T1,J$LDEV(J) ;STORE PHYSICAL NAME
LSH T1,6 ;SHIFT OFF POSSIBLE "P"
MOVEM T1,J$LSDV(J) ; AND STORE DEFAULT SCHEDULING DEVICE
SETZM J$LD60(J) ;FLAG US NOT ON A DN60
JRST STAR.4 ; CONTINUE.
;
> ;END OF IFN FTJSYS
> ;END OF IFN D60SPL
;"START" IS CONTINUED ON THE NEXT PAGE
;
; "START" COMMAND CONTINUED FROM THE PREVIOUS PAGE
;
IFN D60SPL,<
;
; HERE IF THE DEVICE DOES NOT EXIST AND IS NOT 'DN61' OR 'DN64'
;
STAR.E: MOVE T1,J$LGNM(J) ;GET START ARGUMENT
TELL OPR,%%DDE ;SAY DEVICE DOESN'T EXIST
POPJ P, ;LET HIM TRY AGAIN.
> ;END OF IFN D60SPL
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
IFN D60SPL,<
ON S,STARTD ;FLAG THAT WE ARE STARTED
SKIPE J$LD60(J) ;ARE WE ON A DN60?
PJRST WHAT ;YES, DONT SAY HELLO OR
; GIVE A "GO", JUST GIVE "WHAT".
>
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,< IFE D60SPL,<
;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
IFN D60SPL,<
SKIPA ;ERROR
>
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 D60SPL
> ;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
IFN D60SPL,<
SKIPE J$LSDV(J) ;ARE WE A KNOWN COMPONENT?
>
PUSHJ P,SNDQSR## ;SEND IT
IFN D60SPL,<
PUSHJ P,D60RLS ;RELEASE THE COMM. FRONT END
>
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:
IFE D60SPL,<
TXNE S,DSKOPN ;ARE WE PRINTING A FILE?
PUSHJ P,OUTFLS ;YES, FLUSH ALL OUTPUT
PUSHJ P,(P1) ;CALL TYPE DEPENDENT ROUTINE
>
IFN D60SPL,<
TXNN S,DSKOPN ;ARE WE PRINTING A FILE?
JRST KILL4 ;NO.
PUSHJ P,OUTFLS ;YES, FLUSH ALL OUTPUT
JRST KILL3 ;ERROR, LOST THE PRINTER.
KILL4: 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:
IFE D60SPL,<
OFF S,RUNB ;TURN OFF THE RUN BIT
>
IFN D60SPL,<
OFF S,RUNB!PAUSEB ;TURN OFF RUN AND PAUSE BITS
>
PJRST SNDSTC ;STOP SCHEDULING AND RETURN
GO:
IFN D60SPL,<
SKIPN J$LD60(J) ;STARTED TO A DN60?
JRST GO1 ;NO, DO NORMAL "GO" COMMAND
MOVE T1,D60FGS ;YES, GET FLAGS
TRNE T1,D60SSU ;RECEIVED "SET STATION" COMMAND?
JRST GO1 ;YES, DO "GO" COMMAND.
PUSHJ P,D60TSM ;NO, IN SIMULATE MODE?
JRST GO2 ;YES, DIFFERENT MESSAGE
TELL OPR,[ASCIZ /!?LPT... Must set station before !"GO!" command
/]
POPJ P,
;
; HERE ON INVALID "GO" IN SIMULATE MODE
;
GO2: TELL OPR,[ASCIZ /!?LPT... Must sign on before !"GO!" command
/]
POPJ P,
GO1:
> ;END OF IFN D60SPL
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:
IFN D60SPL,<
MOVE T1,D60FGS ;GET FLAGS
SKIPE J$LD60(J) ;ARE WE ON A DN60?
TRNE T1,D60SSU ;YES, SIGNED ON?
JRST DOPAU1 ;ALL IS OK, MUST BE "PAUSE"
TELL OPR,[ASCIZ /![LPT... Spooler is PAUSE'ing on $ because
/]
MOVEI T1,[ASCIZ /station number not yet set!]
/]
PUSHJ P,D60TSM ;DIFFERENT MSG IF WE ARE SIMULATING
MOVEI T1,[ASCIZ /not yet signed on to host!]
/]
TELL OPR,(T1)
JRST STOP ;STOP THE WORLD
;
; HERE IF STATION IS SIGNED ON.
;
DOPAU1:
>
TELL OPR,[ASCIZ /Spooler is PAUSE'ing ON $, type GO to continue
/]
JRST STOP ;AND GO STOP
;
; SUBROUTINE TO DO THINGS THAT NEED TO BE DONE WHEN
; EVERYTHING IS IDLE.
;
IFN D60SPL,<
;
QIDLE: SKIPN J$LD60(J) ;ARE WE ON A DN60?
POPJ P, ;NO.
MOVE T1,D60FGS ;YES, GET FLAGS
TRNE T1,D60SSU ;ARE WE SIGNED ON?
POPJ P, ;YES.
SKIPN J$LSDV(J) ;NO, HAVE WE A SCHEDULING DEVICE?
POPJ P, ;NO.
PUSHJ P,DOREST ;YES, SAY "GOODBY" TO QUASAR
SETZM J$LSDV(J) ;WE ARE NOW UNKNOWN.
POPJ P, ;ALL DONE.
;
>
;
SUBTTL Operator Commands -- REPRINT
;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
IFN D60SPL,<
POPJ P, ;ERROR
>
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
SUBTTL Operator Commands -- SKPCOPY
;SKPCOP -- ROUTINE TO START THE NEXT COPY OF THE CURRENT FILE
;CALL WITH:
; PUSHJ P,SKPCOP
; RETURN HERE
;
SKPCOP: PUSHJ P,OUTFLS ;FLUSH OUTPUT
IFN D60SPL,<
POPJ P, ;ERROR
>
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
SUBTTL Operator Commands -- SKPFILE
;SKPFIL -- ROUTINE TO START THE NEXT FILE
;CALL WITH:
; PUSHJ P,SKPFIL
; RETURN HERE
;
SKPFIL: PUSHJ P,OUTFLS ;FLUSH OUTPUT
IFN D60SPL,<
POPJ P, ;ERROR
>
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
IFN D60SPL,<
;
; SUBROUTINE TO REQUEUE THIS PRINT JOB
;
DOREQ: TXNE S,RQB ;HAVE WE DONE IT ALREADY?
POPJ P, ;YES, DONT DO IT AGAIN.
MOVEI T2,MSGBLK ;NO, 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
MOVE N,J$RNPP(J) ;GET NUMBER OF PAGES
MOVEM N,CHE.IN+CKPAG(T2) ;AND STORE IT
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
SETZM REQ.AF(T2) ;TRY AGAIN RIGHT AWAY
MOVX T1,CKFREQ ;GET REQUEUE BIT
TXNN S,BUSY ;IF NOT BUSY...
SETZ T1, ; NO REQUEUE BIT.
MOVEM T1,REQ.IN+CKFLG(T2) ;STORE IT
PUSHJ P,RIDLOG ;RELEASE THE LOG FILE
MOVX T1,<REQ.SZ,,.QOREQ> ;GET MESSAGE HEADER
MOVEM T1,MSGBLK ;STORE IT
MOVEI T1,MSGBLK ;ADDR OF REQUEUE BLOCK
PUSHJ P,SNDQSR## ;SEND IT TO QUASAR
ON S,RQB ;MARK WE HAVE REQUEUED
PUSHJ P,CLSFIL ;CLOSE INPUT FILE
TXNE S,BUSY ;NO MESSAGE UNLESS BUSY
TELL OPR,[ASCIZ /!%LPT... job requeued automatically
/]
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
; "WHAT" CONTINUED ON NEXT PAGE
;
; CONTINUATION OF THE "WHAT" COMMAND FROM PREVIOUS PAGE
;
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:
IFN D60SPL,<
TXNE S,BUSY ;ARE WE BUSY?
JRST WHATD ;YES.
PUSHJ P,D60WIL ;NO, PRINT "READING" IF APPROPRIATE
; (SKIP IF READING, NON-SKIP
; TO PRINT "IDLE")
>
IFE D60SPL,<
TXNN S,BUSY ;ARE WE BUSY?
>
TELL OPR,%%LII ;NO, TELL HIM
WHATD: MOVE T1,J$FORM(J) ;LOAD THE FORMS TYPE
TXNE S,MNTBIT ;ARE WE IN MOUNT WAIT?
TELL OPR,%%WFF ;YES, TELL HIM
IFE D60SPL,<
PJRST CURINF ;AND GIVE THE REST OF CURRENT INFO
>
IFN D60SPL,<
PUSHJ P,CURINF ;PRINT SOME CURRENT INFO
SKIPN J$LD60(J) ;ARE WE ON A DN60?
POPJ P, ;NO.
PJRST D60WHT ;YES, PRINT INFO FROM IT
>
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/]
IFN D60SPL,<
SKIPE T4,MSGLIN ;LINE?
TELL OPR,[ASCIZ / LINE ACTIVITY/]
ADD T1,T4 ;COMBINE FLAGS
>
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
IFN D60SPL,<
STAMP LPOPR ;STAMP THE MESSAGE
>
BACK.1: CAMLE N,J$RNPP(J) ;BACKING UP PAST BEGINNING?
MOVE N,J$RNPP(J) ;YES, MAKE IT A REWIND
IFE D60SPL,<
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:
IFN D60SPL,<
STAMP LPMSG ;DIFFERENT STAMP FOR INTERNAL BACKSPACE
>
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
IFN D60SPL,<
SETZM MSGLIN
>
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
IFN D60SPL,<
XWD 'L',MSGLIN ;NOTE THAT "ALL" DOES NOT COVER THIS
>
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
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
; SUBROUTINE TO SAY "GOODBY" TO QUASAR (ONLY A SUBROUTINE IN D60SPL)
DOREST:
IFN D60SPL,<
PUSHJ P,CHKSEG ;RELEASE HIGH SEG ON RETURN
>
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
IFN D60SPL,<
POPJ P, ;RETURN, RELEASING HIGH SEG
>
IFE D60SPL,<
TELL OPR,%%LIR ;LPTSPL IS RESET
JRST LPTSPL
>
SUBTTL LOWSEG Operator Commands -- CHECKPOINT
;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
IFN D60SPL,<
SKIPE MSGFIL ;WANT FILE MESSAGES?
TELL OPR,%%CPT ;YES, TELL OPR, TOO.
>
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
IFN D60SPL,<
SKIPE MSGFIL ;OPR WANT FILE MESSAGES?
TELL OPR,%%CPT1 ;YES, SEND OPR END OF MSG
>
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
IFN D60SPL,<
;SUBROUTINE TO INPUT AN OCTAL NUMBER
;CALL WITH:
; PUSHJ P,OCTARG
; INVALID DATA OR TERMINATOR
; RETURN HERE WITH NUMBER IN N
;MUST RESPECT T2
OCTARG: SETZ N, ;CLEAR RESULT
PUSHJ P,SPACES ;FLUSH SPACES
SKIPA ;AND SKIP INTO LOOP
OCTAR1: PUSHJ P,GETCHR ;GET A CHAR
CAIG C,"7" ;IS THIS CHAR AN OCTAL DIGIT?
CAIGE C,"0" ; ..
JRST OCTAR2 ;NO. MUST BE END OF NUMBER
ASH N,3 ;ADJUST N FOR THIS OCTAL DIGIT
ADDI N,-"0"(C) ;ADD IN THIS DIGIT
JRST OCTAR1 ;GET NEXT DIGIT
OCTAR2: CAIE C," " ;BLANKS TABS
CAIN C,12 ; AND LINE FEEDS ARE VALID AFTER NUMBER
AOS (P) ;GOOD DELIMITER IN C
POPJ P, ;INVALID DELIMITER
> ;END OF IFN D60SPL
;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
SETNL: OFF S,TTYBRK ;CLEAR THE BREAK FLAG
IFN FTUUOS,<
POPJ P, ;AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
IFN D60SPL,<
SKIPE J$LD60(J) ;ARE WE ON A DN60?
SKIPN D60OIC ;YES, ANY COMMAND CHARS FROM IT?
SKIPA ;NO.
POPJ P, ;YES, WE HAVE DONE ENOUGH.
> ;END OF IFN D60SPL
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:
IFN D60SPL,<
SKIPE J$LD60(J) ;ON A DN60?
SKIPN D60OIC ;YES, ANY CHARS FROM IT?
JRST TTYI.2 ;NO.
SOS D60OIC ;YES, DECREMENT COUNT
ILDB C,D60OIP ;GET CHARACTER
JRST TTYI.3 ;GO PROCESS IT
TTYI.2:
>
GTCHR. ;GET A CHARACTER
CAIE C,.CHCNZ ;IS IT A CONTROL-Z OR A
CAIN C,.CHCNC ; CONTROL-C?
JRST DOEXIT ;YES, GO EXIT
TTYI.3: 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:
IFE D60SPL,<
MOVE T1,J$LDEV(J) ;GET THE DEVICE
PJRST SIXOUT ;AND PRINT IT
>
IFN D60SPL,<
SKIPN T1,J$LDEV(J) ;GET THE DEVICE
MOVE T1,J$LGNM(J) ; OR 'START' ARG IF NONE
PUSH P,T1 ;SAVE IT
PUSHJ P,SIXOUT ;PRINT IT
POP P,T1 ;RESTORE IT
SKIPE J$LSDV(J) ;SCHEDULING DEVICE SPECIFIED?
CAMN T1,J$LSDV(J) ;YES, SCHEDULING TO DIFFERENT DEVICE?
POPJ P, ;NO.
MOVEI C,"=" ;YES, INDICATE THIS
PUSHJ P,SEND
MOVE T1,J$LSDV(J) ;GET DEVICE SCHEDULED FROM
PUSHJ P,SIXOUT ;PRINT IT
POPJ P, ;ALL DONE.
;
>
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
IFE D60SPL,<
PJRST DEVOUT ;PRINT THE CHAR AND RETURN
>
IFN D60SPL,<
PUSHJ P,DEVOUT ;PRINT THE CHAR
JFCL ;IGNORE ERRORS
POPJ P, ;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
IFE D60SPL,<
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 D60SPL,<
PUSHJ P,CLNLOG ;BE SURE LOG IS EMPTY
PUSHJ P,BUFLOG ;SET UP A PAGE FOR I/O BUFFER
>
;
; CONTINUE AT FNDL.2
;
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:
IFE D60SPL,<
JUMPE P1,.POPJ## ;DONE IF NO MORE PAGES
>
IFN D60SPL,<
JUMPE P1,CLNL.2 ;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
IFN D60SPL,<
; HERE WHEN ALL PAGES HAVE BEEN RETURNED
CLNL.2: SETZM J$GINP(J) ;CLEAR PAGE COUNT
SETZM J$GIBC(J) ;CLEAR COUNT OF BYTES LEFT IN CURRENT PAGE
SETZM J$GIBP(J) ;CLEAR BYTE POINTER
;
; NOTE: CLEARING J$GIBP MAKES THE IDPB WHICH TERMINATES THE
; PAGE WITH A NULL AN EFFECTIVE NOOP UNTIL THE FIRST PAGE IS
; ALLOCATED.
;
POPJ P, ;RETURN.
>
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
; (NOTE THAT IN D60SPL, IF WE DO NOT HAVE THE LINE ACTIVE
; WE WAIT FOR 3*S1 SECONDS.)
SUSPND:
IFN D60SPL,<
SKIPN J$LD60(J) ;ARE WE ON A DN60?
JRST SUSP.1 ;NO, NORMAL HIBER.
PUSHJ P,D60SLP ;YES, DIFFERENT SLEEP ROUTINE
POPJ P, ;TIME TO RETURN
;
; HERE WHEN WE ARE NOT ON A DN60 OR WHEN D60SLP DOES A SKIP
; RETURN, INDICATING THAT THE NORMAL 'HIBER' IS APPROPRIATE.
;
SUSP.1:
>
IMULI S1,^D1000 ;CONVERT TO MILLISECS
IFN FTUUOS,<
HIBER S1, ;AND SLEEP
HALT
POPJ P, ;AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
SETOM BLOKED ;WE ARE SLEEPING
SKIPN AWOKEN ;INTERRUPTED SINCE LAST INSTRUCTION?
DISMS ;SLEEP
JFCL ;**DO NOT REMOVE THIS INSTRUCTION**
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.
; D60SPL WILL ALSO TURN OFF THE SCHEDULING BIT IF A DELAY
; HAS BEEN REQUESTED BECAUSE OF INABILITY TO
; START PRINTER OUTPUT OR A WISH TO WAIT FOR A RESPONSE
; TO A JOB.
SNDSTC: TXNN S,STARTD ;ARE WE STARTED?
POPJ P, ;NO, WE ARE NOT KNOWN COMPONENT
IFN D60SPL,<
SKIPN J$LSDV(J) ;HAVE WE A SCHEDULING DEVICE?
POPJ P, ;NOT SIGNED ON, UNKNOWN.
>
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
IFN D60SPL,<
SKIPE D60DLY ;DELAY REQUESTED?
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
IFN D60SPL,<
PUSHJ P,D60TSM ;ARE WE IN SIMULATE MODE?
MOVX T1,'D60SPL' ;YES, USE DIFFERENT 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
IFN D60SPL,<
PUSHJ P,D60TSM ;ARE WE SIMULATING?
SKIPA ;YES.
>
TXO T1,HELRDE ;NO, 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
IFN D60SPL,<
PUSH P,T1 ;SAVE T1
MOVEI T1,D60ESF ;CLEAR "ERROR SINCE FILL"
ANDCAM T1,D60FGS
POP P,T1 ;RESTORE T1
TXNN S,FILOPN ;IS THE DISK FILE OPEN?
POPJ P, ;NO, GIVE EOF RETURN.
>
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
;
; HERE IF WE MUST ADJUST THE INPUT BUFFER IN ORDER
; TO COMPLETE ERROR RECOVERY.
;
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
;
; HERE IF THE "IN" UUO SKIPS, INDICATING AN ERROR.
;
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
IFN D60SPL,<
PUSH P,T1 ;SAVE T1
MOVEI T1,D60ESF ;CLEAR "ERROR SINCE FILL"
ANDCAM T1,D60FGS
POP P,T1 ;RESTORE T1
TXNN S,FILOPN ;IS THE DISK FILE OPEN?
POPJ P, ;NO, GIVE EOF RETURN.
>
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 IN FILE
AOS J$ADRD(J) ;AND TOTAL PAGES READ
PJRST .POPJ1## ;AND SKIP BACK
;
; HERE ON AN RMS FILE
;
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
IFN D60SPL,<
SKIPE J$LD60(J) ;ARE WE ON A DN60?
JRST MOUNT5 ;YES, DON'T BOTHER LOCAL OPR
>
MOVE T1,J$FORM(J) ;LOAD FORMS NAME AGAIN
TELL OPR,MOUNTM ;ASK OPR TO MOUNT 'EM
MOUNT5: 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
;
; HERE TO WAIT FOR THE OPERATOR TO MOUNT THE FORMS.
;
MOUNT1: SKIPE J$LHNG(J) ;IS THE DEVICE OFF-LINE?
JRST MOUNT2 ;YES, FORGET THE FORMFEED
PUSHJ P,SENDFF ;SEND A FORMFEED
IFN D60SPL,<
JRST MOUNT4 ;OUTPUT ERROR
MOVE T1,J$FORM(J) ;GET FORM NAME
TELL USR,MOUNTM ;PRINT MOUNT REQ ON PRINTER
PUSHJ P,SENDFF ;HELP REMOTE OPR TO SEE IT
JRST MOUNT4 ;ERROR
>
PUSHJ P,OUTDMP ;AND DUMP IT OUT
IFN D60SPL,<
JRST MOUNT4 ;OUTPUT ERROR
PUSHJ P,OUTCLS ;CLOSE OUTPUT DEVICE
JRST MOUNT4 ;ERROR
>
MOUNT2: OFF S,RUNB ;TURN OFF RUN FLAG
IFN D60SPL,<
SKIPN J$LD60(J) ;ON A DN60?
>
TELL OPR,STAR ;NO, TYPE A STAR
MOVEI T1,<AUTTIM>-1 ;LOAD NUMBER OF SLEEPS
MOUNT3: JUMPE T1,MOUNT4 ;TIMEOUT IF ZERO
IFN D60SPL,<
PUSH P,T1 ;SAVE COUNTER
MOVEI S1,^D60 ;NO MORE THAN ONE MINUTE
PUSHJ P,SUSPND ;WAIT FOR OPR TYPEIN OR ONE MIN
PUSHJ P,CHKOP0 ;PROCESS ANY OPR TYPEIN
POP P,T1 ;RESTORE COUNT
SKIPE J$LD60(J) ;ON A DN60?
SETZ T1, ;YES, WAIT FOREVER.
TXNN S,RUNB!RQB!ABORT ;HAS OPR TYPED "GO", "KILL", OR "REQUEUE"?
SOJA T1,MOUNT2 ;NO, KEEP WAITING.
PUSHJ P,OUTGET ;YES, GET OUTPUT DEVICE
JRST MOUNT4 ;ERROR
POPJ P, ;DONE PROCESSING
>
IFE D60SPL,<
MOVEI S1,^D60 ;1 MINUTE
PUSHJ P,SUSPND ;DO IT
SKIPN TTYFLG ;DID OPR TYPE SOMETHING?
SOJA T1,MOUNT3 ;DECREMENT COUNT AND LOOP
>
; CONTINUED ON NEXT PAGE
;
; CONTINUATION OF "MOUNT" COMMAND.
;
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!!
IFN D60SPL,<
CAMN T1,J$LSDV(J) ;NO, TRY SCHEDULED PRINTER
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
IFE D60SPL,<
MOVEI T2,3 ;ASSUME WIDTH CLASS 3
>
IFN D60SPL,<
MOVEI T2,4 ;ASSUME WIDTH CLASS 4
>
MOVEM T2,J$FWCL(J) ;SAVE WIDTH CLASS
IFN D60SPL,<
CAIG T1,F$CL3 ;LE CLASS 3 LIMIT?
SOS J$FWCL(J) ;YES, DECREMENT TO 3
>
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
IFN D60SPL,<
S$PASS: PUSHJ P,FH$SIX ;GET PASSWORD
POPJ P, ;EOF!
MOVEM T1,J$FPAS(J) ;STORE FOR SIGNON PROCESSOR
POPJ P, ;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
IFN D60SPL,<
TXNN S,IHGTLP ;DO WE OWN THE PRINTER?
POPJ P, ;NO, DON'T LOAD ANYTHING.
>
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,<
IFN D60SPL,<
SKIPE J$LD60(J) ;ARE WE ON A DN60?
JRST NODAVF ;YES, DAVFU NOT IMPLEMENTED YET
>
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
IFN D60SPL,<
JFCL ;IGNORE ERRORS
>
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
;
; THIS LOOP COPIES VFU DATA INTO THE LINE PRINTER.
;
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
IFN D60SPL,<
JRST LODV.3 ;QUIT ON ERROR
>
JRST LODV.1 ;AND LOOP
LODV.2: IN VFC, ;GET A BUFFER
JRST LODV.1 ;SUCCESS, BACK TO LOOP
LODV.3: PUSHJ P,OUTDMP ;FORCE OUT THE BUFFERS
IFN D60SPL,<
JFCL ;IGNORE ERRORS
>
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
IFN D60SPL,<
JFCL ;IGNORE ERRORS
>
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
TRNN C,1 ;IS THERE AN LSN?
JRST FH$CR1 ;NO, CONTINUE ON
AOS FMBPT ;YES, BUMP
ILDB C,FMBPT ;AND EAT THE TAB
FH$CR1: 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:
IFE D60SPL,<
MOVEI T1,3 ;START AT THREE
>
IFN D60SPL,<
MOVEI T1,4 ;START AT FOUR
>
MOVEM T1,J$FWCL(J) ;STORE IT
MOVE T1,J$FWID(J) ;GET THE WIDTH
IFN D60SPL,<
CAIG T1,F$CL3 ;LE CLASS THREE LIMIT?
SOS J$FWCL(J) ;YES, SET TO 3
>
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
; OUTCLS -- CLOSE OUTPUT DEVICE (D60SPL ONLY)
TOPSEG
SUBTTL OUTGET -- OPEN the output device
;THIS ROUTINE OPENS THE SPECIFIED OUTPUT DEVICE, AND SETS UP A BUFFER RING
; SKIP RETURN ON SUCCESS (D60SPL ONLY)
IFN FTUUOS,<
OUTGET:
IFN D60SPL,<
SKIPE J$LD60(J) ;ON A DN60?
PJRST D60SOS ;YES, SPECIAL OPEN CODE
>
IFE D60SPL,<
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
IFE D60SPL,<
PJRST INTCNL ;CONNECT LPT TO PSISER
>
IFN D60SPL,<
PUSHJ P,INTCNL ;CONNECT LPT TO PSISER
ON S,IHGTLP ;FLAG WE HAVE THE PRINTER
AOS (P) ;SKIP RETURN
POPJ P, ;RETURN.
>
> ;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
IFE D60SPL,<
PJRST INTCNL ;CONNECT LPT TO PSI AND RETURN
>
IFN D60SPL,<
PUSHJ P,INTCNL ;CONNECT LPT TO PSI
ON S,IHGTLP ;FLAG WE HAVE THE PRINTER
AOS (P) ;SKIP RETURN
POPJ P, ;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
IFE D60SPL,<
PJRST INTCNL ;AND CONNECT TO INTERRUPTS
>
IFN D60SPL,<
PUSHJ P,INTCNL ;AND CONNECT TO INTERRUPTS
ON S,IHGTLP ;FLAG WE HAVE THE PRINTER
AOS (P) ;SKIP RETURN
POPJ P, ;RETURN.
>
> ;END IFE FTDPM
OUTG.3: TELL OPR,%%DNA ;GIVE A MESSAGE
IFE D60SPL,<
JRST LPTSPL ;AND RESET THE WORLD
>
IFN D60SPL,<
POPJ P, ;GIVE ERROR RETURN
>
OUTG.4: MOVE T1,J$LGNM(J) ;GET THE GIVEN NAME
TELL OPR,%%DDE ;DEVICE DOESN'T EXIST
IFE D60SPL,<
JRST LPTSPL ;AND RESET THE WORLD
>
IFN D60SPL,<
POPJ P, ;ERROR RETURN.
>
OUTG.5: TELL OPR,%%DIS ;DEVICE IS SPOOLED
IFE D60SPL,<
JRST LPTSPL ;AND RESET THE WORLD
>
IFN D60SPL,<
POPJ P, ;ERROR RETURN
>
> ;END IFN FTUUOS
IFN FTJSYS,<
OUTGET:
IFN D60SPL,<
SKIPE J$LD60(J) ;ARE WE ON A DN60?
JRST D60SOS ;YES, SPECIAL START PROCEDURE.
> ;END OF IFN D60SPL
IFE D60SPL,<
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
> ;END OF IFE D60SPL
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
;
; ;OUTGET IS CONTINUED ON THE NEXT PAGE
;
;
; HERE WHEN THE GTJFN AND OPENF ARE COMPLETE
;
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:
IFE D60SPL,<
PJRST INTON ;CONO PION AND RETURN
>
IFN D60SPL,<
PUSHJ P,INTON ;TURN ON INTERRUPTS
ON S,IHGTLP ;NOTE WE NOW HAVE THE PRINTER
AOS (P) ;SKIP RETURN FOR SUCCESS
POPJ P, ;RETURN.
>
OUTG.4: TELL OPR,%%DNA ;DEVICE NOT AVAILABLE
IFE D60SPL,<
JRST LPTSPL ;AND RESET EVERYTHING
>
POPJ P, ;AND GIVE FAILURE RETURN
> ;END IFN FTJSYS
SUBTTL OUTOUT -- Routine to output a buffer
; THE D60SPL VERSION WILL NON-SKIP ON FATAL ERROR (FILE REQUED)
; AND SKIP RETURN ON SUCCESS (FILE BACKSPACED IF NECESSARY)
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
IFN D60SPL,<
TXNN S,IHGTLP ;DO WE HAVE THE PRINTER?
POPJ P, ;NO, GIVE ERROR RETURN.
TXNE S,RUNB ;DID OPR CLEAR RUN?
JRST OUTO.1 ;NO.
MOVEI S1,^D60 ;WAIT A MINUTE OR FOR OPR INPUT
PUSHJ P,SUSPND
JRST OUTOUT ;LOOK FOR "GO" COMMAND
;
; OPR HAS NOT TYPED "STOP"
;
OUTO.1: SKIPN J$LD60(J) ;ON A DN60?
JRST OUTO.3 ;NO.
PUSHJ P,D60OUT ;YES, SEND BUFFER TO DN60
JRST OUTERR ;ERROR, BACKSPACE.
JRST OUTO.2 ;ALL OK.
OUTO.3:
>
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
IFN D60SPL,<
AOS (P) ;SKIP RETURN FOR SUCCESS
>
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
IFN D60SPL,<
TXNN S,IHGTLP ;DO WE HAVE THE PRINTER?
JRST OUTO.5 ;NO, GIVE ERROR RETURN.
TXNE S,RUNB ;DID OPR CLEAR RUN?
JRST OUTO.4 ;NO.
MOVEI S1,^D60 ;WAIT A MINUTE OR FOR OPR INPUT
PUSHJ P,SUSPND
JRST OUTOUT ;LOOK FOR "GO" COMMAND
;
; OPR HAS NOT TYPED "STOP"
;
OUTO.4: SKIPN J$LD60(J) ;ON A DN60?
JRST OUTO.3 ;NO.
PUSHJ P,D60OUT ;YES, SEND BUFFER TO DN60
JRST OUTERR ;ERROR, BACKSPACE.
JRST OUTO.2 ;ALL OK.
OUTO.3:
>
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
OUTO.2: POP P,T1 ;RESTORE T1
IFN D60SPL,<
AOS (P) ;SKIP RETURN FOR SUCCESS
>
POPJ P, ;AND FINALLY RETURN
;
; HERE IF PRINTER NOT AVAILABLE
IFN D60SPL,<
OUTO.5: POP P,T1 ;RESTORE T1
POPJ P, ;RETURN.
;
> ;END OF IFN D60SPL
;
;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:
IFN D60SPL,<
SKIPN J$LD60(J) ;ARE WE ON A DN60?
>
STATZ LPT,IO.ERR ;NO, A REAL ERROR?
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
IFN D60SPL,<
MOVEI T1,D60ESF ;SET "ERROR SINCE FILL"
IORM T1,D60FGS
SKIPE J$LD60(J) ;ARE WE ON A DN60?
JRST OUTE.6 ;YES.
>
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
;
; HERE ON A VFU ERROR.
;
OUTE.3: TELL OPR,%%VFE ;TELL OPR WE GOT A VFU ERROR
OUTE.4: PUSHJ P,OUTDIE ;SEE IF TOO MANY ERRORS
IFN D60SPL,<
SKIPE J$LD60(J) ;ARE WE ON A DN60?
JRST OUTE.5 ;YES.
>
GETSTS LPT,N ;GET I/O STATUS
TRZ N,IO.ERR ;CLEAR ERROR FLAGS
SETSTS LPT,(N) ;GET RESET THE STATUS
OUTE.5: 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
IFE D60SPL,<
PJRST LODVFU ;LOAD THE VFU AND RETURN
>
IFN D60SPL,<
PUSHJ P,LODVFU ;LOAD THE VFU
AOS (P) ;INDICATE SUCCESS
POPJ P, ; AND RETURN.
> ;END OF IFN D60SPL
> ;END OF IFN FTUUOS
; CONTINUATION OF OUTERR -- D60SPL CASE
; (THIS CODE IS ASSEMBLED FOR BOTH TOPS-10 AND TOPS-20)
IFN D60SPL,<
; HERE ON OUTPUT ERROR FOR A DN60
OUTE.6: PUSHJ P,SAVALL ;SAVE ALL AC'S
PUSHJ P,CHKSEG ;GET HIGH SEG IF NEEDED
PUSHJ P,GETSPL ; ...
PUSHJ P,D60ABO ;ABORT THE BSC STREAM
TXNN S,DSKOPN ;HAVE WE A FILE OPEN?
JRST OUTE.7 ;NO, DON'T TRY TO CONTINUE
MOVEI N,5 ;YES, BACKSPACE FIVE PAGES
PUSHJ P,D60TSM ; UNLESS WE ARE SIMULATING
MOVE N,J$RNPP(J) ;IN WHICH CASE REWIND
CAML N,J$RNPP(J) ;IS FIVE PAGES TOO MANY?
MOVE N,J$RNPP(J) ;YES, GET MAX NUMBER OF PAGES
TELL OPR,[ASCIZ /![LPT... Backspacing # pages!]
/]
PUSHJ P,IBACK ;BACKSPACE THE FILE
PUSHJ P,D60NRY ;PERFORM "NOT READY" DIALOG
JRST OUTE.7 ;ERROR IS UNRECOVERABLE
TELL OPR,[ASCIZ /![LPT... continueing!]
/]
MOVEI T1,D60OER ;CLEAR ERROR BIT
ANDCAM T1,D60FGS
AOS (P) ;SKIP RETURN.
POPJ P, ;RETURN.
; HERE IF THE ERROR IS FATAL -- THE STATION HAS SIGNED OFF
; OR WE ARE PRINTING HEADERS. REQUEUE.
OUTE.7: TXNE S,BUSY ;ARE WE DOING ANYTHING?
PUSHJ P,DOREQ ;YES, REQUEUE IT
POPJ P, ;RETURN.
> ;END OF IFN D60SPL
IFN FTJSYS,<
OUTERR: SETZM J$LIOA(J) ;NO LONGER IOACTIVE
POP P,T1 ;GET STACK BACK IN SYNC
PUSHJ P,.SAVET## ;SAVE SOME ACS
PUSHJ P,INTOFF ;CONO PIOFF
IFN D60SPL,<
SKIPE J$LD60(J) ;ON A DN60?
JRST OUTE.2 ;YES, ASSUME ERROR IS RECOVERABLE
>
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
;
; HERE IF THE ERROR SEEMS RECOVERABLE
;
OUTE.2: SETZM J$LHNG(J) ;CLEAR "HUNG" FLAG
IFN D60SPL,<
MOVEI T1,D60ESF ;SET "ERROR SINCE FILL"
IORM T1,D60FGS
SKIPE J$LD60(J) ;ARE WE ON A DN60?
JRST OUTE.6 ;YES.
>
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
IFN D60SPL,<
POPJ P, ;YES, ERROR RETURN.
>
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
IFE D60SPL,<
PJRST OUTWON ;AND WAIT FOR IT
>
IFN D60SPL,<
PUSHJ P,OUTWON ;WAIT FOR IT
AOS (P) ;SKIP RETURN FOR SUCCESS
POPJ P, ; (I.E., RECOVERED)
>
> ;END IFN FTJSYS
;
;HERE TO CHECK FOR TOO MANY LPT ERRORS
;
OUTDIE: SOSL J$LERR(J) ;COUNT DOWN ERRORS
IFE D60SPL,<
POPJ P, ;STILL ALIVE
>
IFN D60SPL,<
JRST .POPJ1## ;STILL ALIVE
>
TELL OPR,%%TML ;TOO MANY
IFE D60SPL,<
JRST DOREST ;AND DIE
>
IFN D60SPL,<
TXNE S,BUSY ;ARE WE DOING ANYTHING?
PUSHJ P,DOREQ ;YES, REQUEUE THE FILE
POPJ P, ;ERROR RETURN.
>
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
IFE D60SPL,<
IFN FTUUOS,<
OUTEOJ:
IFN D60SPL,<
PUSHJ P,D60TSM ;SIMULATE MODE?
POPJ P, ;YES, DONT DUMP BUFFERS
>
PUSHJ P,OUTDMP ;DUMP ALL BUFFERS
IFN D60SPL,<
POPJ P, ;ERROR RETURN.
SKIPN J$LD60(J) ;ON A DN60?
>
MTEOF. LPT, ;NO, WRITE A TAPE MARK
IFN D60SPL,<
AOS (P) ;SUCCESS RETURN
>
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
> ;END OF IFE D60SPL
SUBTTL OUTDMP -- Dump out buffers and wait
OUTDMP: PUSHJ P,OUTOUT ;FORCE THE LAST BUFFER
IFN D60SPL,<
POPJ P, ;ERROR
SKIPN J$LD60(J) ;ON A DN60?
JRST OUTD.1 ;NO.
PUSHJ P,D60DMP ;YES, DUMP OUTPUT
JRST OUTERR ;ERROR
AOS (P) ;SUCCESS, SKIP RETURN
POPJ P, ;RETURN.
;
; HERE IF THIS IS NOT A DN60 PRINTER
;
> ;END OF IFN D60SPL
OUTD.1:
IFN FTUUOS,<
MOVEI S1,LPT ;GET THE CHANNEL
WAIT S1, ;WAIT FOR BUFFERS TO EMPTY
> ;END IFN FTUUOS
IFN FTJSYS,<
MOVE S1,J$LJFN(J) ;GET THE LPT JFN
MOVX S2,.MONOP ;AND NO-OP FUNCTION
MTOPR ;DO IT
ERCAL OUTERR ;I/O ERROR?
> ;END OF IFN FTJSYS
IFN D60SPL,<
AOS (P) ;SKIP RETURN FOR SUCCESS
>
POPJ P, ;AND RETURN
;
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 D60SPL,< TOPSEG ;THIS IS ONLY CALLED FROM HIGH SEG
>
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
IFN D60SPL,<
TXNN S,IHGTLP ;DO WE HAVE THE PRINTER?
JRST OUTF.5 ;NO, IT IS ALREADY FLUSHED.
SKIPN J$LD60(J) ;ON A DN60?
JRST OUTF.1 ;NO.
PUSHJ P,D60ABO ;ABORT THE BSC STREAM
JRST OUTF.2 ;ALL DONE.
> ;END OF IFN D60SPL
IFN FTUUOS,<
OUTF.1: MOVEI S1,LPT ;LOAD THE CHANNEL NUMBER
RESDV. S1, ;RESET THE CHANNEL
JFCL ;??
> ;END OF IFN FTUUOS
;
; THE TOPS-20 CASE OF OUTFLS
;
IFN FTJSYS,<
OUTF.1: 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
IFN D60SPL,<
OUTF.5: AOS (P) ;SKIP RETURN
>
POPJ P, ;RETURN
> ;END IFN FTJSYS
;
;
; HERE TO GET CONTROL OF THE PRINTER BACK
; (NOT NEEDED IN TOPS-20 UNLESS WE ARE RUNNING A DN60 PRINTER)
;
IFE D60SPL,<
PJRST OUTGET ;AND REINIT THE LPT
> ;END OF IFE D60SPL
IFN D60SPL,<
OUTF.2: PUSHJ P,OUTGET ;REINIT THE LPT
JRST OUTF.3 ;UNABLE TO
AOS (P) ;SKIP RETURN
POPJ P, ;SUCCESS
; HERE IF THE RE-INIT FAILED.
OUTF.3: SKIPN J$LD60(J) ;ARE WE ON A DN60?
JRST OUTF.4 ;NO, SKIP DIALOG
PUSHJ P,D60NRY ;YES, ASK FOR PRINTER BACK
JRST OUTF.4 ;CAN'T HAVE IT
AOS (P) ;GOT IT, SKIP RETURN.
POPJ P, ;SUCCESS
;
; HERE IF WE CANNOT GET THE PRINTER BACK
;
OUTF.4: TXNE S,BUSY ;ARE WE DOING ANYTHING?
PUSHJ P,DOREQ ;YES, REQUEUE THE JOB
POPJ P, ;FAILURE RETURN
> ;END OF IFN D60SPL
SUBTTL OUTCLS -- CLOSE THE OUTPUT DEVICE
IFN D60SPL,<
TOPSEG
OUTCLS: TXNE S,IHGTLP ;DO WE HAVE THE PRINTER?
PUSHJ P,OUTOUT ;YES, EMPTY OUTPUT BUFFERS
JRST OUTC.3 ;NO OR FATAL ERROR, REQUEUE DONE.
MOVE T1,D60FGS ;GET FLAGS
TRNE T1,D60ESF ;ERROR SINCE FILL?
JRST OUTC.2 ;YES, SINCE FILL DIDN'T CORRECT
; IT, IT IS FATAL.
SKIPN J$LD60(J) ;NO, ARE WE ON A DN60?
JRST OUTC.1 ;NO.
PUSHJ P,D60EOF ;YES, DO EOF PROCESSING
JRST OUTC.2 ;ERROR, REQUEUE
AOS (P) ;NO, SKIP RETURN
POPJ P, ;RETURN.
; HERE IF WE ARE ON A REGULAR PRINTER
OUTC.1:
IFN FTUUOS,<
CLOSE LPT, ;CLOSE THE PRINTER
STATZ LPT,IO.ERR ;ANY ERRORS?
JRST OUTC.2 ;YES, REQUEUE
RELEAS LPT, ;RELEASE THE PRINTER
>
IFN FTJSYS,<
HRRZ S1,J$LJFN(J) ;GET PRINTER'S JFN
CLOSF ;CLOSE AND RELEASE PRINTER
ERJMP OUTC.2 ;REQUEUE IF ERROR
>
OFF S,IHGTLP ;FLAG IT RELEASED
AOS (P) ;SKIP RETURN
POPJ P, ;RETURN.
;
; HERE ON ERROR DURING EOF PROCESSING. IT IS DIFFICULT TO
; BACKSPACE SO WE ALWAYS REQUEUE.
OUTC.2: TXNE S,BUSY ;ARE WE DOING ANYTHING?
PUSHJ P,DOREQ ;YES, REQUEUE FROM LAST
; CHECKPOINT.
OUTC.3: SKIPN J$LD60(J) ;ARE WE ON A DN60?
JRST OUTC.4 ;NO.
PUSHJ P,D60ABO ;YES, ABORT IF NECESSARY
MOVEI T1,D60OER ;CLEAR ERROR BIT
ANDCAM T1,D60FGS ; SINCE THIS IS ALL FOR THIS JOB
POPJ P, ;RETURN.
; HERE TO ABORT A REAL PRINTER
OUTC.4:
IFN FTUUOS,<
RELEAS LPT, ;CLEAR OUT PRINTER
>
IFN FTJSYS,<
HRRZ S1,J$LJFN(J) ;GET JFN
RLJFN ;TRY TO RELEASE IT
JFCL ;IGNORE ANY ERRORS
>
OFF S,IHGTLP ;FLAG PRINTER GONE.
POPJ P, ;RETURN.
> ;END OF IFN D60SPL
SUBTTL LPT CONTROL ROUTINES
LOWSEG
;CONTROL CHARACTER TABLE
NCLRFF==(1B0) ;DON'T CLEAR FORMFEED FLAG
SUPRCH==(1B1) ;SUPPRESSABLE CHARACTER
CHTAB:
IFE D60SPL,<
XWD NCLRFF,.POPJ## ;(00) NULL
>
IFN D60SPL,<
XWD NCLRFF,.POPJ1## ;(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
IFN D60SPL,<
JRST FILDON ;OUTPUT ERROR, FILE REQUED
>
JRST LPTA.1 ;AND LOOP
LPTA.3: PUSHJ P,CHKSP ;GO HANDLE SPECIAL CHARS
IFN D60SPL,<
JRST FILDON ;ERROR, TERMINATE.
>
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
IFN D60SPL,<
JRST FILDON ;ERROR
>
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
IFN D60SPL,<
JRST FILDON ;ERROR
>
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
IFN D60SPL,<
JRST FILDON ;ERROR
>
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
IFN D60SPL,<
JRST FILDON ;ERROR
>
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
IFN D60SPL,<
JRST FILDON ;ERROR
>
PUSHJ P,DEVOUT ;TWO
IFN D60SPL,<
JRST FILDON ;ERROR
>
PUSHJ P,DEVOUT ;THREE
IFN D60SPL,<
JRST FILDON ;ERROR
>
; CONTINUATION OF LPTOCT
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
IFN D60SPL,<
JRST FILDON ;ERROR
>
SOJG T4,OCT5 ;END OF WORD?
SOJG T3,OCT4 ;END OF LINE?
HLRZ C,P2 ;GET MOTION CHARACTER
PUSHJ P,DEVOUT ; ..
IFN D60SPL,<
JRST FILDON ;ERROR
>
SOJG T2,OCT3 ;END OF BLOCK?
PUSHJ P,DEVOUT ;YES--2 EXTRA LINE FEEDS
IFN D60SPL,<
JRST FILDON ;ERROR
>
PUSHJ P,DEVOUT ; ..
IFN D60SPL,<
JRST FILDON ;ERROR
>
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 ; ..
IFN D60SPL,<
JRST FILDON ;ERROR
>
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
; CONTINUATION OF LPTCOB
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
IFN D60SPL,<
JRST FILDON ;ERROR
>
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
IFN D60SPL,<
JRST FILDON ;ERROR
>
MOVEI C,.CHLFD ;LOAD A LINE FEED
PUSHJ P,DOLF ;AND SEND EOL
IFN D60SPL,<
JRST FILDON ;ERROR
>
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)
;
; THE D60SPL VERSION DOES A SKIP RETURN IF OK, NON-SKIP IF ERROR.
;
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
IFN D60SPL,<
POPJ P, ;ERROR RETURN
>
SOJA N,DOLF1 ;AND SUBTRACT FROM QUOTA
;HERE TO PROCESS A FORM FEED
DOFORM: TXOE S,FFSEEN
IFN D60SPL,<
JRST .POPJ1## ;DO NOT PRINT BLANK PAGES
>
IFE D60SPL,<
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
IFN D60SPL,<
JRST .POPJ1## ;ONLY 1 LINE FEED IN A ROW
>
IFE D60SPL,<
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 ^
IFN D60SPL,<
JRST [POP P,C ;RESTORE C
POPJ P,] ;ERROR RETURN.
>
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
IFE D60SPL,<
TXON S,FFSEEN ;IS FFSEEN ON?
PUSHJ P,DEVOUT ;NO, SEND IT
POPJ P, ;RETURN
>
IFN D60SPL,<
TXOE S,FFSEEN ;IS FFSEEN ON?
PJRST .POPJ1## ;YES, DON'T SEND ANOTHER
PJRST DEVOUT ;NO, SEND A FORM FEED.
>
;SUBROUTINE TO OUTPUT ONE CHAR ON SELECTED DEVICE
;CALL WITH:
; PUSHJ P,DEVOUT
; RETURN HERE (HALTS IF ERROR)
;
; THE D60SPL VERSION DOES A SKIP RETURN IF OK, NON-SKIP ON ERROR.
;
LOWSEG
DEVOUT: TXNE S,NOTYPE ;IS NOTYPE ON?
IFE D60SPL,<
POPJ P, ;YES, JUST RETURN
>
IFN D60SPL,<
JRST .POPJ1## ;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,<
IFE D60SPL,<
SKIPGE J$XHIP(J) ;HEADER IN PROGRESS?
POPJ P, ;YES, JUST RETURN
> ;END IFE D60SPL
CAIG C,24 ;IS IT BETWEEN
CAIGE C,12 ; 12 AND 24?
IFE D60SPL,<
POPJ P, ;NO, RETURN
>
IFN D60SPL,<
JRST .POPJ1## ;NO, RETURN
>
PJRST OUTOUT ;YES, DUMP IT
> ;END IFN FTDPM
IFN D60SPL,<
AOS (P) ;SKIP RETURN
>
POPJ P, ;RETURN
DEVO.2: PUSHJ P,OUTOUT ;DUMP THE BUFFER
IFN D60SPL,<
POPJ P, ;ERROR
>
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
IFE D60SPL,<
TXZE S,RQB ;CLEAR REQUE AND SKIP IF NOT SET
>
IFN D60SPL,<
TXNE S,RQB ;SKIP IF NOT REQUEUEING
>
MOVEI T4,[ASCIZ /*REQUEUE*/] ;SAY SO
IFE D60SPL,<
PUSHJ P,GIVHDR ;GO SETUP THE LINE
>
IFN D60SPL,<
MOVEM T4,J$XHIP(J) ;STORE MESSAGE TO PRINT
>
JRST TRAILR ;AND NOW GO PRINT THE TRAILER
JOBHDR:
IFN D60SPL,<
PUSHJ P,D60TSM ;ARE WE SIMULATING?
POPJ P, ;YES, NO HEADERS OR TRAILERS.
>
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
IFE D60SPL,<
PUSHJ P,GIVHDR ;GO SET THE LINE
>
IFN D60SPL,<
MOVEM T4,J$XHIP(J) ;STORE POINTER TO MESSAGE
>
JRST BANNER ;AND GO PRINT THE BANNER PAGES
;
; SUBROUTINE TO PRINT A BANNER LINE
;
GIVHDR: MOVE T3,J$FWCL(J) ;LOAD THE WIDTH CLASS
IFE D60SPL,<
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
>
IFN D60SPL,<
TELLN USR,@J$XHIP(J) ;PRINT LEADING MESSAGE
>
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
IFN D60SPL,<
CAIE T3,3 ;IF NOT CLASS THREE...
>
TELL USR,JBHDR8 ;TYPE "MONITOR"
TELLN USR,LPCNF ;PRINT THE MONITOR NAME
IFE D60SPL,<
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
>
IFN D60SPL,<
TELLN USR,@J$XHIP(J) ;PRINT A WORD
>
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
IFN D60SPL,<
POPJ P, ;QUIT ON ERRORS
>
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
IFE D60SPL,<
CAIE S1,3 ;IS IT 3?
>
IFN D60SPL,<
CAIGE S1,3 ;IS IT 3 OR 4?
>
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
IFE D60SPL,<
MOVE P3,J$FTRA(J) ;AND THE NUMBER OF TRAILERS
PJUMPE P3,OUTEOJ ;RETURN IF ZERO
>
IFN D60SPL,<
SKIPN P3,J$FTRA(J) ;AND THE NUMBER OF TRAILERS
POPJ P, ;RETURN IF ZERO
>
TRAI.1: PUSHJ P,SENDFF ;SEND A FORMFEED
IFN D60SPL,<
POPJ P, ;QUIT ON ERRORS
>
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
IFE D60SPL,<
PJRST OUTEOJ ;AND DUMP BUFFERS AND RETURN
>
IFN D60SPL,<
POPJ P, ; 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
IFN D60SPL,<
CAILE T1,3 ;BUT NO MORE THAN THREE
MOVEI T1,3 ; ...
>
TRAI.5: PUSHJ P,DEVOUT ;PRINT A TAB
IFN D60SPL,<
POPJ P, ;QUIT ON ERROR
>
SOJG T1,TRAI.5 ;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:
IFE D60SPL,<
TELLN USR,J$XHBF(J) ;SEND A LINE
>
IFN D60SPL,<
PUSHJ P,GIVHDR ;SEND A LINE
>
MOVE T4,J$FWCL(J) ;GET THE WIDTH CLASS
IFE D60SPL,<
CAIN T4,3 ;IS IT 3?
>
IFN D60SPL,<
CAIL T4,3 ;IS IT 3 OR 4?
>
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
IFN D60SPL,<
PUSHJ P,OUTOUT ;DUMP OUTPUT BUFFER
JFCL ;IGNORE ERRORS
>
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
;
;
; HERE TO PRINT "STARS" AT THE BOTTOM OF THE PAGE.
; THIS IS THREE LINES OF RULER.
;
PEOP2:
IFN D60SPL,<
PUSH P,[EXP 0] ; -2 COLUMN COUNTER
PUSH P,[EXP ^D100] ; -1 CURRENT RADIX
PUSH P,[ASCIZ /0/] ; 0 CURRENT DIGIT
PEOP3: AOS T1,-2(P) ;INCREMENT AND FETCH COLUMN COUNTER
CAMLE T1,J$FWID(J) ;BEYOND SPECIFIED WIDTH?
JRST PEOP4 ;YES, DONE WITH THIS LINE.
IDIV T1,-1(P) ;NO, DIVIDE BY RADIX
IDIVI T1,^D10 ;COMPUTE LOW DIGIT OF QUOTIENT
DPB T2,[POINT 4,0(P),6] ;STORE LOW DIGIT IN CHARACTER
TELL USR,0(P) ;PRINT THE CHARACTER
JRST PEOP3 ;DO THE REST
;
; END OF LINE
;
PEOP4: TELL USR,CRDC3 ;GO TO NEXT LINE
SETZM -2(P) ;CLEAR COLUMN COUNTER
MOVE T1,-1(P) ;GET CURRENT RADIX
IDIVI T1,^D10 ;DIVIDE IT BY 10
JUMPE T1,PEOP5 ;IT WAS ONE, WE ARE DONE.
MOVEM T1,-1(P) ;STORE NEW RADIX
JRST PEOP3 ;DO NEXT LINE
;
; END OF THREE LINES
;
PEOP5: POP P,T1 ;ADJUST STACK
POP P,T1
POP P,T1
>
IFE D60SPL,<
TELL USR,STARS ;PRINT THE STARS
>
POPJ P, ;AND RETURN
;
SUBTTL HEAD -- Generate File-header pages
HEAD: PUSHJ P,.SAVE3## ;SAVE SOME ACS
IFN D60SPL,<
PUSHJ P,D60TSM ;SIMULATE MODE?
POPJ P, ;YES, NO FILE HEADERS
>
PUSHJ P,SENDFF ;SEND A FORMFEED
IFN D60SPL,<
POPJ P, ;RETURN IMMEDIATELY ON ERROR
>
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.
HEAD.2: PUSHJ P,HEAD.1 ;PRINT THE HEADER
SOJG P3,HEAD.2 ;LOOP FOR THE WHOLE WORKS
POPJ P, ;RETURN
; SUBROUTINE TO PRINT ONE HEADER PAGE
HEAD.1: 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:
IFE D60SPL,<
TELLN USR,J$XHBF(J) ; ..
>
IFN D60SPL,<
PUSHJ P,GIVHDR ;PRINT BANNER LINE
>
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
IFE D60SPL,<
CAIE P1,3 ;WIDTH CLASS 3?
>
IFN D60SPL,<
CAIGE P1,3 ;WIDTH CLASS 3 OR 4?
>
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:# .]
IFE D60SPL,<
CAIE P1,3 ;WIDTH CLASS 3?
>
IFN D60SPL,<
CAIGE P1,3 ;WIDTH CLASS 3 OR 4?
>
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 # *****
/]
IFE D60SPL,<
PJRST SENDFF ;SEND A FORM FEED
>
IFN D60SPL,<
PUSHJ P,SENDFF ;SEND A FORM FEED
JFCL ;IGNORE ERRORS
PUSHJ P,OUTOUT ;DUMP BUFFER
JFCL ;IGNORE ERRORS
POPJ P, ;RETURN.
>
;
; TABLE OF PAPER FORMATS AND FILE FORMATS
;
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
TELL4: PUSHJ P,DEVOUT ;PRINT THE CHAR
IFN D60SPL,<
POPJ P, ;RETURN IMMEDIATELY ON ERROR
>
SOJG P3,TELL4 ;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: RESET ;RESET ALL 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
IFN D60SPL,<
SETZM MSGLIN ; ON LINE ACTIVITY
>
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
IFN D60SPL,<
PUSHJ P,M$ACQP## ;GET A PAGE FOR DISK BUFFERS
PG2ADR AP ;CONVERT TO ADDRESS
MOVEM AP,J$DBUF(J) ;SAVE FOR LATER
>
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:
IFN D60SPL,<
ON S,INCMND ;MARK WE ARE IN A COMMAND
>
PUSHJ P,COMIN ;DO THE COMMAND
IFN D60SPL,<
OFF S,INCMND ;MARK NO LONGER IN A 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
SETOM FMNEW ;FORCE DEFALTS TO BE READ
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
VARSEG
;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
;
LOWSEG
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
IFN D60SPL,<
SUBTTL DN60 ADDITIONS TO LPTSPL
;
; THIS IS THE DN60 ADDITIONS TO LPTSPL. THESE ADDITIONS HAVE
; BEEN GATHERED TOGETHER HERE RATHER THAN NEAR THEIR
; USE FOR EASE OF MAINTENANCE.
;
; SUBROUTINES ARE AS FOLLOWS:
;
; D60ABO ABORT THE BSC STREAM
; D60C11 DO A CAL11. UUO, QUEUEING TO THE DN60
; D60CRD PROCESS A CARD FROM THE IBM 3780 CARD RADER
; D60DMP DUMP OUTPUT BUFFERS
; D60EOF CLOSE THE BSC STREAM
; D60ICL CLEAR AN INPUT ABORT OR EOF
; D60LPT PROCESS LPT DATA
; D60LRG RECOGNIZE LOG FILE SWITCHES
; D60NRY HANDLE A "NOT READY" CONDITION
; D60OPI CHECK FOR OPERATOR INPUT (A CARD)
; D60OUT SEND A BUFFER TO THE LINE PRINTER
; D60QUE SEND CURRENT CARD FILE TO SPRINT
; D60RDS READ DN60 DEVICE STATUS
; D60RLS RELEASE THE DN60 FRONT END
; D60SET PROCESS THE "SET" COMMAND
; D60SLP SLEEP A WHILE, PROCESSING CARD INPUT
; D60SOF SIGNOFF COMMAND
; D60SON SIGNON COMMAND
; D60SOS START AN OUTPUT STREAM
; D60STR PERFORM START COMMAND PROCESSING
; D60TSM TEST FOR SIMULATE MODE
; D60WDC WRITE DN60 DEVICE COMMAND (1 BYTE)
; D60WHT PRINT DN60 INFO FOR "WHAT" COMMAND
; D60WIL SUBSTITUTE FOR "IDLE" IN WHAT COMMAND
;
;
; HERE FROM THE "START" COMMAND WHEN THE
; DEVICE NAME IS "DN61" OR "DN64".
;
TOPSEG
D60STR: PUSHJ P,SIXIN ;GET NAME AFTER "DN6X:"
JRST D60BST ;BAD START COMMAND
SETZB T2,D60FGS ;CLEAR T2 AND FLAGS WORD
SETZM D60DLY ;NO INITIAL SCHEDULING DELAY
CAMN T1,[<SIXBIT /IBM2780/>] ;IBM 2780?
TRO T2,D60278 ;YES, FLAG IN T2
CAME T1,[<SIXBIT /IBM3780/>] ;IBM 3780?
JUMPE T2,D60BST ;NEITHER, BAD START COMMAND
IORM T2,D60FGS ;SET FLAG FOR IBM 2780 IF SO
D60ST1: CAIE C,"/" ;IF NOT TO SLASH ALREADY...
PUSHJ P,SPACES ; GET NEXT NON-BLANK
CAIN C,12 ;END OF LINE?
JRST D60ST9 ;YES, PROCESS THE DATA
CAIE C,"/" ;NO, SWITCH STARTER?
JRST D60BST ;NO, SYNTAX PROBLEM.
PUSHJ P,SIXIN ;YES, GET SWITCH NAME
JRST D60BST ;SHOULD BE THERE.
MOVE T2,T1 ;PUT SWITCH NAME IN T2
MOVE T1,[IOWD D60STL,D60STT]
PUSHJ P,LKNAME ;LOOK FOR THE NAME
JRST D60BST ;NOT FOUND
MOVE T1,D60STX-D60STT(T1) ;MATCH, GET TABLE ENTRY
TRNE T1,-1 ;DISPATCH ADDRESS?
JRST (T1) ;YES, DISPATCH
IORM T1,D60FGS ;NO, SET FLAGS INSTEAD
JRST D60ST1 ;LOOK FOR NEXT SWITCH
;
D60BST:
IFN FTUUOS,<
TELL OPR,[ASCIZ /!?LPT... Bad START command for DN61
/]
>
IFN FTJSYS,<
TELL OPR,[ASCIZ /!?LPT... Bad START command for DN64
/]
>
POPJ P,
;
;
; TABLE OF SWITCH NAMES
;
DEFINE NAMES,<
C SIMULATE,D60SIM,0
C SUPPORT,D60SUP,0
C PRIMARY,D60PRI,0
C SECONDARY,D60SEC,0
C PORT,D60ST6,0
C LINE,D60ST7,0
C STATION,D60ST8,0
>
DEFINE C(A,B,C),<
EXP SIXBIT /A/
>
D60STT: NAMES
D60STL==.-D60STT
DEFINE C(A,B,C),<
EXP B
>
D60STX: NAMES
;
; PORT
;
D60ST6: CAIE C,":" ;FOLLOWED BY A COLON?
JRST D60BST ;NO, ERROR.
PUSHJ P,OCTARG ;YES, GET OCTAL ARGUMENT
JFCL ;DON'T CARE ABOUT DELIMITER
CAILE N,13 ;TOO BIG?
JRST D60BST ;YES.
DPB N,[POINT 4,D60FGS,9]
MOVEI T1,D60PTS ;FLAG PORT SPECIFIED
IORM T1,D60FGS
JRST D60ST1
;
; LINE
;
D60ST7: CAIE C,":" ;ARGUMENT?
JRST D60BST ;NO.
PUSHJ P,DECARG ;GET LINE NUMBER
JFCL
CAILE N,^D11 ;TOO LARGE?
JRST D60BST ;YES.
DPB N,[POINT 5,D60FGS,14]
MOVEI T1,D60LNS ;FLAG LINE SPECIFIED
IORM T1,D60FGS
JRST D60ST1
;
; STATION
;
D60ST8: CAIE C,":" ;ARGUMENT?
JRST D60BST ;NO.
PUSHJ P,OCTARG ;YES, GET STATION NUMBER
JFCL
CAILE N,77 ;TOO LARGE?
JRST D60BST ;YES.
DPB N,[POINT 9,D60FGS,23]
MOVEI T1,D60STS ;FLAG STATION SPECIFIED
IORM T1,D60FGS
JRST D60ST1
;
; HERE AT END OF LINE. ALL SWITCHES PROCESSED.
;
D60ST9: MOVE T1,D60FGS ;GET FLAGS
TRC T1,D60PTS!D60LNS ;BETTER HAVE SPECIFIED PORT AND LINE
TRCE T1,D60PTS!D60LNS
JRST D60BST ;DIDN'T
TLNN T1,(D60SIM!D60SUP)
JRST D60BST ;NEITHER SIMULATE NOR SUPPORT
TLNN T1,(D60PRI!D60SEC)
JRST D60BST ;NEITHER PRIMARY NOR SECONDARY
;
; NOW INITIALIZE THE DN60 INTERFACE.
;
LDB T1,[POINT 4,D60FGS,9]
HRLM T1,D60CEB ;PDP-11 PORT NUMBER
IFN FTUUOS,<
MOVEI T1,.C11UP ;ASK IF THE FRONT END IS UP
HRRM T1,D60CEB
MOVE T1,[XWD 1,D60CEB]
CAL11. T1,
JRST D60BST ;NO PORT CONFIGURED
CAIE T1,1 ;IS THIS FRONT END UP?
JRST D60BST ;NO.
MOVEI T1,.C11NM ;YES, IS THIS A DN60?
HRRM T1,D60CEB
MOVE T1,[XWD 1,D60CEB]
CAL11. T1,
JRST D60BST
CAME T1,[SIXBIT /DN60 /]
JRST D60BST ;NOT A DN60 ON THIS PORT
MOVEI T1,.C11QU ;SET UP CAL11 BLOCK...
HRRM T1,D60CEB ; FOR QUEING FUNCTIONS
> ;END OF IFN FTUUOS
;
; INITIALIZE THE DN60 INTERFACE, TOPS-20 STYLE.
;
IFN FTJSYS,<
SETZB P1,J$LJFN(J) ;CLEAR P1, NO JFN YET.
D60STM: MOVE S1,[XWD 6,D60CEB] ;POINT TO CAL11. BLOCK
PUSHJ P,ENQ$## ;INTERLOCK ON THIS PORT
JRST [CAIE S1,ENQX6 ;IS PORT BUSY?
JRST D60STK ;NO, SOME OTHER PROBLEM.
PUSHJ P,D60ZZZ ;OTHER USER, WAIT A SECOND
JRST D60STM] ; AND TRY AGAIN.
D60ST2: MOVE T1,[POINT 7,D60JBF]
MOVEI T3,"F" ;BUILD NAME OF "FE" DEVICE
IDPB T3,T1
MOVEI T3,"E"
IDPB T3,T1
LDB T2,[POINT 3,P1,32]
JUMPE T2,D60ST3 ;DONT STORE HIGH DIGIT IF ZERO
ADDI T2,"0"
IDPB T2,T1 ;STORE HIGH DIGIT OF UNIT NUMBER
D60ST3: LDB T2,[POINT 3,P1,35]
ADDI T2,"0"
IDPB T2,T1 ;STORE LOW DIGIT
MOVEI T3,":" ;FOLLOWED BY COLON
IDPB T3,T1 ; TO SPECIFY DEVICE
SETZ T3, ;FOLLOWED BY A NULL
IDPB T2,T1 ; TO INDICATE END OF STRING
MOVX S1,GJ%OLD!GJ%SHT ;OLD FILE, SHORT FORM OF GTJFN
HRROI S2,D60JBF ;POINT TO STRING
GTJFN ;GET A JFN
ERJMP D60ST4 ;TRY NEXT UNIT, IF APPROPRIATE
MOVEM S1,J$LJFN(J) ;REMEMBER JFN OF FE DEVICE
MOVX S2,<^D8>B5!OF%RD!OF%WR ;READ, WRITE, 8 BITS
OPENF ;OPEN THE "FILE"
ERJMP D60ST5 ;TRY NEXT UNIT, IF APPROPRIATE
MOVX S2,.MODTE ;FUNCTION TO SPECIFY WHICH F.E.
LDB T1,[POINT 4,D60FGS,9] ; (T1 = REGISTER 3)
SUBI T1,10 ;CONVERT PORT NUMBER TO DTE NUMBER
MTOPR ;SPECIFY THE FRONT END
ERJMP D60STK ;SHOULD NOT HAPPEN
PUSHJ P,DEQ$## ;RELINQUISH CONTROL OF THIS PORT
JRST D60STK ;JSYS ERROR
JRST D60STJ ;INITIALIZATION COMPLETE
;
;
; HERE IF THE GTJFN FAILS
;
D60ST4: CAIE S1,GJFX29 ;DEVICE NOT AVAILABLE?
JRST D60STK ;NO, SOMETHING'S WRONG.
AOJA P1,D60ST2 ;YES, TRY NEXT UNIT.
;
; HERE IF THE OPENF FAILS
;
D60ST5: CAIE S1,OPNX7 ;DEVICE NOT AVAILABLE?
JRST D60STK ;NO, SOMETHING'S WRONG.
MOVE S1,J$LJFN(J) ;YES, RELEASE THE JFN
RLJFN
ERJMP D60STK ;JSYS ERROR
AOJA P1,D60ST2 ;GET ANOTHER JFN
;
; HERE ON A FATAL JSYS ERROR
;
D60STK: PUSHJ P,D60JSE ;PRINT AN ERROR MESSAGE
PUSHJ P,DEQ$## ;BE SURE PORT IS NOT TIED UP
PUSHJ P,D60JSE ;ANOTHER ERROR?
JRST D60BST ;"BAD START"
;
> ;END IFN FTJSYS
;
; INITIALIZATION OF THE DN60 INTERFACE IS NOW COMPLETE
;
D60STJ: MOVE T1,[XWD ^D26,7] ;READ 26 BYTES OF DN60 STATUS
MOVEM T1,D60CEB+2
MOVE T1,[XWD D60BSZ,D60BUF]
MOVEM T1,D60CEB+3 ;STORE BUFFER DESCRIPTOR
MOVSI T1,(BYTE (12) 4 (24) 0) ;8-BIT BYTES, OFFSET 0
MOVEM T1,D60CEB+4
SETZM D60CEB+5
PUSHJ P,D60C11 ;DO A CAL11. UUO
JRST D60BST
;
; WE HAVE READ DN60 STATUS
;
MOVSI T1,(1B7) ;CAN THIS DN60 DO
TDNN T1,D60BUF+4 ; IBM 3780 TRANSLATION?
JRST D60BST ;NO, BAD START COMMAND.
LDB T1,[POINT 8,D60BUF+3,7] ;GET NUMBER OF LINES
LDB T2,[POINT 5,D60FGS,14] ;GET LINE NUMBER
CAMLE T2,T1
JRST D60BST ;THAT LINE NOT ON THIS FRONT END
;
; THE PORT AND LINE NUMBERS ARE BOTH OK.
;
LDB T1,[POINT 5,D60FGS,14] ;LINE NUMBER
HRLM T1,D60CEB+1 ;STORE IN PARM BLOCK
MOVE T1,[BYTE (8) 4] ;DISABLE THE LINE
MOVEM T1,D60BUF
MOVE T1,[XWD 1,6] ;WRITE LINE COMMAND, 1 BYTE
MOVEM T1,D60CEB+2
PUSHJ P,D60C11 ;DO IT
JRST D60BST ;FAILURE
PUSHJ P,D60ZZZ ;WAIT A SECOND
MOVSI T1,(BYTE (8) 1, 1, 0) ;ENABLE, IBM 3780
MOVE T2,D60FGS ;GET FLAGS
TRNE T2,D60278 ;IBM 2780?
XORI T1,(BYTE (8) 0,3) ;YES, CHANGE ENABLE CODE
TLNE T2,(D60SIM) ;SIMULATE MODE?
TRO T1,<BYTE (8) 0,0,1> ;YES.
TLNE T2,(D60PRI) ;PRIMARY BSC?
TRO T1,<BYTE (8) 0,0,2> ;YES.
MOVEM T1,D60BUF ;STORE COMMAND
MOVE T1,[XWD 3,6] ;WRITE LINE COMMAND, 3 BYTES
MOVEM T1,D60CEB+2
PUSHJ P,D60C11 ;ENABLE THE LINE
JRST D60BST ;ERROR.
;
;
; WE HAVE NOW ENABLED THE DN60 LINE
;
MOVE T1,[XWD 2,4] ;WRITE DEVICE COMMAND, 2 BYTES
MOVEM T1,D60CEB+2
MOVSI T1,(BYTE (8) 1, 1) ;DEVICE TYPE = PRINTER
MOVEM T1,D60BUF
PUSHJ P,D60C11 ;DO THE CAL11. UUO
JRST D60BST ;ERROR
MOVE T1,[XWD 3,6] ;WRITE LINE COMMAND, 3 BYTES
MOVEM T1,D60CEB+2
MOVSI T1,(BYTE (8) 5, 3, 0) ;ASSUME 208B MODEMS
MOVEM T1,D60BUF ;SET CTS DELAY TO 48 MILLISECONDS
PUSHJ P,D60C11 ;DO THE CAL11. UUO
JRST D60BST ;ERROR.
MOVSI T1,(BYTE (8) 6, ^D64, 0) ;ASSUME MODERATE LINE SPEED
MOVEM T1,D60BUF ;SET SILO WARINNG LEVEL TO 64
PUSHJ P,D60C11 ;DO THE CAL11. UUO
JRST D60BST ;ERROR.
MOVSI T1,(BYTE (8) ^D24) ;CLEAR OUTPUT EOF
PUSHJ P,D60WDC
JRST D60BST
MOVSI T1,(BYTE (8) ^D27) ;CLEAR INPUT EOF
PUSHJ P,D60WDC
JRST D60BST
;
; WE NOW HAVE THE LINE ALL SET UP. FLUSH OUT ANY PREVIOUS
; TRANSMISSIONS.
;
MOVSI T1,(BYTE (8) ^D25) ;SIGNAL OUTPUT ABORT
PUSHJ P,D60WDC ;SEND DEVICE COMMAND TO DN60
JRST D60BST ;CANNOT!
MOVSI T1,(BYTE (8) ^D28) ;SIGNAL INPUT ABORT
PUSHJ P,D60WDC
JRST D60BST ;CANNOT.
;
;
; WAIT FOR INPUT AND OUTPUT ABORT TO COMPLETE, IN EITHER ORDER.
;
D60STB: PUSHJ P,D60ZZZ ;WAIT A SECOND
PUSHJ P,D60RDS ;READ DEVICE STATUS
JRST D60BST ;CANNOT.
TRNE T1,1B28 ;INPUT ABORT COMPLETE?
JRST D60STC ;YES.
TLNN T1,(1B17) ;NO, OUTPUT ABORT COMPLETE?
JRST D60STB ;NO, KEEP WAITING.
;
; HERE IF OUTPUT ABORT COMPLETES FIRST
;
MOVSI T1,(BYTE (8) ^D26) ;CLEAR OUT ABORT COMPLETE
PUSHJ P,D60WDC
JRST D60BST
;
; NOW WAIT FOR JUST INPUT ABORT COMPLETE
;
D60STD: PUSHJ P,D60ZZZ ;WAIT 1 SECOND
PUSHJ P,D60RDS ;READ DEVICE STATUS
JRST D60BST
TRNN T1,1B28 ;INPUT ABORT COMPLETE?
JRST D60STD ;NO, WAIT FOR IT.
MOVSI T1,(BYTE (8) ^D29) ;YES, CLEAR IT.
PUSHJ P,D60WDC
JRST D60BST
JRST D60STE ;ABORTS ALL DONE.
;
; HERE IF INPUT ABORT COMPLETES FIRST
;
D60STC: MOVSI T1,(BYTE (8) ^D29)
PUSHJ P,D60WDC ;CLEAR INPUT ABORT
;
; NOW WAIT FOR OUTPUT ABORT COMPLETE
;
D60STF: PUSHJ P,D60ZZZ ;SLEEP A SECOND
PUSHJ P,D60RDS ;READ STATUS
JRST D60BST
TLNN T1,(1B17) ;OUTPUT ABORT COMPLETE?
JRST D60STF ;NO, WAIT FOR IT.
MOVSI T1,(BYTE (8) ^D26) ;YES, CLEAR IT.
PUSHJ P,D60WDC
JRST D60BST
;
;
; HERE WHEN ALL THE ABORTS ARE COMPLETE.
; CLEAR EOF, SET BLOCK SIZE AND BSC MODE TYPE.
;
D60STE: MOVSI T1,(BYTE (8) ^D24) ;CLEAR OUTPUT EOF
PUSHJ P,D60WDC
JRST D60BST
MOVSI T1,(BYTE (8) ^D27) ;CLEAR INPUT EOF
PUSHJ P,D60WDC
JRST D60BST
MOVE T1,D60FGS ;GET FLAGS
TRNE T1,D60278 ;ARE WE DOING IBM 2780 STUFF?
JRST D60STG ;YES.
MOVEI T1,3 ;NO, 3 BYTE LONG COMMAND
HRLM T1,D60CEB+2
MOVE T1,[BYTE (8) ^D16, 0, 2] ;512. BYTES
MOVEM T1,D60BUF ;STORE COMMAND
PUSHJ P,D60C11 ;SET MAX BLOCK LENGTH
JRST D60BST
MOVSI T1,(<BYTE (8) ^D2, ^D0, ^D0>) ;NO LIMIT TO LOGICAL RECORDS
MOVEM T1,D60BUF ; IN A MESSAGE
PUSHJ P,D60C11
JRST D60BST ;ERROR
MOVSI T1,(BYTE (8) ^D20) ;SET NEW BSC MODE
PUSHJ P,D60WDC ;SET BSC MODE
JRST D60BST ;ERROR.
MOVSI T1,(BYTE (8) ^D17) ;SPECIFY DATA COMPRESSION
PUSHJ P,D60WDC
JRST D60BST ;ERROR
JRST D60STH ;REJOIN MAIN PATH
;
;
; HERE IF WE ARE DOING AN IBM 2780
;
D60STG: MOVEI T1,3 ;3 BYTE LONG COMMAND
HRLM T1,D60CEB+2
MOVE T1,[BYTE (8) ^D16, ^D144, ^D1] ;400 BYTE BLOCKS
MOVEM T1,D60BUF ;STORE COMMAND
PUSHJ P,D60C11 ;SET MAX BLOCK LENGTH
JRST D60BST
MOVSI T1,(<BYTE (8) ^D2, ^D7, ^D0>) ;MAX OF SEVEN RECORDS PER BLOCK
MOVEM T1,D60BUF
PUSHJ P,D60C11 ;SET MAX LOGICAL RECORDS
JRST D60BST ;ERROR.
MOVSI T1,(BYTE (8) ^D19) ;SPECIFY OLD BSC MODE
PUSHJ P,D60WDC ;SET BSC MODE
JRST D60BST ;ERROR.
MOVSI T1,(BYTE (8) ^D18) ;SPECIFY NO DATA COMPRESSION
PUSHJ P,D60WDC
JRST D60BST ;ERROR
;
; HERE TO REJOIN IBM 3780 AND IBM 2780 INTO MAIN PATH.
;
D60STH:
;
;
; NOW SPECIFY SUPPORT OR SIMULATE MODE
;
MOVE T1,D60FGS ;GET FLAGS
MOVSI T2,(BYTE (8) 6) ;SIMULATE A PRINTER
TLNN T1,(D60SIM) ;SIMULATE MODE?
MOVSI T2,(BYTE (8) 7) ;NO, SUPPORT A READER
MOVEM T2,D60BUF
PUSHJ P,D60C11 ;DO IT
JRST D60BST
MOVE T1,D60FGS ;GET FLAGS AGAIN
MOVSI T2,(BYTE (8) 10) ;SUPPORT A PRINTER
TLNN T1,(D60SUP) ;SUPPORT MODE?
MOVSI T2,(BYTE (8) 11) ;NO, SIMULATE A READER
MOVEM T2,D60BUF
PUSHJ P,D60C11
JRST D60BST ;ERROR.
;
; THE LINE IS NOW ALL READY TO GO. ONLY SETTING DTR IS LEFT
; FOR AN OPERATOR COMMAND.
;
MOVE T1,CNTSTA ;ASSUME WE ARE CENTRAL
MOVEM T1,MYSTA
MOVE T2,D60FGS ;GET FLAGS
TRNN T2,D60STS ;STATION SPECIFIED?
JRST D60STA ;NO.
LDB T1,[POINT 9,D60FGS,23] ;YES, GET STATION NUMBER
MOVEM T1,MYSTA ;STORE FOR FORM ACCESSING
D60STA: SETZM J$LREM(J) ;SET J$LREM BASED ON REMOTENESS
CAME T1,CNTSTA ;AT CENTRAL?
SETOM J$LREM(J) ;NO.
;
;
; NOW MAKE UP A DEVICE NAME BASED ON THE PORT AND LINE NUMBER
;
MOVE T2,[POINT 6,J$LDEV(J)]
MOVEI T1,'P'
IDPB T1,T2 ;FORM IS 'PNNLMM'
LDB T3,[POINT 4,D60FGS,9] ;GET PORT NUMBER
IDIVI T3,^D8 ;COMPUTE TWO OCTAL DIGITS
MOVEI T1,'0'(T3) ;HIGH-ORDER DIGIT
IDPB T1,T2
MOVEI T1,'0'(T4) ;LOW-ORDER DIGIT
IDPB T1,T2
MOVEI T1,'L'
IDPB T1,T2
LDB T3,[POINT 5,D60FGS,14] ;GET THE LINE NUMBER
IDIVI T3,^D10 ;TWO DECIMAL DIGITS
MOVEI T1,'0'(T3)
IDPB T1,T2
MOVEI T1,'0'(T4)
IDPB T1,T2
SETOM J$LD60(J) ;FLAG US AS RUNNING ON A DN60
AOS (P) ;SKIP MEANS SUCCESS
POPJ P, ;RETURN.
;
;
; SUBROUTINE TO RELEASE THE DN60 FRONT END. ON TOPS-10 NOTHING
; NEED BE DONE, SINCE THERE IS NO LONG-TERM CONNECTION.
; ON TOPS-20 WE MUST RELEASE THE JFN, AND IT MUST BE DONE
; CAREFULLY TO AVOID HURTING OTHER COPIES OF D60SPL THAY MAY
; BE USING THIS SAME PORT.
;
D60RLS:
IFN FTJSYS,<
SKIPE J$LD60(J) ;ON A DN60?
SKIPN J$LJFN(J) ;YES, HAVE WE A JFN?
POPJ P, ;NO, JUST RETURN.
D60RL2: MOVE S1,[XWD 6,D60CEB] ;SPECIFY PORT NUMBER
PUSHJ P,ENQ$## ;BE SURE NO OTHER USERS OF THIS F.E.
JRST [CAIE S1,ENQX6 ;OTHER USER?
JRST D60RL1 ;NO, ERROR.
PUSHJ P,D60ZZZ ;NO, WAIT A WHILE
JRST D60RL2] ; AND TRY AGAIN.
HRRZ S1,J$LJFN(J) ;GET OUR JFN
SETZM J$LJFN(J) ;DON'T DO THIS TWICE
CLOSF ;CLOSE AND RELEASE
ERJMP D60RL1 ;ERROR.
JRST D60RL3 ;DEQ AND RETURN.
;
; HERE ON JSYS ERROR
;
D60RL1: PUSHJ P,D60JSE ;GIVE ERROR MESSAGE
D60RL3: PUSHJ P,DEQ$## ;RELEASE CONTROL OF THE PORT
PUSHJ P,D60JSE ;ERROR MESSAGE
POPJ P, ;RETURN.
;
>
;
;
; SUBROUTINE TO TEST FOR SIMULATE MODE. THIS IS USED TO
; SUPPRESS HEADERS AND TRAILERS, AND TO SCHEDULE A
; DIFFERENT QUEUE.
;
TOPSEG
D60TSM: PUSH P,T1 ;SAVE T1
MOVE T1,D60FGS ;GET FLAGS
TLNN T1,(D60SIM) ;SIMULATE MODE?
AOS -1(P) ;NO, SKIP RETURN.
POP P,T1 ;RESTORE T1
POPJ P, ;RETURN.
;
;
; SUBROUTINE TO SIMULATE AN "OUT" UUO
;
; SEQUENCE IS:
;
; SOSGE J$LBCT(J)
; CALL D60OUT AND RETURN TO THE SOSGE
; IDPB J$LBPT(J)
;
LOWSEG
;
D60OUT: TXNN S,IHGTLP ;DO WE OWN THE LINE PRINTER?
POPJ P, ;NO, JUST RETURN.
PUSH P,T1 ;YES, SAVE T1
PUSH P,T2 ; AND T2
MOVE T1,D60FGS ;GET FLAGS
TRNE T1,D60OER ;STILL IN ERROR STATE?
JRST D60OU4 ;YES, DONT SEND BUFFER.
MOVEI T1,D60BSZ*5 ;NO, GET BUFFER LENGTH
SKIPL T2,J$LBCT(J) ;GET NUMBER OF BYTES STORED
; IF NEGATIVE, BUFFER IS FULL.
SUB T1,T2 ;COMPUTE NUMBER OF BYTES IN BUFFER
JUMPE T1,D60OU3 ;EMPTY, JUST RETURN.
HRLZS T1 ;PUT IN LEFT HALF
HRRI T1,2 ;"WRITE DATA"
MOVEM T1,D60CEB+2
MOVSI T1,(BYTE (12) 5 (24) 0)
MOVEM T1,D60CEB+4 ;7-BIT BYTES, OFFSET 0
D60OU2: MOVEI T2,^D60 ;MUST GET A BUFFER IN 60 SECONDS
D60OU1: PUSHJ P,D60C11 ;SEND THE BUFFER
JRST D60OU6 ;ERROR.
HRRZ T1,D60CEB+5 ;GET RESULT CODE
CAIN T1,1 ;SUCCESS?
JRST D60OU3 ;YES.
CAIE T1,2 ;DELAYED?
JRST D60OU6 ;NO, MUST BE ABORT.
;
; ;CONTINUED ON NEXT PAGE
;
;
; HERE WHEN THE ATTEMPT TO DO OUTPUT GETS A "DELAYED" RETURN.
;
HLRZ T1,D60CEB+5 ;GET NUMBER OF BYTES MOVED
JUMPE T1,D60OU7 ;NO PROGRESS, WAIT.
ADDM T1,D60CEB+4 ;SOME BYTES TAKEN, ADD TO OFFSET
MOVNS T1 ;NEGATIVE OF BYTES MOVED
HRLZS T1 ; INTO LH OF T1
ADDM T1,D60CEB+2 ;DECREMENT COUNT
D60OU7: AOS D60ODY ;RECORD AN OUTPUT DELAY
JUMPN T1,D60OU8 ;DONT SLEEP IF GOT SOME BYTES
PUSHJ P,D60ZZZ ;SLEEP FOR A SECOND
D60OU8: PUSHJ P,CHKOPR ;PROCESS ANY OPERATOR COMMANDS
SOJG T2,D60OU1 ;RE-ISSUE UUO UNLESS WAITED TOO LONG
SKIPE MSGLIN ;PRINT WITH LINE ACTIVITY MESSAGES
TELL OPR,[ASCIZ /![LPT... Device $ output delayed!]
/]
JRST D60OU2 ;TRY AGAIN, UNTIL ABORT.
;
; HERE ON SUCCESSFUL COMPLETION
;
D60OU3: AOS -2(P) ;SKIP RETURN
D60OU4: MOVE T1,[POINT 7,D60BUF]
MOVEM T1,J$LBPT(J) ;RESET BYTE POINTER
MOVEI T1,D60BSZ*5 ; AND COUNTER
MOVEM T1,J$LBCT(J) ;THE BUFFER IS NOW EMPTY
POP P,T2 ;RESTORE T2
POP P,T1 ;RESTORE T1
POPJ P, ;RETURN.
;
; HERE ON TIMEOUT OR BAD RESULT CODE OR ANY OTHER ERROR.
; SET A FLAG SO CALLER WILL ABORT THE BSC STREAM.
;
D60OU6: MOVEI T1,D60OER ;FLAG OUTPUT ERROR
IORM T1,D60FGS
JRST D60OU4 ;GIVE ERROR RETURN
;
;
; SUBROUTINE TO DUMP OUTPUT BUFFERS.
;
D60DMP: MOVSI T1,(BYTE (8) ^D3) ;SIGNAL DUMP OUTPUT
PUSHJ P,D60WDC ;TELL THE FRONT END
POPJ P, ;ERROR
D60DP1: PUSHJ P,D60ZZZ ;WAIT A SECOND
PUSHJ P,D60RDS ;READ DEVICE STATUS
POPJ P, ;ERROR
TLNE T1,(1B17) ;OUTPUT ABORTED?
POPJ P, ;YES, FAILED TO DUMP BUFFERS
TLNE T1,(1B11) ;OUTPUT STILL BEIGN DUMPED?
JRST D60DP1 ;YES, WAIT FOR ABORT OR DUMP COMPLETE
AOS (P) ;NO, DUMP FINISHED.
POPJ P, ;SUCCESS RETURN.
;
; SUBROUTINE TO SLEEP FOR ONE SECOND
;
D60ZZZ:
IFN FTUUOS,<
MOVEI S1,1 ;NUMBER OF SECONDS
SLEEP S1,
>
IFN FTJSYS,<
MOVEI S1,^D1000 ;NUMBER OF MILLISECONDS
DISMS
>
POPJ P, ;RETURN
;
;
; SUBROUTINE TO ABORT THE STREAM IF IT HAS ABSORBED ANY DATA.
;
TOPSEG
;
D60ABO: TXNN S,IHGTLP ;DO WE HAVE THE PRINTER?
POPJ P, ;NO, DO NOTHING.
SKIPE MSGLIN ;YES.
TELL OPR,[ASCIZ /![LPT... OUTPUT ABORT!]
/]
MOVE T1,D60FGS ;GET FLAG BITS
TRNN T1,D60OAT ;ANY DATA SENT?
JRST D60AB1 ;NO.
MOVSI T1,(BYTE (8) ^D25) ;ABORT TRANSMISSION
PUSHJ P,D60WDC
JRST D60AB7 ;CANNOT!
D60AB6: PUSHJ P,D60ZZZ ;WAIT A SECOND
PUSHJ P,D60RDS ;READ DEVICE STATUS
JRST D60AB7 ;CANNOT.
TLNN T1,(1B17) ;OUTPUT ABORT COMPLETE?
JRST D60AB6 ;NO, WAIT A LITTLE LONGER
MOVSI T1,(BYTE (8) ^D26) ;YES, ACKNOWLDEGE ABORT
PUSHJ P,D60WDC
JRST D60AB7 ;ERROR.
MOVEI T1,D60OAT ;CLEAR ACTIVE BIT
ANDCAM T1,D60FGS ;SINCE ABORT IS NOW COMPLETE.
OFF S,IHGTLP ;CALL D60SOS TO GET PRINTER AGAIN
MOVSI T1,(BYTE (8) ^D24) ;CLEAR EOF...
PUSHJ P,D60WDC ; IN CASE IT IS SET
JRST D60AB7 ;ERROR.
D60AB1: POPJ P, ;DONE.
;
; HERE ON ERROR.
;
D60AB7: JRST D60AB1 ;WHAT ELSE?
;
;
; SUBROUTINE TO SIGNAL EOF. THIS IS USED AFTER EVERY
; PRINTER JOB IN ORDER TO ALLOW CARDS.
;
; SKIP RETURN ON SUCCESS, NON-SKIP IF ERROR.
;
TOPSEG
;
D60EOF: TXNN S,IHGTLP ;DO WE HAVE THE PRINTER?
POPJ P, ;NO, JUST RETURN.
PUSHJ P,D60OUT ;YES, BE SURE BUFFER IS EMPTY
POPJ P, ;ERROR.
MOVE T1,D60FGS ;GET FLAG BITS
TRNN T1,D60OAT ;HAVE WE DONE ANY OUTPUT?
JRST D60EF3 ;NO.
MOVSI T1,(BYTE (8) ^D23)
PUSHJ P,D60WDC ;SIGNAL OUTPUT EOF
JRST D60EF1 ;ERROR.
D60EF2: PUSHJ P,D60ZZZ ;WAIT A SECOND
PUSHJ P,D60RDS ;READ DEVICE STATUS
JRST D60EF1 ;ERROR.
TLNE T1,(1B17) ;OUTPUT ABORT COMPLETE?
JRST D60EF1 ;YES, SOMETHING IS WRONG
TRNN T1,1B19 ;NO, EOF COMPLETE?
JRST D60EF2 ;NO, WAIT ANOTHER SECOND.
MOVSI T1,(BYTE (8) ^D24) ;YES, ACKNOWLEDGE EOF
PUSHJ P,D60WDC
JRST D60EF1 ;ERROR.
MOVEI T1,D60OAT ;NO LONGER ACTIVE
ANDCAM T1,D60FGS
D60EF3: OFF S,IHGTLP ;WE NO LONGER OWN THE LPT
SKIPE MSGLIN
TELL OPR,[ASCIZ /![LPT... OUTPUT EOF!]
/]
AOS (P) ;SKIP RETURN
POPJ P,
;
; HERE ON ERROR AND ABORT COMPLETE
;
D60EF1: MOVEI T1,D60OER ;FLAG OUTPUT IN ERROR
IORM T1,D60FGS
POPJ P, ;GIVE ERROR RETURN.
;
;
; SUBROUTINE CALLED WHEN OUTPUT HAS BEEN ABORTED BECAUSE THE
; BSC STREAM WAS ABORTED, PROBABLY DUE TO PRINTER OFFLINE
; BUT MAYBE DUE TO COMMUNICATIONS FAILURE.
;
; SKIP RETURN IF PROBLEM FIXED, NON-SKIP IF NOT.
;
TOPSEG
;
D60NRY: TELL OPR,[ASCIZ /%LPT... Device $ is not ready /]
TXNE S,INCMND ;ARE WE PROCESSING A COMMAND?
JRST D60NR6 ;YES, NO WAY TO RECOVER.
PUSHJ P,D60TSM ;NO, SIMULATING?
JRST D60NR3 ;YES. CAN'T REQUEUE USEFULLY.
D60NR5: TELL OPR,[ASCIZ /-- type !"GO!" when ready
/]
OFF S,RUNB ;STOP PROCESSING
TELL OPR,STAR ;SOLICIT INPUT FROM OPR
D60NR1: MOVEI S1,^D3 ;TIME TO WAIT
PUSHJ P,D60SLP ;WAIT A MOMENT
MOVE T1,D60FGS ;GET FLAGS
TRNN T1,D60SSU ;HAS CONTACT BEEN LOST?
JRST D60NR7 ;YES, SET RUN AND GIVE ERROR RETURN.
PUSHJ P,CHKOP0 ;NO, PROCESS ANY LOCAL OPERATOR TYPEIN
TXNN S,RUNB ;NO, HAS "GO" BEEN TYPED?
JRST D60NR1 ;NO, WAIT FOR ONE OR THE OTHER.
TRNE T1,D60IAT ;INPUT ACTIVE?
JRST D60NR1 ;YES, WAIT FOR IT TO CLEAR.
PUSHJ P,D60SOS ;NO, RE-ESTABLISH OUTPUT STREAM
JRST D60NRY ;NOT YET READY
AOS (P) ;SKIP RETURN
POPJ P, ;CONTINUE PRINTING FILE
;
;
; HERE IF "NOT READY" IN SIMULATE MODE.
;
D60NR3: TXNE S,DSKOPN ;IS A FILE OPEN?
JRST D60NR4 ;YES (USUAL CASE)
TELL OPR,[ASCIZ /-- data lost --/]
JRST D60NR5 ;GIVE APPREHENSIVE MESSAGE
;
; HERE IF WE ARE SENDING A FILE
;
D60NR4: TELL OPR,[ASCIZ /-- requeueing job
/]
POPJ P, ;PROBLEM NOT FIXED.
;
; HERE IF WE ARE PROCESSING A COMMAND, PROBABLY SIGNON OR SIGNOFF.
; WE CAN'T RECOVER FROM THIS CONDITION BECAUSE WE CAN'T CALL
; THE COMMAND DECODER RECURSIVELY.
;
D60NR6: TELL OPR,[ASCIZ /-- command aborted.
/]
POPJ P, ;ERROR RETURN.
;
; HERE IF CONTACT FAILS. SET RUN AGAIN AND GIVE ERROR RETURN.
; THIS WILL CAUSE THE FILE TO BE REQUED.
;
D60NR7: ON S,RUNB ;TURN RUN BACK ON
POPJ P, ;ERROR RETURN.
;
;
; SUBROUTINE TO CHECK FOR OPERATOR INPUT FROM CARD READER.
; SKIP RETURN IF ANY, SETS D60OIC AND D60OIP.
; BLANK CARDS ARE IGNORED.
;
TOPSEG
;
D60OPI: PUSH P,T1 ;SAVE T1
SKIPE D60OIC ;ANY CARDS LEFT FROM LAST TIME?
JRST D60OI2 ;YES, PROCESS THEM FIRST
D60OI7: PUSHJ P,D60RQI ;NO, SET UP FOR INPUT. HAVE WE INPUT?
JRST D60OI1 ;NO.
D60OI4: MOVE T1,[XWD D60BSZ*5,1] ;YES, READ DATA
MOVEM T1,D60CEB+2
MOVSI T1,(BYTE (12) 5 (24) 0)
MOVEM T1,D60CEB+4 ;7-BIT BYTES
PUSHJ P,D60C11
JRST D60OI1 ;ERROR (11-DOWN?)
HRRZ T1,D60CEB+5 ;GET RETURN CODE
CAIN T1,3 ;ABORT OR EOF?
JRST D60OI3 ;YES, ALL DONE.
HLRZ T1,D60CEB+5 ;GET LENGTH OF TEXT
JUMPE T1,D60OI1 ;NO DATA
MOVEM T1,D60OIC ;STORE LENGTH
MOVE T1,[POINT 7,D60BUF]
MOVEM T1,D60OIP ;STORE BYTE POINTER
D60OI5: ILDB T1,T1 ;PEEK AT FIRST CHARACTER
CAIE T1,15 ;IS IT CARRIAGE RETURN?
JRST D60OI2 ;NO, SKIP (CALL COMMAND DECODER)
D60OI6: SOSG D60OIC ;YES, SKIP TO LINE FEED
JRST D60OI4 ;OUT OF BUFFER, GET ANOTHER.
ILDB T1,D60OIP ;GET CHARACTER
CAIE T1,12 ;LINE FEED?
JRST D60OI6 ;NO, KEEP LOOKING.
MOVE T1,D60OIP ;YES, GET NEW BYTE POINTER
JRST D60OI5 ;SEE IF THIS CARD IS EMPTY, TOO
;
; HERE ON ERROR. CLEAR ABORT AND EOF.
;
D60OI3: PUSHJ P,D60ICL ;CLEAR ABORT AND EOF
JFCL ;DONT CARE WHICH
JRST D60OI7 ;SEE IF ANOTHER STREAM (UNLIKELY)
;
; HERE TO EXIT
;
D60OI2: AOS -1(P) ;SKIP RETURN (PROCESS COMMAND)
D60OI1: POP P,T1 ;RESTORE T1
POPJ P, ;RETURN.
;
;
; SUBROUTINE TO DO INPUT SETUPS
;
D60RQI: MOVE T1,D60FGS ;GET FLAGS
TRNE T1,D60IAT ;ALREADY DOING INPUT?
JRST D60RQ5 ;YES, DONT DO SETUPS AGAIN.
PUSHJ P,D60RDS ;READ DEVICE STATUS
JRST D60RQ1 ;UNABLE TO READ STATUS
TRNN T1,1B26 ;WAS INPUT PERMISSION REQUESTED?
JRST D60RQ1 ;NO.
MOVSI T1,(BYTE (8) ^D4) ;YES, CLEAR THE BIT
PUSHJ P,D60WDC ; SO WE CAN SEE IT NEXT TIME
PUSHJ P,.SAVE1## ;SAVE P1
MOVEI P1,^D25 ;SPEND A WHILE WAITING FOR REQUEST
D60RQ3: PUSHJ P,D60RDS ;READ DEVICE STATUS
JRST D60RQ1 ;CANNOT, MUST BE NO REQUEST
TLNE T1,(1B16) ;IS INPUT PERMISSION REQUESTED?
JRST D60RQ2 ;YES, GRANT PERMISSION
SOJLE P1,D60RQ1 ;IF WE HAVE WAITID LONG ENOUGH, QUIT.
IFN FTJSYS,<
MOVEI S1,^D250 ;WAIT ONE QUARTER SECOND
DISMS
>
IFN FTUUOS,<
MOVE T1,[EXP HB.RTL+^D250]
HIBER T1, ;WAIT ONE QUARTER SECOND
JFCL
>
JRST D60RQ3 ;CHECK FOR INPUT REQUEST AGAIN
;
;
; HERE WHEN INPUT PERMISSION HAS BEEN REQUESTED.
;
D60RQ2: MOVSI T1,(BYTE (8) ^D22) ;GRANT INPUT PERMISSION
PUSHJ P,D60WDC
JRST D60RQ1 ;FAILURE
SKIPE MSGLIN
TELL OPR,[ASCIZ /![LPT... INPUT PERMISSION REQUESTED!]
/]
D60RQ7: PUSHJ P,D60RDS ;READ DEVICE STATUS
JRST D60RQ1 ;CANNOT.
TRNN T1,1B31 ;IS "GRANT" STILL UP?
JRST D60RQ6 ;NO, CHECK ON OTHER BITS
PUSHJ P,D60ZZZ ;WAIT A SECOND
JRST D60RQ7 ;LOOK AGAIN.
;
D60RQ6: TRNN T1,1B27!1B29!1B30 ;INPUT DOING ANYTHING?
JRST D60RQ1 ;NO, TRY AGAIN LATER.
MOVEI T1,D60IAT ;YES, FLAG INPUT ACTIVE
IORM T1,D60FGS
SKIPE MSGLIN
TELL OPR,[ASCIZ /![LPT... INPUT PERMISSION GRANTED!]
/]
D60RQ5: AOS (P) ;SKIP RETURN
D60RQ1: POPJ P, ;RETURN.
;
;
; SUBROUTINE TO SLEEP FOR A WHILE, CHECKING FOR OPERATOR INPUT.
; CALLED WHEN THERE IS NOTHING TO DO AND NO OUTPUT STREAM
; RUNNING.
;
; S1 = NUMBER OF SECONDS*3 TO WAIT (UNLESS TTY OR IPCF ACTIVITY)
;
TOPSEG
;
D60SLP: TXNN S,IHGTLP ;DO WE OWN THE PRINTER?
JRST D60SLD ;NO.
PUSHJ P,D60OUT ;YES, DUMP THE BUFFER
JFCL ;CATCH ERRORS LATER
AOS (P) ;SKIP RETURN
POPJ P, ; TO DO NORMAL HIBER PROCESSING
;
; HERE WHEN WE DO NOT OWN THE PRINTER. DO IDLE-TIME WORK.
;
D60SLD: MOVEM S1,D60SLC ;GO THROUGH LOOP S1 TIMES
; (= S1*3 SECONDS)
PUSHJ P,SAVALL ;SAVE ALL AC'S (RESTORE ON RETURN)
D60SL9: MOVE T1,[XWD ^D63,5] ;READ LINE STATUS, 63 BYTES
MOVEM T1,D60CEB+2
MOVSI T1,(BYTE (12) 4 (24) 0) ;8-BIT BYTES
MOVEM T1,D60CEB+4
PUSHJ P,D60C11 ;READ LINE STATUS
JRST D60SL1 ;SOME KIND OF PROBLEM.
IFN FTJSYS,<
MOVEI T1,D60SSU ;SEE IF SIGNED ON
TDNN T1,D60FGS ;FLAG IS SET
JRST D60S11 ;NO,SKIP LOGGING THE ENTRY
GTAD ;GET CURRENT DATE AND TIME
IDIVI S1,<1000000/^D24> ;TO GET HOUR OF DAY
MOVE S2,D60TIM ;PREV TIME
IDIVI S2,<1000000/^D24> ;FIND PREV HOUR
CAMN S1,S2 ;DIFFERENT HOURS?
JRST D60S11 ;NO,DONT LOG ENTRY
MOVEI T1,2 ;REASON FOR LOGGING ENTRY
PUSHJ P,D60LGE ;LOG IT IN SYSERR
JFCL ;ERROR RETURN IS NOOP
> ; END OF IFN FTJSYS
D60S11: SETZ T1, ;BUILD CURRENT D60DTR AND D60DSR
MOVE T2,D60BUF ;GET LINE STATUS
TRNE T2,1B22 ;IS DTR UP?
TLO T1,(D60DTR) ;YES, INDICATE THAT
TRNE T2,1B21 ;IS DSR UP?
TLO T1,(D60DSR) ;YES, INDICATE THAT
XOR T1,D60FGS ;SEE IF EITHER HAS CHANGED
TLNE T1,(D60DTR!D60DSR)
PUSHJ P,D60WHT ;YES, PRINT AND CHANGE D60FGS
;
; ;CONTINUED ON NEXT PAGE
;
;
; HERE WHEN THE NEW VALUES ON DTR AND DSR HAVE BEEN STORED.
; IF DSR IS OFF AND WE WERE SIGNED ON,
; WE ARE NO LONGER SIGNED ON.
;
MOVE T1,D60FGS ;GET FLAGS
TLNE T1,(D60DSR) ;IS DATA SET READY?
JRST D60SLB ;YES.
TRNN T1,D60SSU ;NO, WAS STATION SIGNED ON?
JRST D60SLB ;NO, NOT IMPORTANT.
MOVEI T1,D60SSU ;YES, NO LONGER SIGNED ON.
ANDCAM T1,D60FGS
ON S,PAUSEB ;STOP NOW, WAIT FOR "SET STATION"
; OR "SIGNON"
PUSHJ P,D60TSM ;ARE WE SIMULATING?
JRST D60SLA ;YES, DIFFERENT MESSAGE
MOVE N,MYSTA ;NO, ANNOUNCE SIGNOFF
IFN FTJSYS,<
MOVEI T1,3 ;REASON FOR SYSERR ENTRY=SIGNOFF
PUSHJ P,D60LGE ;LOG IN SYSTEM ERROR FILE
JFCL ;NOOP FOR ERROR RETURN FROM JSYS
> ;END OF IFN FTJSYS
TELL OPR,[ASCIZ /![LPT... Station & has signed off!]
/]
JRST D60SL4 ;CONTINUE
;
; HERE TO GIVE A DIFFERENT MESSAGE IN SIMULATE MODE
;
D60SLA: TELL OPR,[ASCIZ /![LPT... Automatic signoff--line has hung up!]
/]
;
D60SL4: ;QIDLE WILL SAY "GOODBY" TO QUASAR
;
; HERE WHEN DTR AND DSR HAVE BEEN PROCESSED
;
D60SLB:
;
;
; NOW CHECK FOR INPUT, EITHER CARDS OR PRINT IMAGES.
;
D60SL1: MOVE T1,D60FGS ;GET FLAG BITS
TLNE T1,(D60SIM) ;SIMULATE MODE?
JRST D60SL5 ;YES.
PUSHJ P,D60OPI ;NO, ANY CARD INPUT FOR OPERATOR?
JRST D60SL6 ;NO.
PUSHJ P,D60CRD ;SEE IF THIS IS A JOB, AND PROCESS IT.
JRST D60SL1 ;IT WAS, CHECK FOR MORE INPUT
ON S,INCMND ;IT WASN'T, MARK WE ARE IN A COMMAND
PUSHJ P,COMIN ;PROCESS THE COMMAND
OFF S,INCMND ;COMMAND PROCESSING COMPLETE
JRST D60SL1 ;CHECK FOR MORE INPUT
;
D60SL6:
IFN FTUUOS,<
MOVE T1,[EXP HB.RTL+^D3000] ;WAIT THREE SEC
HIBER T1,
JFCL ;WHAT??
>
IFN FTJSYS,<
MOVEI S1,^D3000 ;WAIT THREE SEC
DISMS
>
SKIPN TTYFLG ;ANY TYPEINS?
SKIPE @QRYFLG ;OR HAVE WE HAD AN IPCF INTERRUPT?
SETZM D60SLC ;YES, CANCEL REST OF WAIT TIME
MOVE T1,D60FGS ;GET FLAGS
TRNN T1,D60IAT ;INPUT ACTIVE?
SOSLE D60SLC ;NO, WAITED LONG ENOUGH?
JRST D60SL9 ;NO, RUN THE LOOP AGAIN
POPJ P, ;YES, CHECK QUASAR QUEUES AGAIN.
; (INPUT IS NOT ACTIVE)
;
;
; HERE IF WE ARE IN SIMULATE MODE.
;
D60SL5: PUSHJ P,CHKOPR ;PROCESS OPERATOR INPUT
PUSHJ P,D60RQI ;ESTABLISH AN INPUT STREAM
JRST D60SL6 ;NONE, SLEEP.
MOVE T1,[XWD D60BSZ*5,1] ;READ DATA
MOVEM T1,D60CEB+2
MOVSI T1,(BYTE (12) 5 (24) 0)
MOVEM T1,D60CEB+4 ;7-BIT BYTES
PUSHJ P,D60C11
JRST D60SL6 ;ERROR.
HRRZ T1,D60CEB+5 ;GET RETURN CODE
CAIN T1,3 ;ABORT OR EOF?
JRST D60SL7 ;YES, ALL DONE.
HLRZ T1,D60CEB+5 ;GET LENGTH OF TEXT
JUMPE T1,D60SL6 ;NO DATA.
PUSHJ P,D60LPT ;GO PROCESS LINE PRINTER DATA
JRST D60SL5 ;PROCESS MORE DATA, IF ANY.
;
; HERE ON EOF OR ABORT.
;
D60SL7: PUSHJ P,D60ICL ;CLEAR INPUT ABORT OR EOF
JRST D60SL8 ; IT WAS ABORT.
PUSHJ P,D60LPF ;INDICATE EOF
SETZM D60SLC ;CANCEL REST OF WAIT TIME
JRST D60SL6 ;NO MORE DATA FOR NOW
;
; HERE ON ERROR
;
D60SL8: PUSHJ P,D60LPE ;INDICATE ERROR
JRST D60SL6 ; AND RETURN.
;
;
; HERE TO PROCESS LINE PRINTER DATA COMING TO A SIMULATED
; IBM 3780.
;
D60LPT: MOVE T1,D60FGS
TRNE T1,D60LFO ;IS LINE PRINTER FILE OPEN?
JRST D60LP1 ;YES.
SKIPE MSGFIL ;NO, PRINT MESSAGE IF REQUESTED.
TELL OPR,[ASCIZ /![LPT... Log file started!]
/]
IFN FTUUOS,<
MOVE T1,J$LDEV(J) ;GET "PNNLMM"
MOVEM T1,J$DUUO+.RBNAM(J) ; IT IS THE FILE NAME
MOVSI T1,(SIXBIT /LPT/) ;EXTENSION IDENTIFIES LINE PRINTER DATA
MOVEM T1,J$DUUO+.RBEXT(J)
SETZM J$DUUO+.RBPPN(J) ;PUT ON MY DISK AREA
SETZM J$DUUO+.RBPRV(J) ;DEFAULT OTHER VALUES
MOVEI T1,.RBTIM ;SET UP FOR ENTER UUO
MOVEM T1,J$DUUO+.RBCNT(J)
SETZ T1, ;ASCII MODE
MOVSI T2,(SIXBIT /D60/) ;ERSATZ DEVICE "D60"
MOVSI T3,J$DBRH(J) ;BUFFER HEADER FOR OUTPUT
OPEN DSK,T1 ;OPEN DEVICE "D60"
JRST D60LP3 ;OPEN ERROR
MOVE T4,J$DBUF(J) ;CREATE OUTPUT BUFFERS
EXCH T4,.JBFF##
OUTBUF DSK,<1000/203>
MOVEM T4,.JBFF##
LOOKUP DSK,J$DUUO(J) ;SEE IF PREVIOUS FILE THERE
SETZM J$DUUO+.RBSIZ(J) ;NO, START AT FRONT.
ENTER DSK,J$DUUO(J) ;OPEN THE FILE FOR OUTPUT
JRST D60LP3 ;ERROR.
SKIPE T1,J$DUUO+.RBSIZ(J) ;HOW LONG IS FILE?
ADDI T1,^D127 ;NON-ZERO, ACCOUNT FOR PARTIAL BLOCK
IDIVI T1,^D128 ;CONVERT WORDS TO BLOCKS
ADDI T1,1 ;BLOCKS START AT NUMBER 1
USETO DSK,(T1) ;APPEND TO THE FILE (IF ANY)
SETZM J$DUUO+.RBALC(J) ;DONT TRUNCATE FILE WHEN CLOSING
MOVE T1,J$DUUO+.RBSIZ(J) ;GET LENGTH IN WORDS
IMULI T1,5 ;CONVERT TO CHARACTERS
MOVEM T1,D60FSZ ;REMEMBER INITIAL FILE SIZE
>
;
;
; OPEN LINE PRINTER FILE, TOPS-20 STYLE
;
IFN FTJSYS,<
MOVE T1,[POINT 7,D60JBF] ;POINTER TO JFN NAME BUFFER
MOVE T2,[POINT 7,[ASCIZ /<DN60>LPT-IBM-/]]
D60LP8: ILDB T3,T2 ;COPY FIRST PART OF NAME
JUMPE T3,D60LP9 ;FIRST PART DONE
IDPB T3,T1 ;STORE CHARACTER
JRST D60LP8 ;COPY THE REST OF FIRST PART
;
D60LP9: MOVE T2,[POINT 6,J$LDEV(J)] ;POINT TO "PNNLMM"
MOVEI T4,^D6 ;SIX CHARACTERS
D60LPA: ILDB T3,T2 ;GET CHARACTER
JUMPE T3,D60LPJ ;GOT THEM ALL
ADDI T3,40 ;CONVERT TO ASCII
IDPB T3,T1 ;APPEND TO STRING
SOJG T3,D60LPA ;COPY ALL SIX CHARACTERS
D60LPJ: MOVE T2,[POINT 7,[ASCIZ /.LPT/]]
D60LPH: ILDB T3,T2 ;COPY EXTENSION
JUMPE T3,D60LPG ;GOT IT ALL
IDPB T3,T1 ;STORE CHARACTER
JRST D60LPH ;GET THE REST
;
D60LPG: SETZ T3, ;APPEND A NULL TO THE STRING
IDPB T3,T1 ; TO END IT
HRROI S2,D60JBF ;POINT TO THE STRING
MOVX S1,GJ%SHT ;SHORT FORM OF GTJFN
GTJFN ;GET A JFN
ERJMP D60LP3 ;ERROR
MOVEM S1,D60OJN ;REMEMBER OUTPUT JFN
MOVX S2,<^D7>B5+OF%APP+OF%NWT ;APPEND MODE
OPENF ;OPEN THE FILE
ERJMP D60LP3 ;ERROR
MOVEI S2,^D7 ;SET FILE BYTE SIZE...
SFBSZ ; TO SEVEN (ASCII)
ERJMP D60LP3 ;ERROR
RFPTR ;GET FILE'S LENGTH
ERJMP D60LP3 ;ERROR (WHY?)
MOVEM S2,D60FSZ ;REMEMBER FILE SIZE (IN BYTES)
> ;END OF IFN FTJSYS
;
;
; CONTINUE WITH LOG FILE INITIALIZATION
; (NOTE: DON'T INCREASE THE "200" FOR OPR MESSAGE WITHOUT
; INCREASING THE SIZE OF J$XHBF)
;
MOVE T1,[POINT 7,J$XHBF(J)] ;SET UP BYTE POINTERS
MOVEM T1,D60LGP
MOVEM T1,D60LGQ
MOVEI T1,^D200 ; AND COUNTER
SKIPE D60FSZ ;UNLESS THIS IS A RESTART...
SETZ T1, ; IN WHICH CASE DON'T BOTHER WITH RECORDING FOR OPR
MOVEM T1,D60LGC
MOVE T1,[XWD D60LR3,[ASCIZ \/PNAME:\]]
PUSHJ P,D60LRI ;INITIALIZE LOG PARM RECOGNIZER
MOVEI T1,D60LFO ;MARK THE LINE PRINTER FILE OPEN
IORM T1,D60FGS
MOVEI T1,D60LRE ;MARK LOG FILE PARMS NOT RECOGNIZED
ANDCAM T1,D60FGS
;
;
; THE LINE PRINTER FILE IS NOW OPEN.
;
D60LP1: HLRZ T1,D60CEB+5 ;GET COUNT
MOVEM T1,D60OIC ;STORE IN COUNT CELL
MOVE T1,[POINT 7,D60BUF]
MOVEM T1,D60OIP ;STORE INITIAL BYTE POINTER
;
; THIS LOOP COPIES DATA FROM THE IBM 370'S PRINTER TASK
; TO THE DISK FILE.
;
D60LP4: SKIPN D60OIC ;ANY CHARS LEFT IN BUFFER?
JRST D60LP5 ;DONE WITH PASS.
SOS D60OIC ;YES, DECREMENT CHARACTER COUNT
ILDB C,D60OIP ;GET CHARACTER
SKIPG D60LGC ;NEAR FRONT OF FILE?
JRST D60LPD ;NO.
SOS D60LGC ;YES, DECREMENT COUNT
IDPB C,D60LGP ;REMEMBER CHARACTER FOR OPR MAYBE
CAIG C," " ;GRAPHIC CHARACTER?
JRST D60LPD ;NO.
MOVE T1,D60LGP ;YES, ADVANCE BYTE POINTER
MOVEM T1,D60LGQ ; TO COVER LAST GRAPHIC.
D60LPD:
IFN FTUUOS,<
SOSLE J$DBCT(J) ;ANY ROOM IN DISK BUFFER?
JRST D60LP6 ;YES, STORE CHARACTER.
OUT DSK, ;NO, EMPTY THE BUFFER
JRST D60LP6 ;NO ERRORS, STORE CHARACTER
GETSTS DSK,N ;GET CHANNEL STATUS
D60LPB: SKIPE MSGERR
TELL OPR,[ASCIZ /!?LPT... DISK OUTPUT ERROR, STATUS = &
/]
JRST D60LP7 ;ABORT THE OPERATION
;
; HERE TO STORE A CHARACTER IN THE BUFFER
;
D60LP6: IDPB C,J$DBPT(J)
AOS D60FSZ ;REMEMBER INCREASED LENGTH
> ;END OF IFN FTUUOS
PUSHJ P,D60LRG ;OPERATE THE LOG FILE RECOGNIZER
JRST D60LP4 ;GET NEXT CHARACTER
;
;
; HERE WHEN WE ARE DONE SCANNING THE BUFFER. ON TOPS-10, WE ARE DONE.
; ON TOPS-20, DO A SOUT JSYS TO TRANSFER THE DATA TO A MONITOR BUFFER.
;
D60LP5:
IFN FTJSYS,<
MOVE S1,D60OJN ;GET OUTPUT JFN
HRROI S2,D60BUF ;BYTE PTR TO STRING
HLRZ T1,D60CEB+5 ;GET THE COUNT OF BYTES
ADDM T1,D60FSZ ;REMEMBER INCREASED LENGTH
MOVNS T1 ;NEED THE NEGATIVE
SOUT ;OUTPUT THE STRING
ERJMP D60LPB ;ERROR
POPJ P, ;RETURN TO CALLER
;
; HERE ON AN ERROR
;
D60LPB: SKIPN MSGERR ;DOES OPR WANT TO SEE ERRS?
JRST D60LP7 ;NO.
TELL OPR,[ASCIZ /!?LPT... DISK OUTPUT ERROR
/]
PUSHJ P,D60JSE ;PRINT ERROR MESSAGE FROM MONITOR
JRST D60LP7 ;TERMINATE INPUT
;
> ;END OF IFN FTJSYS
IFN FTUUOS,<
POPJ P, ;RETURN.
>
;
;
; HERE WHEN THE DATA FROM THE DN60 IS COMPLETE.
;
D60LPF: MOVE T1,D60FGS ;GET FLAGS
TRNN T1,D60LFO ;HAVE WE ANY DATA?
JRST D60LP2 ;NO, IGNORE TRANSMISSION.
IFN FTUUOS,<
MOVE T1,[EXP %CNDTM] ;YES, FORM A RANDOM NAME
GETTAB T1, ;GET TIME AND DATE IN 36 BITS
SETO T1, ;SHOULD NOT HAPPEN
>
IFN FTJSYS,<
GTAD ;GET TIME AND DATE IN 36 BITS
MOVE T1,S1 ;PUT IN T1
>
MOVEM T1,D60FLN ;FORM UNIQUE NAME
SKIPLE D60LGC ;SHORT FILE?
JRST D60LF5 ;YES, DELETE IT.
MOVE T1,D60FGS ;GET FLAGS
TRNN T1,D60LRE ;HAVE WE RECOGNIZED LOG FILE INFO?
JRST D60LF3 ;NO, PRINT FOR [1,2]
MOVE T1,D60LRD ;YES, GET DISPOSITION CODE
JRST @[JRST D60LF4 ;1 = PRINT
JRST D60LF5 ;2 = DELETE
JRST D60LF6]-1(T1) ;3 = HOLD
;
;
; HERE IF THERE IS NO LOG INFO. SET TO [1,2] AND FALL
; INTO PRINT.
;
D60LF3: MOVE T1,[XWD 1,2]
MOVEM T1,D60LRU
SETZM D60LRN
;
; HERE TO PRINT THE LOG FILE
;
D60LF4:
IFN FTUUOS,<
MOVE T1,D60LRN ;GET "NAME" OF LOG FILE
MOVEM T1,J$DUUO+.RBSPL(J) ;SET "RENAMED ORIG. NAME"
MOVE T1,D60FLN ;GET RANDOM FILE NAME
MOVEM T1,J$DUUO+.RBNAM(J) ;MAKE IT THE NEW NAME
MOVEI T1,177 ;SET PROTECTION
DPB T1,[POINT 8,J$DUUO+.RBPRV(J),7] ;TO KEEP EYES OFF
RENAME DSK,J$DUUO(J) ;CHANGE FILE'S NAME AND PROTECTION
JRST D60LP3 ;RENAME ERROR
CLOSE DSK, ;CLOSE THE OUTPUT FILE
STATZ DSK,742000 ;ANY LAST ERRORS?
JRST D60LPB ;YES.
RELEAS DSK,
> ;END OF IFN FTUUOS
;
;
; PRINT THE LOG FILE, TOPS-20 STYLE.
;
IFN FTJSYS,<
MOVE T1,[POINT 7,[ASCIZ /<DN60>/]]
MOVE T2,[POINT 7,D60JBF]
D60LFA: ILDB T3,T1 ;COPY FIRST PART OF NEW NAME
JUMPE T3,D60LFB ;END OF NAME
IDPB T3,T2 ;STORE THE CHARACTER
JRST D60LFA ;COPY WHOLE STRING
;
D60LFB: GTAD ;GET INTERNAL TIME (RANDOM NUMBER)
MOVE T1,[POINT 3,S1,17] ;LOW SIX OCTAL DIGITS
MOVE S2,[POINT 6,D60FLN] ;RECORD SIXBIT NAME
MOVEI T4,^D6 ;SIX CHARACTERS
D60LFC: ILDB T3,T1 ;GET CHARACTER OF NAME
ADDI T3,20 ;MAKE SIXBIT DIGIT
IDPB T3,S2 ;RECORD FOR QMANGR
ADDI T3,40 ;CONVERT TO ASCII
IDPB T3,T2 ;APPEND TO STRING
SOJG T4,D60LFC ;TAKE SIX CHARACTERS
D60LFM: MOVE T1,[POINT 7,[ASCIZ /.LPT/]]
D60LFE: ILDB T3,T1 ;GET CHAR FROM TAIL OF NEW NAME
JUMPE T3,D60LFD ;ALL DONE
IDPB T3,T2 ;APPEND TO STRING
JRST D60LFE ;COPY THE WHOLE STRING
;
D60LFD: SETZ T3, ;APPEND A NULL
IDPB T3,T2 ; TO TERMINATE THE STRING
MOVX S1,GJ%SHT+GJ%FOU ;SHORT GTJFN, OUTPUT FILE
HRROI S2,D60JBF ;POINT TO JFN NAME BUFFER
GTJFN ;GET JFN FOR NEW FILE NAME
ERJMP D60LP3 ;ERROR
MOVX S2,<^D7>B5+OF%WR+OF%NWT ;WRITE ON FILE
OPENF ;OPEN OUTPUT FILE
ERJMP D60LP3 ;ERROR
MOVEI S2,^D7 ;SET FILE BYTE SIZE...
SFBSZ ; TO SEVEN
ERJMP D60LP3 ;ERROR
HRLM S1,D60OJN ;REMEMBER NEW JFN
;
;
; WE HAVE SPECIFIED THE NEW NAME OF THE FILE TO BE SPOOLED.
;
HRRZ S1,D60OJN ;GET OLD JFN
TXO S1,CO%NRJ ;DONT RELEASE THE JFN
CLOSF ;CLOSE THE FILE
ERJMP D60LP3 ;ERROR
HLRZ S1,D60OJN ;GET NEW JFN
TXO S1,CO%NRJ ;DONT RELEASE THE JFN
CLOSF ;CLOSE THE FILE
ERJMP D60LP3 ;ERROR
HRRZ S1,D60OJN ;GET OLD JFN
HLRZ S2,D60OJN ; AND NEW JFN
RNAMF ;CHANGE NAMES (OLD BECOMES NEW)
ERJMP D60LP3 ;ERROR
HLRZ S1,D60OJN ;GET NEW JFN
RLJFN ;RELEASE IT
ERJMP D60LP3 ;ERROR
HRRZ S1,D60OJN ;GET OLD JFN
RLJFN ;RELEASE IT
ERJMP D60LP3 ;ERROR
SETZM D60OJN ;BOTH JFN'S ARE RELEASED
> ;END OF IFN FTJSYS
;
;
; HERE TO SEND THE FILE TO LPTSPL FOR PRINTING
;
MOVX T1,<SIXBIT /LPT/> ;GET NEW EXTENSION
MOVEM T1,D60FLX ;STORE AS FILE EXTENSION
MOVEI T1,D60LFO ;TURN OFF "OPEN" BIT
ANDCAM T1,D60FGS
PUSHJ P,.SAVE1## ;SAVE P1
PUSHJ P,M$ACQP## ;GET A PAGE FOR QMANGR PARM LIST
MOVEM AP,J$APAG(J) ;REMEMBER PAGE FOR FREEING
PG2ADR AP ;CONVERT TO ADDRESS
MOVE P1,AP ;POINT P1 TO PAGE
MOVSI T1,'LPT' ;PUT FILE IN LPT QUEUE
MOVEM T1,Q.DEV(P1)
IFN FTUUOS,<
MOVE T1,[XWD 100,16] ;GET PPN OF D60: AREA
GETTAB T1,
MOVE T1,[XWD 5,32] ;MUST BE 602A MONITOR, USE [5,32]
>
IFN FTJSYS,<
MOVE T1,[XWD 1,2] ;OPERATOR'S PPN
>
MOVEM T1,Q.PPN(P1) ;STORE AS PPN OF SUBMITTOR
MOVE T2,D60LRU ;GET USER'S PPN
SETZ T1, ;BUILD USER NAME
MOVEI T3,6 ; FROM THE PPN
D60LF7: LSH T1,3 ; AS 12 OCTAL DIGITS
LSHC T1,3
ADDI T1,'0'
SOJG T3,D60LF7 ;DO FIRST SIX DIGITS
MOVEM T1,Q.USER(P1) ;STORE AS FIRST HALF OF NAME
SETZ T1, ;NOW DO SECOND HALF
MOVEI T3,6
D60LF8: LSH T1,3
LSHC T1,3
ADDI T1,'0'
SOJG T3,D60LF8 ;DO LAST SIX DIGITS
MOVEM T1,Q.USER+1(P1)
PUSHJ P,D60QUE ;SEND FILE TO LPTSPL
SKIPE MSGFIL
TELL OPR,[ASCIZ /![LPT... Log file placed in LPT queue!]
/]
MOVE AP,J$APAG(J) ;GET PAGE ADDRESS BACK
PUSHJ P,M$RELP## ;RELEASE THE PAGE
JRST D60LF1 ;END OF LOG FILE PROCESSING
;
;
; HERE TO DELETE THE LOG FILE. THIS IS DONE ONLY IN RESPONSE
; TO AN EXPLICIT USER REQUEST OR IF THE FILE IS VERY SHORT, SINCE
; WE WILL BE TYPING IT TO THE OPR ANYWAY.
;
D60LF5:
IFN FTUUOS,<
SETZM J$DUUO+.RBNAM(J) ;BLANK NAME
SETZM J$DUUO+.RBEXT(J) ; AND EXTENSION
RENAME DSK,J$DUUO(J) ;DELETE THE FILE
JRST D60LP3 ;ERROR OF SOME KIND
> ;END OF IFN FTUUOS
IFN FTJSYS,<
HRRZ S1,D60OJN ;GET OUTPUT JFN
TXO S1,CO%NRJ ;DONT RELEASE THE JFN
CLOSF ;CLOSE THE JFN
ERJMP D60LP3 ;ERROR
HRRZ S1,D60OJN ;GET JFN AGAIN
TXO S1,DF%EXP ;EXPUNGE
DELF ;DELETE (AND EXPUNGE)
ERJMP D60LP3 ;ERROR
> ;END OF IFN FTJSYS
SKIPE MSGFIL
TELL OPR,[ASCIZ /![LPT... Log file deleted!]
/]
D60LF9:
IFN FTUUOS,<
CLOSE DSK, ;CLOSE THE OUTPUT FILE
MOVEI T1,D60LFO ;MARK THE FILE CLOSED
ANDCAM T1,D60FGS
STATZ DSK,742000 ;ANY LAST ERRORS?
JRST D60LPB ;YES, PRINT MESSAGE
RELEAS DSK,
>
IFN FTJSYS,<
HRRZ S1,D60OJN ;GET OUTPUT JFN
RLJFN ;RELEASE THE JFN
ERJMP D60LP3 ;ERROR
SETZM D60OJN ;NO MORE OUTPUT JFN
MOVEI T1,D60LFO ;MARK PRINTER FILE CLOSED
ANDCAM T1,D60FGS
> ;END OF IFN FTJSYS
SKIPLE D60LGC ;WAS THE FILE VERY SHORT?
JRST D60LF2 ;YES, JUST TYPE IT TO OPR.
SKIPE MSGFIL
TELL OPR,[ASCIZ /![LPT... Log file completed!]
/]
JRST D60LF1 ;END OF LOG FILE PROCESSING
;
;
; HERE IF THE FILE IS VERY SHORT (I.E., LESS THAN 200
; CHARACTERS). THIS IS PROBABLY NOT A LOG FILE BUT INSTEAD
; AN OPERATOR MESSAGE. TYPE IT FOR THE OPERATOR IF HE
; HAS SET HIS MESSAGE LEVEL APPROPRIATELY.
;
D60LF2: SETZ T1, ;APPEND A NULL AFTER LAST GRAPHIC
IDPB T1,D60LGQ ; TO STOP THE "TELLN" UUO.
SKIPN MSGJOB ;DOES OPR WANT OTHER SYSTEM'S MSGS?
JRST D60LF1 ;NO.
TELL OPR,[ASCIZ /![LPT... MESSAGE: !"/]
TELLN OPR,J$XHBF(J) ;PRESENT MESSAGE TO OPR
TELL OPR,[ASCIZ /!"!]
/]
;
; HERE AT THE END OF LOG FILE PROCESSING
;
D60LF1: MOVEI T1,1 ;WAIT A SHORT WHILE
MOVEM T1,D60DLY ; BEFORE SENDING ANOTHER JOB
SETZM D60OIC ;JUST IN CASE
POPJ P, ;RETURN.
;
;
; HERE TO HOLD THE FILE FOR LATER DISPOSITION BY THE USER.
; WE GIVE THE FILE A SPECIAL EXTENSION SO THE RETRIEVAL
; PROGRAM CAN FIND IT.
;
D60LF6:
IFN FTUUOS,<
MOVE T1,D60FLN ;GET RANDOM FILE NAME
MOVEM T1,J$DUUO+.RBNAM(J) ;BE SURE NO DUPLICATES
MOVSI T1,'D6R' ;SPECIAL EXTENSION FOR D60RTV
HLLM T1,J$DUUO+.RBEXT(J)
MOVE T1,D60LRN ;GET USER-SPECIFIED NAME
MOVEM T1,J$DUUO+.RBSPL(J) ;STORE FOR D60RTV
MOVE T1,D60LRU ;GET USER'S PPN
MOVEM T1,J$DUUO+.RBAUT(J) ;STORE AS AUTHOR
MOVEI T1,177 ;CHANGE PROTECTION
DPB T1,[POINT 8,J$DUUO+.RBPRV(J),7] ;TO KEEP USER'S EYES OFF
RENAME DSK,J$DUUO(J) ;CHANGE THE NAME AND PROTECTION
JRST D60LP3 ;ERROR
> ;END OF IFN FTUUOS
IFN FTJSYS,<
;
; WE HAVE NO RETRIEVAL PROGRAM UNDER TOPS-20 WITH GALAXY
; VERSION 3 (WAITING FOR FILE SPOOLER WITH VERSION 4)
; SO WE WILL RENAME THE FILE TO THE USER'S AREA.
;
MOVE T1,[POINT 7,D60JBF] ;POINTER TO JFN BUFFER
MOVEI T3,"["
IDPB T3,T1 ;STORE "["
MOVE S2,D60LRU ;GET DIRECTORY NUMBER
MOVE S1,T1 ;POINT TO BUFFER
DIRST ;STORE CORRESPONDING STRING
ERJMP D60LP3 ;ERROR (UNLIKELY)
MOVE T1,S1 ;GET UPDATED POINTER
MOVEI T3,"]" ;END USER'S NAME
IDPB T3,T1
MOVE T2,[POINT 7,[ASCIZ /LPT-IBM-/]] ;UNLIKELY NAME
D60LFG: ILDB T3,T2 ;COPY NAME TO BUFFER
JUMPE T3,D60LFH
IDPB T3,T1
JRST D60LFG
;
;
D60LFH: MOVE T2,[POINT 6,D60LRN] ;APPEND USER'S LOG FILE NAME
MOVEI T4,^D6
D60LFI: ILDB T3,T2 ;COPY NAME TO BUFFER
JUMPE T3,D60LFL ;SHORT NAME
ADDI T3,40 ;CONVERT TO ASCII
IDPB T3,T1
SOJG T4,D60LFI ;COPY UP TO SIX CHARACTERS
D60LFL: MOVEI T3,"-" ;DASH TO SEPARATE NEXT PART
IDPB T3,T1 ;PUT IN STRING
MOVE T2,[POINT 3,D60FLN] ;RANDOM NAME
MOVEI T4,^D12 ;COPY OUT AS 12 OCTAL DIGITS
D60LMN: ILDB T3,T2 ;GET OCTAL DIGIT
ADDI T3,"0" ;CONVERT TO PRINTABLE ASCII
IDPB T3,T1 ;APPEND TO STRING
SOJG T4,D60LMN ;GET ALL TWELVE CHARACTERS
MOVE T2,[POINT 7,[ASCIZ /.LOG/]] ;EXTENSION
D60LFJ: ILDB T3,T2 ;COPY END OF NEW NAME
JUMPE T3,D60LFK ;END OF STRING
IDPB T3,T1
JRST D60LFJ
;
;
; HERE WHEN THE NAME OF THE NEW FILE HAS BEEN BUILT.
;
D60LFK: SETZ T3, ;APPEND A NULL
IDPB T3,T1 ; TO END THE STRING
MOVX S1,GJ%SHT+GJ%FOU ;SHORT GTJFN, OUTPUT FILE
HRROI S2,D60JBF ;POINT TO JFN NAME BUFFER
GTJFN ;GET JFN FOR NEW FILE NAME
ERJMP D60LP3 ;ERROR
MOVX S2,<^D7>B5+OF%WR+OF%NWT ;WRITE ON FILE
OPENF ;OPEN OUTPUT FILE
ERJMP D60LP3 ;ERROR
MOVEI S2,^D7 ;SET FILE BYTE SIZE...
SFBSZ ; TO SEVEN
ERJMP D60LP3 ;ERROR
HRLM S1,D60OJN ;REMEMBER NEW JFN
HRRZ S1,D60OJN ;GET OLD JFN
TXO S1,CO%NRJ ;DONT RELEASE THE JFN
CLOSF ;CLOSE THE FILE
ERJMP D60LP3 ;ERROR
HLRZ S1,D60OJN ;GET NEW JFN
TXO S1,CO%NRJ ;DONT RELEASE THE JFN
CLOSF ;CLOSE THE FILE
ERJMP D60LP3 ;ERROR
HRRZ S1,D60OJN ;GET OLD JFN
HLRZ S2,D60OJN ; AND NEW JFN
RNAMF ;CHANGE NAMES (OLD BECOMES NEW)
ERJMP D60LP3 ;ERROR
HLRZ S1,D60OJN ;GET NEW JFN
RLJFN ;RELEASE IT
ERJMP D60LP3 ;ERROR
> ;END OF IFN FTJSYS
;
;
; HERE WHEN THE FILE HAS BEEN HELD FOR THE USER
;
MOVE T1,D60LRN ;GET NAME FROM "/LNAME:"
SKIPE MSGFIL
TELL OPR,[ASCIZ /![LPT... Log file !"+!" held for /]
MOVE T1,D60LRU ;GET PPN
SKIPE MSGFIL
PUSHJ P,TYPUID ;TYPE IT
SKIPE MSGFIL
TELL OPR,[ASCIZ / !]
/]
JRST D60LF9 ;FINISH UP AS FOR DELETE.
;
;
; HERE IF THE INPUT STREAM ENDED IN ABORT
;
D60LPE:
IFN FTUUOS,<
CLOSE DSK, ;CLOSE THE FILE
>
MOVEI T1,D60LFO ;MARK THE FILE CLOSED
TDNN T1,D60FGS ;UNLESS IT WASN'T OPEN
JRST D60LP2 ;NOT OPENED
ANDCAM T1,D60FGS
IFN FTUUOS,<
STATZ DSK,742000 ;ANY LAST ERRORS?
JRST D60LPB ;YES, LOSE.
RELEAS DSK,
>
IFN FTJSYS,<
HRRZ S1,D60OJN ;GET OUTPUT JFN
CLOSF ;CLOSE THE FILE
ERJMP D60LP3 ;ERROR
SETZM D60OJN ;NO MORE JFN
>
SKIPE MSGFIL
TELL OPR,[ASCIZ /![LPT... Log file suspended!]
/]
D60LP2: SETZM D60OIC ;JUST IN CASE
POPJ P, ;NO COMMAND TO PROCESS
;
;
; HERE IF WE HAD AN ERROR OPENING OR CLOSING THE FILE
;
D60LP3: SKIPE MSGERR
TELL OPR,[ASCIZ /!?LPT... Error opening or closing printer disk file
/]
D60LPC: SETZM D60OIC ;RENDER BUFFER EMPTY
MOVSI T1,(BYTE (8) ^D28)
PUSHJ P,D60WDC ;ABORT RECEPTION
PUSHJ P,D60ICL ;WAIT FOR COMPLETION
JFCL
POPJ P, ;NO COMMAND TO PROCESS
;
; HERE IF THERE IS A DISK DATA ERROR.
;
D60LP7:
IFN FTUUOS,<
CLOSE DSK, ;CLOSE THE FILE
>
MOVEI T1,D60LFO ;MARK THE FILE CLOSED
ANDCAM T1,D60FGS
IFN FTUUOS,<
RELEAS DSK,
>
IFN FTJSYS,<
HRRZ S1,D60OJN ;GET OUTPUT JFN
CLOSF ;CLOSE THE FILE
ERJMP .+1 ;IGNORE ANY ERRORS
SETZM D60OJN ;JFN IS GONE
>
JRST D60LPC ;ABORT INPUT AND EXIT
;
;
; THIS IS THE LOG FILE RECOGNIZER. ITS PURPOSE IS TO
; RECORD THE SWITCHES IN THE LOG FILE WHICH SPECIFY WHAT
; IS TO BE DONE WITH THE FILE.
;
; THE BASIC SEARCH CODE IS DATA DRIVEN USING D60LRP, D60LRW
; AND D60LRC. D60LRP IS A BYTE POINTER TO A SSEARCH STRING,
; D60LRW CONTAINS THE INITIALIZE VALUE OF THE BYTE POINTER
; AND THE DISPATCH ADDRESS, AND D60LRC CONTAINS A CONDITION TO TEST.
;
; THE RECOGNIZER CAN BE IN ANY ONE OF FOUR MODES:
; A -- SKIPPING TEXT LOOKING FOR A BLANK TO START A SWITCH
; B -- RECOGNIZING A SWITCH
; C -- PROCESSING SWITCH ARGUMENT(S)
; D -- IGNOREING THE REMAINDER OF THE LOG FILE
;
; IN MODE A, D60LRP IS ZERO AND D60LRC IS "CAIE C,BLANK".
;
; IN MODE B, D60LRP POINTS TO THE CURRENT POSITION IN THE
; STRING BEING RECOGNIZED, RH(D60LRW) IS THE START OF THE STRING
; AND LH(D60LRW) IS THE ADDRESS TO DISPATCH TO WHEN
; (AND IF) THE END OF THE STRING IS REACHED WITH A MATCH.
;
; IN MODE C, D60LRP IS ZERO, D60LRC IS "SKIPA" AND LH(D60LRW)
; POINTS TO THE ROUTINE TO PROCESS THE NEXT CHARACTER OF THE
; SWITCH ARGUMENT.
;
; IN MODE D, D60LRP IS ZERO AND D60LRC IS "JFCL".
;
;
; THIS IS THE RECOGNIZER DESCRIBED ABOVE.
; IT IS CALLED WITH C CONTAINING THE CHARACTER FROM THE LOG FILE.
;
D60LRG: CAIN C,15 ;CARRIAGE RETURN?
POPJ P, ;YES, WAIT FOR LINE FEED.
CAIL C,"A"+40 ;NO, LOWER CASE LETTER?
CAILE C,"Z"+40
SKIPA ;NO.
SUBI C,40 ;YES, CONVERT TO UPPER CASE.
SKIPE D60LRP ;ANY BYTE POINTER?
JRST D60LR1 ;YES, CHECK IT.
XCT D60LRC ;NO, IS CONDITION TRUE?
POPJ P, ;NO, DO NOTHING.
HRRZ T1,D60LRC ;ARE WE STARTING A SWITCH?
JUMPE T1,D60LR2 ;NO, JUST DISPATCH.
D60LQ7: HRRZ T1,D60LRW ;YES, SET UP BYTE POINTER
HRLI T1,(POINT 7,)
MOVEM T1,D60LRP ;TO DO THE MATCHING
POPJ P, ;WAIT FOR NEXT CHARACTER
;
; HERE ON ARG SCANNING OR A SWITCH NAME IS RECOGNIZED TO DISPATCH.
;
D60LR2: SKIPN T1,D60LRW ;IS THERE A DISPATCH ADDRESS?
POPJ P, ;NO, DO NOTHING.
HLRZS T1 ;YES, PUT IN LEFT HALF
JRST (T1) ; AND DISPATCH
;
; HERE TO MATCH THE NEXT CHARACTER OF THE STRING
;
D60LR1: ILDB T1,D60LRP ;GET NEXT CHARACTER OF STRING
JUMPE T1,D60LR2 ;END OF STRING, DISPATCH.
CAMN T1,C ;MATCH?
POPJ P, ;YES, WAIT FOR NEXT CHAR
JRST D60LQ7 ;NO, REWIND BYTE POINTER
;
; SUBROUTINE TO SET UP FOR THE NEXT SWITCH. SET RECOGNIZER TO
; MODE A AND ARRANGE TO GO TO MODE B AND C AT THE PROPER
; TIMES. T1 CONTAINS [XWD DISPATCH,[ASCIZ \SWITCH NAME\]]
;
D60LRI: MOVEM T1,D60LRW ;STORE DISPATCH AND STRING NAME
SETZM D60LRP ;SET TO MODE A
MOVE T1,[CAIE C," "]
MOVEM T1,D60LRC
POPJ P,
;
;
; HERE WHEN "/PNAME:" IS RECOGNIZED. THIS IS THE FIRST SWITCH.
;
D60LR3: MOVSI T1,(SKIPA) ;SET RECOGNIZER TO MODE C
MOVEM T1,D60LRC
SETZM D60LRP
SETZM D60LRU ;CLEAR NAME FIELD
MOVE T1,[XWD D60LRU,D60LRU+1]
BLT T1,D60LRU+7
MOVE T1,[POINT 7,D60LRU]
MOVEM T1,D60LRS ;SET UP BYTE POINTER
MOVEI T1,^D39 ;MAX LENGTH...
MOVEM T1,D60LRL ; IS 39 CHARACTERS
JSP T1,D60LRR ;SET DISPATCH ADDRESS FOR NEXT CHARACTER
;
;
; PARSE PROGRAMMER NAME, TOPS-10 STYLE.
;
IFN FTUUOS,<
;
; HERE ON THE NEXT CHARACTER AFTER "/PNAME:" AND EACH
; SUBSEQUENT CHARACTER UP TO AND INCLUDING THE COMMA.
;
PUSHJ P,D60LRO ;TEST FOR OCTAL DIGIT
JRST D60LR8 ;NOT OCTAL, CHECK COMMA
HLRZ T1,D60LRU ;GET PROJECT NO.
LSH T1,3 ;MULTIPLY BY 8
ADDI T1,-"0"(C) ;ADD IN ITS DIGIT
TLNE T1,-1 ;OVERFLOW IN 18-BIT ARITHMETIC?
JRST D60LRF ;YES, FAILURE.
HRLM T1,D60LRU ;NO, STORE NEW PROJECT NUMBER
POPJ P, ;WAIT FOR NEXT CHARACTER
;
; HERE IF THIS IS NOT AN OCTAL DIGIT
;
D60LR8: CAIE C,"," ;COMMA?
JRST D60LRF ;NO, FAIL.
MOVEI T1,D60LQ2 ;SET DISPATCH ADDRESS
HRLOM T1,D60LRW ; FOR NEXT DIGIT
POPJ P, ;WAIT FOR THAT DIGIT
;
; HERE TO ABSORB THE PROGRAMMER NUMBER
;
D60LQ2: PUSHJ P,D60LRO ;OCTAL NUMBER?
JRST D60LR9 ;NO, PERHAPS END.
HRRZ T1,D60LRU ;YES, GET PROGRAMMER NUMBER
LSH T1,3 ;MULTIPLY BY 8
ADDI T1,-"0"(C) ;ADD IN NEW DIGIT
TLNE T1,-1 ;OVERFLOW IN 18-BIT ARITHMETIC?
JRST D60LRF ;YES, INVALID.
HRRM T1,D60LRU ;STORE NEW PROGRAMMER NUMBER
POPJ P, ;COME BACK ON NEXT CHAR
;
; HERE ON A NON-OCTAL DIGIT.
;
D60LR9: PUSHJ P,D60LRA ;ALPHANUMERIC?
SKIPA ;NO, THAT'S GOOD
JRST D60LRF ;YES, LOSE.
HRRZ T1,D60LRU ;NO, GET PROGRAMMER NUMBER
JUMPE T1,D60LRF ;MUST NOT BE ZERO
HLRE T1,D60LRU ;GET PROJECT NUMBER
JUMPLE T1,D60LRF ;MUST NOT BE NEGATIVE OR ZERO
> ;END OF IFN FTUUOS
;
;
; HERE TO PARSE PROGRAMMER NAME, TOPS-20 STYLE.
;
IFN FTJSYS,<
CAIE C,12 ;AT END OF LINE?
CAIN C," " ;OR ENDING WITH A BLANK?
JRST D60LR8 ;YES, END OF NAME.
IDPB C,D60LRS ;NO, STORE IN STRING
SOSLE D60LRL ;FILLED NAME?
POPJ P, ;NO, WAIT FOR NEXT CHARACTER
D60LR8: MOVX S1,RC%EMO ;YES, SUPPRESS RECOGNITION
HRROI S2,D60LRU ;POINT TO STORED NAME
RCUSR ;CONVERT USER NAME TO DIRECTORY NUMBER
ERJMP D60LRF ;ERROR, FILE IS UNKNOWN.
TXNE S1,RC%NOM!RC%AMB ;IS NAME NON-EXISTENT OR AMBIGUOUS?
JRST D60LRF ;YES, FILE IS UNKNOWN.
MOVEM T1,D60LRU ;STORE AS "PPN" FOR LATER PROCESSING
> ;END OF IFN FTJSYS
;
; HERE WHEN THE PROGRAMMER'S NAME HAS BEEN SCANNED. NOW LOOK
; FOR THE LOG FILE NAME.
;
MOVE T1,[XWD D60LR5,[ASCIZ \/LNAME:\]]
PJRST D60LRI ;GO TO MODE A FOR NEXT SWITCH
;
;
; HERE ON RECOGNITION OF "/LNAME:"
;
D60LR5: MOVSI T1,(SKIPA) ;SET RECOGNIZER TO MODE C
MOVEM T1,D60LRC
SETZM D60LRP
MOVE T1,[POINT 6,D60LRN]
MOVEM T1,D60LRS ;SET UP BYTE POINTER
SETZM D60LRN ;MAKE NAME FIELD INITIALLY BLANK
MOVEI T1,6
MOVEM T1,D60LRL ;SET UP COUNT
JSP T1,D60LRR ;RETURN HERE FOR NEXT CHARACTER
;
; HERE TO SCAN THE NAME GIVEN AS ARGUMENT TO "/LNAME:"
;
PUSHJ P,D60LRA ;IS CHARACTER ALPHANUMERIC?
JRST D60LR6 ;NO, WE ARE DONE.
SUBI C,40 ;YES, CONVERT TO SIXBIT
IDPB C,D60LRS ;ACCUMULATE NAME
SOSLE D60LRL ;ACCUMULATED ENOUGH?
POPJ P, ;NO, WAIT FOR NEXT CHARACTER
D60LR6: MOVE T1,[XWD D60LR7,[ASCIZ \/LDISP:\]]
PJRST D60LRI ;YES, MODE A FOR NEXT SWITCH
;
;
; HERE ON RECOGNITION OF THE "/LDISP:" SWITCH.
;
D60LR7: MOVSI T1,(SKIPA) ;SET TO MODE C
MOVEM T1,D60LRC
SETZM D60LRP
MOVE T1,[POINT 6,D60LRD]
MOVEM T1,D60LRS ;SET UP BYTE POINTER
MOVEI T1,6 ;SET UP CHAR COUNT
MOVEM T1,D60LRL
SETZM D60LRD ;INITIALIZE NAME TO BLANKS
JSP T1,D60LRR ;RETURN HERE ON NEXT CHARACTER
;
; HERE WITH EACH CHARACTER OF DISPOSITION
;
PUSHJ P,D60LRA ;IS CHARACTER ALPHANUMERIC?
JRST D60LQ1 ;NO, MUST BE END.
SUBI C,40 ;MAKE CHAR INTO SIXBIT
IDPB C,D60LRS ;ACCUMULATE KEY WORD
SOSLE D60LRL ;ACCUMULATED ENOUGH?
POPJ P, ;NO, WAIT FOR NEXT CHARACTER
D60LQ1: MOVE T1,D60LRD ;GET NAME ACCUMULATED
SETZ C, ;SET C TO CODE FOR DISPOSITION
CAMN T1,[SIXBIT /PRINT/]
MOVEI C,1
CAMN T1,[SIXBIT /DELETE/]
MOVEI C,2
CAMN T1,[SIXBIT /HOLD/]
MOVEI C,3
JUMPE C,D60LRF ;IF NONE OF THESE, INVALID.
MOVEM C,D60LRD ;OTHERWISE STORE CODE.
;
; HERE WHEN THE STRING HAS BEEN VERIFIED
;
D60LQ4: MOVE T1,[XWD D60LQ6,[ASCIZ \/ENDLI\]]
PJRST D60LRI ;NEXT RECOGNIZE TERMINATION SWITCH
;
;
; HERE ON RECOGNITION OF "/ENDLI"
;
D60LQ6: MOVEI T1,D60LRE ;FLAG LOG PARMS RECOGNIZED
IORM T1,D60FGS
;
; HERE TO CEASE SCANNING THE LOG FILE, EITHER BECAUSE OF
; A SYNTAX ERROR OR BECAUSE OF COMPLETE RECOGNITION
; OF THE LOG FILE PARMS.
;
D60LRF: SETZM D60LRP ;SET TO MODE D
MOVSI T1,(JFCL)
MOVEM T1,D60LRC
POPJ P, ;ALL DONE.
;
;
; SUBROUTINE TO TEST A CHARACTER FOR ALPHANUMERIC
;
D60LRA: CAIL C,"A" ;IS CHARACTER ALPHABETIC?
CAILE C,"Z"
SKIPA ;NO, CHECK FOR NUMERIC
JRST D60LR4 ;YES, SKIP RETURN.
CAIL C,"0" ;IS CHARACTER NUMERIC?
CAILE C,"9"
SKIPA ;NO, NOT ALPHANUMERIC
D60LR4: AOS (P) ;IS ALPHANUMERIC
POPJ P, ;RETURN.
;
IFN FTUUOS,<
; SUBROUTINE TO TEST A CHARACTER FOR BEING AN OCT