.MCALL .MODULE .MODULE SPINIT,VERSION=11,COMMENT= ; Copyright (c) 1998 by Mentec, Inc., Nashua, NH. ; All rights reserved ; ; This software is furnished under a license for use only on a ; single computer system and may be copied only 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 except for use on such ; system and to one who agrees to these license terms. Title ; to and ownership of the software shall at all times remain ; in Mentec, Inc. ; ; The information in this document is subject to change without ; notice and should not be construed as a commitment by Digital ; Equipment Corporation, or Mentec, Inc. ; ; Digital and Mentec assume no responsibility for the use or ; reliability of its software on equipment which is not supplied ; by Digital or Mentec, and listed in the Software Product ; Description. .ENABL LC .NLIST BEX CND ; ------------------------------------------------------------- ; SPINIT performs initialization for the SPOOL Utility ; ------------------------------------------------------------- .SBTTL Edit History ; ------------------------------------------------------------- ; Author: Greg Adams ; 28-APR-80 GA CKSIZ doesn't correctly size work file. ; 23-AUG-80 GA Create work file if not found. ; 25-AUG-83 GA Update for RT-11 V5.1 ; 07-NOV-83 GA Modify to facilitate virtual overlaying. ; 18-SEP-87 RHH Modify to be conditionally built as virtual job ; 30-Jun-88 RHH V5.5 Multi-stream support ; 02-Dec-88 RHH Replace ..SPSO patch ; 07-Jan-89 RHH Make streams into device queues ; 01-Nov-1990 JFW bracket error messages with ;+/;ERROR/.../;- ; 27-Jul-1998 TDS 011 4-digit years for RT-11 5.7 ; ------------------------------------------------------------- .SBTTL Conditionals ;+ ;COND ; V$JOB (0) REL job ; 1 SAV (virtual) job ; ; SP$MLS (=V$JOB) stream(s) ; 0 1 stream ; 1 multiple streams ; ; SP$PPS (=V$JOB) PRO print screen function ; 0 no PRO print screen ; 1 PRO print screen ; ; SP$DBG (0) no special debug code ; 1 special debug code ;- .IIF NDF V$JOB V$JOB =: 0 ; Build REL version by default SP$PPS =: V$JOB ; Print-screen support SP$MLS =: V$JOB ; Multi-stream support .IIF NDF SP$DBG SP$DBG =: 0 ; Debugging code .SBTTL Macros and other definitions .MCALL .CSTAT, .CLOSE, .DSTAT, .ENTER, .EXIT, .GVAL .MCALL .LOCK, .LOOKUP,.SERR, .HERR, .PEEK, .POKE, .PVAL .MCALL .PRINT, .PROTEC,.PURGE, .QSET, .RCTRLO,.SETTOP .MCALL .SCCA, .SPFUN, .UNLOCK,.WRITW .IF NE V$JOB .MCALL .CRRG, .CRAW, .RDBBK, .RDBDF, .WDBBK .ENDC; NE V$JOB .MCALL .ASSUME, .BR .IIF EQ V$JOB .MCALL SOB ; Number of output devices supported: .IF EQ SP$MLS NUMDEV ==: 1 ; Single Stream SPOOLer .IFF; EQ SP$MLS NUMDEV ==: 8. ; This many output devices .ENDC; EQ SP$MLS .MACRO ...... .ENDM .SBTTL Channel assignments SPCHAN ==: NUMDEV ; Channel for workfile PICHAN ==: NUMDEV+1 ; Channel for PI I/O WINOFF =: 0 ; Offset into region to start window. R.SHAR =: 4 ; Region is sharable .SBTTL Number of Queue Elements NQELEM ==: NUMDEV+1 ; Allocate separate Q-elements ; for every output device, and ; one for the workfile and MRKT's. ; PIX uses one of the unused printer ; queue elements. ; IF NQELEM IS CHANGED HERE, CHANGE ; IT IN SPOOL.MAC ALSO. .SBTTL Global Variables, Offsets and Bits .IF EQ SP$MLS $BUSY ==: 100000 ; Device is busy. $CRPND ==: 040000 ; Completion processing due device. $HOLD ==: 020000 ; Output is to be held. $NEXT ==: 010000 ; Move the the start of next file. $LAST ==: 004000 ; Move to the beginning of last file. $KILL ==: 002000 ; Kill all output to the device. $PSPND ==: 001000 ; Print screen pending on unit. .SBTTL SDCTAB offsets SDCESZ ==: 000020 ; 16 bytes per SDCTAB entry D.STAT ==: 000002 ; Offset to SDCTAB device status B.USED ==: 000004 ; Offset to SDCTAB used blocks count B.HEAD ==: 000006 ; Offset to SDCTAB header block (var) B.TAIL ==: 000010 ; Offset to SDCTAB tailer block (var) B.BEG ==: 000012 ; Offset to SDCTAB begin block (con) B.END ==: 000014 ; Offset to SDCTAB end block (con) D.BLK ==: 000016 ; Offset to SDCTAB output block number .ENDC; EQ SP$MLS .SBTTL Monitor offsets and definitions $UFLOA ==: 46 ; USR SWAP location $ERRBY ==: 000052 ; Error byte $SYPTR ==: 000054 ; Pointer to monitor base $CNFG1 =: 000300 ; Offset to config word 1 USWAP$ =: 001000 ; USR swap bit in config word 1 $CNTXT =: 000320 ; Offset to job's impure area pointer VLOAD$ =: 040000 ; Virtual job wants IOT cntxt-switched $CNFG2 =: 370 ; second configuration word BUS$ =: 000100 PROS$ =: 020000 BUS$M =: BUS$!PROS$ ; Mask for type bits BUS$X =: BUS$!PROS$ ; Strange (busless) KXJ BUS$C =: PROS$ ; CTI bus BUS$Q =: BUS$ ; QBUS BUS$U =: 0 ; UNIBUS $SYSGE =: 000372 ; Offset to RT-11 SYSGEN MMGT$ =: 000002 ; XM bit in SYSGEN $SPSTA ==: 000414 ; Spooler status word fixed offset .SBTTL SP communication area offsets T$VEC =: 020 ; IOT vector address. PR7 =: 340 ; Priority 7 mask. SP$VEC ==: 000110 ; Spooler vector address SP.CSW ==: -46 ; CSW adrs of I/O request ;001 SP.DAT ==: -44 ; ASCII date offset ;001 SP.TIM ==: -30 ; ASCII time offset SP.FNR ==: -20 ; File name offset from SPINT: SP.BNR ==: -12 ; Block number offset from SPINT: SP.DEV ==: -7 ; Device number offset from SPINT: SP.WCR ==: -6 ; Word count offset from SPINT: SP.BPR ==: -4 ; Buffer pointer offset from SPINT: .SBTTL Miscellaneous Bit Definitions RONLY$ =: 100 ; READ_ONLY device FILST$ =: 200 ; FILE_STRUCTURED device DS.ATT =: 1 ; .DSTAT block offsets DS.ADR =: 4 CS.UNT =: 10 ; .CSTAT offsets CS.NAM =: 12 SP.DVC =: 55 ; SP's device code .SBTTL $SPSTA Bit Diagram ; Spooler status word ($SPSTA) bit definition. ; ; |15|14|13|12|11|10|09|08|07|06|05|04|03|02|01|00| ; $SPSTA=> | | | | | | | | | | | | | | | | | ; ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ; Error detected | | | | | \ | / | | | | | \ | / ; set by SPOOL ---' | | | | \|/ | | | | | \|/ ; | | | | | | | | | | `- Unit number for ; Pseudo interrupt | | | | | | | | | | SET commands. ; request -----------' | | | | | | | | | ; | | | | | | | | `----- Move to next file ; Date/time request ----' | | | | | | | ; | | | | | | `----- Put output on hold. ; Print screen ------------' | | | | | ; | | | | `--- Stop holding output. ; Show spooler status --------' | | | ; | | `--- Kill all output. ; Override default flag pages ------' | ; (000 = no overide) `--- Spooler active (set by SPOOL) ; (111 = override with 0 flag pages) ; ; $SPSTA bit definitions NEXT ==: 000010 ; Move to start of next file. OFF ==: 000020 ; Set spooler unit off. ON ==: 000040 ; Set spooler unit on. KILL ==: 000100 ; Set kill device output. ACTIVE ==: 000200 ; Spooler is active. SHOW ==: 004000 ; Show status of spooler. PRTSCR ==: 010000 ; Print screen (PC 300 only). DATIME ==: 020000 ; Date and time request. INTEN ==: 040000 ; Fake interrupt enable. ERROR ==: 100000 ; Error bit (set by SPOOL). ; Special $SPSTA Bit Combinations SP$MSK ==: ON+OFF+NEXT+KILL ; Special Op Bit Mask AB$ORT ==: ON+OFF ; ABORT flag EX$IT ==: ON+OFF+KILL ; EXIT combination UP$OON ==: ON+OFF+ERROR ; SPOOL is starting up ACTION ==: 177777-INTEN-ERROR-ACTIVE ; Most $SPSTA bits .IF NE SP$MLS .SBTTL Spool STREAM TABLE offsets ST.STA ==: 0 ; Stream Status Word STA.CL ==: 001 ; Stream has been closed STA.DN ==: 002 ; Stream output has completed STA.EP ==: 004 ; .ENTER initiated STA.BS ==: 010 ; Stream is now being output STA.E2 ==: 020 ; .ENTER block-0 has been output ; and stream is now active STA.AP ==: 040 ; Appended stream STA.KL ==: 100 ; Stream has been killed ST.DTE ==: 2 ; Current Device Table Entry (byte) ST.JOB ==: 3 ; Job associated with stream (byte) ST.ID ==: 4 ; Identifier (CSW Address) ST.WFB ==: 6 ; First WF block ST.LWB ==: 10 ; Last WF block written ST.NXO ==: 12 ; Next WF block for output ST.NST ==: 14 ; Pointer to next entry ST.ESZ ==: 16 ; Stream table entry size .SBTTL Spool OUTPUT DEVICE TABLE offsets OT.STA ==: 0 ; Device status byte OTPND ==: 001 ; Completion pending OTBSY ==: 002 ; Device is in use OTNXT ==: 004 ; SET SPn NEXT in effect OTKIL ==: 010 ; SET SPn KILL in effect OTOFF ==: 020 ; SET SPn WAIT in effect OTPRM ==: 040 ; Device is primed OT.CHA ==: 1 ; Device channel number (byte) OT.CST ==: 2 ; Current stream entry address ;OT.PEN ==: 3 ; No. of pending streams OT.DEV ==: 4 ; Device name OT.ESZ ==: 6 ; Output device table entry size NUMSTR ==: 8. ; Number of streams possible NUMODV ==: 8. ; Number of output devices possible STRMSK ==: 7 ; Stream number mask .SBTTL Workfile map bits WM.BK0 ==: 200 ; Block-zero flag WM.SMK ==: 37 ; stream mask .ENDC; NE SP$MLS .SBTTL **** Impure Data **** .IF NE V$JOB .PSECT .IMPD.,D .IFF; NE V$JOB .PSECT .IMPD.,D,GBL,REL,CON .ENDC; NE V$JOB .IF EQ SP$MLS SDCTAB::.BLKB SDCESZ ; Allocate control table .ENDC; EQ SP$MLS .SBTTL Workfile Specifications ; Normally, the spooler work file is SY:SPOOL.SYS. The user ; may change the following specification if he requires the work ; file to be on an alternate device or under a different name. ; Note that the work file is considered to be a system file and ; hence, is subject to the same restrictions (i.e. cannot be moved ; in a squeeze operation, etc.) .IF NE SP$MLS WFMAX =: 8192. ; Maximum workfile size SOUNIT: .WORD 0 ; SO unit number .ENDC; NE SP$MLS ..SWFL:: SPLFIL: .RAD50 /SFDSPOOL SYS/ ; Define spooler work file. ..SPSZ:: WFSIZE: .WORD 1000. ; Size of work file (working) .IF NE SP$PPS PI: .RAD50 /PI / ; Define the Pro Interface. .ENDC; NE SP$PPS AREA:: .WORD 0,0,0,0,0,0 ; EMT request block. OUTBEN::.WORD 0 ; end of SPFBUF SPFBFA::.WORD 0 ; address of SPFBUF .IF EQ V$JOB OUTBUF::.LIMIT ; Output buffer is here + 2. .IFF; EQ V$JOB OUTBUF::.WORD 0 ; SPFBUF is in SPX .WORD 0 ; needed? .SBTTL SPX Shared Region Information ; Equates that relate to XM's SP sharable high memory region. BLK =: 1000 ; one block's address space SPPAR =: 3 ; PAR (must be above /V ovlys) SPHIBF ==: ; corresponding virtual address COMSIZ ==: 32.*2 ; comm area size SP$COM ==: SPHIBF+<1*BLK> ; Start of SPOOL COMM area SP$HTM ==: SP$COM+COMSIZ ; High-memory time string BCHNKS =: 256./32.+2 ; Shared area expressed in 32. word ; chunks. The 256 words are the ; forwarding buffer, the next 32 words ; are for communication variables, ; and final 32 words are static ; high memory variables (all located ; in SPX). ; SPRADR: .RDBBK BCHNKS, R.SHAR, ; SPFBUF IN SPX ; Define Region Definition Block in-line because the RDBBK macro won't ; handle blanks in the region name. .RDBDF SPRADR: .WORD 0 ; R.GID .WORD BCHNKS ; R.GSIZ .WORD ; R.GSTS .RAD50 /SP $ / ; GR.NAM - SPFBUF IN SPX SPWADR: .WDBBK SPPAR, BCHNKS, 0, WINOFF, BCHNKS, SPWRID = SPWADR+W.NRID ; Address of region ID word. .IF NE SP$MLS ; SPOOL's workfile map ; Define region definition block in-line because R.GSIZ must be calculated ; based on the value of WFSIZE. (The customer can patch WFSIZE) ; SPWFRG: .RDBBK WFSCHK, RS.EXI, ; SPOOL Workfile Map SPWPAR = SPPAR+1 ; Next available PAR WFMADR = SPWPAR*20000 ; Effective workfile map virtual adrs SPWFRG: .WORD 0 ; R.GID WFSCHK: .WORD 0 ; R.GSIZ - (loaded by code) .WORD ; R.GSTS .RAD50 /SPWFM$/ ; GR.NAM ; Window Definition Block for SPOOL workfile map SPWFWD: ; .WDBBK SPWPAR, WFSCH1, , , , .BYTE 0 ; W.NID .BYTE SPWPAR ; W.NAPR .WORD 0 ; W.NBAS WFSCH1: .WORD 0 ; W.NSIZ - (loaded by code) SPWFID: .WORD 0 ; W.NRID .WORD 0 ; W.NOFF .WORD 0 ; W.NLEN .WORD WS.MAP ; W.NSTS .ENDC; NE SP$MLS .ENDC; EQ V$JOB .SBTTL More Impure data .PSECT .IMPD.,D PSBUF:: .WORD 0 ; Location of print screen buffer. DEVBUF::.WORD 0 ; Location of output buffer. CCAFLG::.WORD 0 ; SCCA flag .IF NE V$JOB .SBTTL Data and buffers for Virtual Job version of SPOOL SPCSRV::.WORD 0 ; Local copy of $SPSTA (RMON's SPOOL Fxd Ofst) SPCSR:: .WORD SPCSRV ; Pointer to local copy of SPOOL ctrl word OURBUF::.BLKW 256.*NUMDEV ; Local one-block data buffer .IF NE SP$PPS ; If PRO PRINT_SCREEN support, PROBUF::.BLKB 288. ; Local PRO-buffer .ENDC; NE SP$PPS .IFF; NE V$JOB .SBTTL Data for FB version of SPOOL SPCSR:: .WORD 0 ; Pointer to spooler control word. .ENDC; NE V$JOB .IF NE SP$PPS PRO:: .WORD -1 ; Assume this is a Professional 300. .ENDC; NE SP$PPS .IF NE SP$DBG .PSECT .TEXT.,D msg1: .asciz /DEVBUF initialized/ msg4: .asciz /WORKFILE setup/ msg7: .asciz /SPINIT complete/ .even .ENDC; NE SP$DBG .IF NE SP$MLS .PSECT .IMPD.,D .SBTTL Stream table, Output Device Table, and Workfile Map STRTAB::.BLKB ; Stream Table .EVEN ODVTAB::.BLKB ; Output Device Table .EVEN ORING:: .BLKB NUMODV ; Output processor ring buffer RINGMX ==: .-2 .EVEN OIRING::.WORD ORING ; Input pointer to ORING OORING::.WORD ORING ; Output pointer to ORING WFMAPA::.WORD 0 ; Points to WFMAP WFMAPL::.WORD 0 ; Points just beyond WFMAP .ENDC; NE SP$MLS .SBTTL SPINIT - Entry point .PSECT .CODE.,I .ENABL LSB SPINIT:: .LOCK ; Don't let BG do I/Os to SP... MOV #AREA,R2 ; R2 => EMT request block (always). .PVAL R2,#$SPSTA,#UP$OON ; SPOOL INACTIVE during startup .RCTRLO ; Just in case we need to report an error. .SCCA R2,#CCAFLG ; Trap CTRL/C's - (detect in SPTASK) .QSET #QEROOM,#NQELEM ; Allocate more queue elements. .IF EQ V$JOB ; This code is included in the FB (.REL) version of SPOOL .GVAL R2,#$CNFG1 ; Get configuration word 1. BIT #USWAP$,R0 ; Is the USR swapping? BNE 10$ ; No, then we can use it. ;+ ;ERROR MOV #NOUSR,R0 ; Cannot start with a swapping USR. ;- JMP NOGOOD ...... 10$: .GVAL R2,#$SYSGE ; Is this XM monitor? BIT #MMGT$,R0 BEQ GETMEM ; If not, then carry on. ;+ ;ERROR MOV #USEVJ,R0 ; Tell user to use VIRTUAL version ;- JMP NOGOOD ...... ; ----- Get more memory from the work area ------------------------ GETMEM: MOV #SPOOL,@#$UFLOA ; Let USR swap over root (is this ok?) MOV OUTBUF+2,R1 ; R1 -> start of output buffers. ADD #,R1 ; R1 -> Highest location we require. .SETTOP R1 ; Ask for it. SUB #2,R1 ; Round down to the next lower word. CMP R0,R1 ; Did we get it? BHIS 30$ ; Yes, then all ok. ;+ ;ERROR MOV #NOMEM,R0 ; No, then report and exit. ;- JMP NOGOOD ...... 30$: MOV OUTBUF+2,DEVBUF ; Inform that we will use above us. MOV #SPFBUF,R0 ; point to SPFBUF .IFF; EQ V$JOB .DSABL LSB ; This code is included in the VIRTUAL JOB (.SAV) version of SPOOL). ; Use an unused PAR to map to the high-memory SPFBUF and some communication ; variables, residing in the high memory part of SPX.SYS. .ENABL LSB .CRRG R2,#SPRADR ; Allocate region in extended memory. BCC 10$ ; Did we get it? ;+ ;ERROR MOV #NOXMEM,R0 ; No, report the fact ;- JMP NOGOOD ; Abort exit. ...... 10$: MOV SPRADR,SPWRID ; Map the region to our window. .CRAW R2,#SPWADR ; Create the window. BCC 20$ ; Did it map up? ;+ ;ERROR MOV #CANTMAP,R0 ; Nope, then we have problems. ;- JMP NOGOOD ; Abort exit. ...... 20$: MOV #OURBUF,DEVBUF ; local buffer .IF NE SP$PPS MOV #PROBUF,PSBUF ; PRO print-screen buffer .ENDC; NE SP$PPS MOV #SPHIBF,R0 ; address of high forwarding buffer .ENDC; EQ V$JOB ; ----- Common code for both FB and XM versions --------------------------- MOV R0,SPFBFA ; Set buffer address variable MOV R0,OUTBUF ; Initialize pointer variable ADD #1000,R0 ; point 1 block past buffer, MOV R0,OUTBEN ; Set buffer limit check value .IF NE SP$MLS MOV #,R2 MOV #STRTAB,R0 ; point to STREAM TABLE 30$: CLRB (R0)+ ; clear it. SOB R2,30$ MOV #,R2 MOV #ODVTAB,R0 ; point to DEVICE TABLE 40$: CLRB (R0)+ ; clear it. SOB R2,40$ .ENDC; NE SP$MLS MOV #AREA,R2 ; -> EMT area .BR SFLOOK ; fall through .DSABL LSB .SBTTL Set up the spooler workfile .ENABL LSB SFLOOK: .DSTAT R2,#SPLFIL ; Is the device in the system? BCC 10$ ; Yes, then go look it up. MOV #<^RSY>,SPLFIL ; No, then lets try SY:. BR SFLOOK ; SY: cannot fail (right?). ...... 10$: TST 4(R2) ; Is the handler loaded? BNE 20$ MOV #NOSFHN,R0 ; Nope, tisk tisk! BR 40$ ...... ; Try to find an existing workfile 20$: .PURGE #SPCHAN ; Clear out the channel (never hurts). .SERR .LOOKUP R2,#SPCHAN,#SPLFIL ; Lookup the spooler work file. BCC 50$ ; Found ok? TSTB @#$ERRBY ; System error? BPL 30$ ; Branch if not. ;+ ;ERROR .PRINT #DIOERR ; ?SPOOL-F-Dir I/O error ;- MOV #SPLFIL,R0 ; address of RAD50 name CLR 2(R0) ; eliminate workfilename from msg MOV #DIOER1,R1 ; point to ASCII message area CALL $FNASC ; convert RAD50 to ASCII MOV #DIOER1,R0 ; show the errant device name BR 40$ ...... ; Workfile does not presently exist. Create a new workfile. 30$: .IF NE SP$MLS CMP WFSIZE,#WFMAX ; workfile specified too big? BLOS 32$ MOV #INVWFS,R0 ; Invalid workfile size BR 40$ ...... 32$: .ENDC; NE SP$MLS .ENTER R2,#SPCHAN,#SPLFIL,WFSIZE ; Nope, then create it. BCC 60$ ; Could we enter it? ; User-specified workfile size failed. Try for whatever we can get. .ENTER R2,#SPCHAN,#SPLFIL,#-1 ; Try for a file as big as we can get. BCC 50$ ;+ ;ERROR MOV #NOSFIL,R0 ; Say ".ENTER failed" and abort. ;- 40$: JMP NOGOOD ...... 50$: CMP R0,#10. ; less than 10 is unreasonable. BLO 80$ ; Its too small...take abort exit. MOV R0,WFSIZE ; Use it. 60$: .HERR ; Fall through to the next block. ; .PRINT #MSG4 ; ----- Verify that the work file is big enough ---------------- 70$: MOV WFSIZE,R1 DEC R1 ; Convert no. of blocks to block number .WRITW R2,#SPCHAN,#SPINIT,#256.,R1 ; Try to write highest BCC 90$ ; Carry on if successful. 80$: MOV #TOOSMA,R0 ; Must be using floppies! BR 40$ ; Abort exit. ...... ; Inform data structure of workfile size 90$: .IF EQ SP$MLS MOV R1,LWFBLK ; Last workfile block .IFF; EQ SP$MLS MOV WFSIZE,R0 ; workfile size in blocks (bytes) ADD #63.,R0 ; round up for chunk calculation .REPT 6 ASR R0 ; divide by 64 bytes to get chunks .ENDR MOV R0,WFSCHK ; store region size in R. Def. Blk MOV R0,WFSCH1 ; store region size in W. Def. Blk .CRRG R2,#SPWFRG ; Allocate region in extended memory. BCC 95$ ; Did we get it? MOV #NOWFMR,R0 ; No, report the fact BR 96$ ; Abort exit. ...... 95$: MOV SPWFRG,SPWFID ; Map the region to our window. .CRAW R2,#SPWFWD ; Create the window. BCC 97$ ; Did it map up? ;+ ;ERROR MOV #NOWFMW,R0 ; Nope, then we have problems. ;- 96$: JMP NOGOOD ; Abort exit. ...... 97$: MOV #WFMADR,R0 ; workfile map address MOV R0,WFMAPA ; store it ADD WFSIZE,R0 ; find WFMAP boundary MOV R0,WFMAPL ; just beyond WFMAP ; Clear the workfile map 100$: CMP R0,WFMAPA ; beyond WFMAP? BLOS 110$ CLRB -(R0) ; clear it. BR 100$ ...... 110$: .ENDC; EQ SP$MLS .BR DEVLK ; Fall through. .DSABL LSB .SBTTL Lookup Printer Devices ; ; Do .DSTAT of device ; If (exists && NOT random access && loaded) ; Do .LOOKUP on it ; Call REALDV to get physical name ; If (name not found in table) then ; { ; add 1 to number of devices ; store name in table ; } .PSECT .PURE.,D ; Spool output device list ..SPND:: MAXDEV: .WORD NUMDEV ; Max no. of devices in VJOB ..SPDL:: DEVLST: .RAD50 /SO0/ .IF NE SP$MLS .RAD50 /SO1/ /SO2/ /SO3/ /SO4/ /SO5/ /SO6/ /SO7/ .ENDC; NE SP$MLS ..SPSO:: PHYLST: .RAD50 /LP0/ /LS0/ .WORD 0 ; table terminator .PSECT .IMPD.,D DEVNAM: .WORD 0 ; RAD50 Device name for messages .WORD 0 ; non-filename terminator ; Printer device DBLK - the next four words must remain together DEVSPC: .WORD 0 ; .LOOKUP DBLK DEVFSP: .RAD50 / / ; filename .RAD50 / / ; extension PHYFLG: .WORD 0 ; PHYSICAL flag LOKBLK: .BYTE 0,1 ; LOOKUP arg block .WORD DEVSPC .WORD 0 ; -1 .WORD 0 .WORD 0 ; "user" routine ptr, PHYS indicator CSDATA: .BLKW 6 ; .CSTAT area DEVBLK: .BLKW 4 ; .DSTAT area .IF EQ SP$MLS PHYNAM::.BLKB 4 ; Physical Device Name of printer LWFBLK: .WORD 0 ; Last workfile block .ENDC; EQ SP$MLS .EVEN .SBTTL DEVLK - Lookup Printer Devices .PSECT .CODE.,I ;+ ; Lookup printer devices. Check to make sure that they are appropriate ; for sequential text output, and that their handlers are loaded. ;- .ENABL LSB DEVLK: .IF NE SP$MLS MOV #ODVTAB,R4 ; Point to output device table .IFF; NE SP$MLS MOV #SDCTAB,R4 ; Point to SPOOL device control table .ENDC; NE SP$MLS MOV #DEVLST,R5 ; Point to device list CLRB LOKBLK ; starting channel = 0 MOV #DEVSPC,LOKBLK+2 ; "user" routine indicator CLR LOKBLK+10 ; .LOOKUP "user" routine CLR NUMDVW ; reset no. of devices CLR PHYFLG ; start with LOGICAL names .IF NE SP$MLS MOV #-1,SOUNIT .ENDC; NE SP$MLS ; Loop for all logical devices in table DEVLST 10$: MOV R5,R2 ; save address of device name MOV (R5)+,R1 ; Get an SO device name BEQ 40$ ; End of list? .IF NE SP$MLS INC SOUNIT ; advance to next SO unit number .ENDC; NE SP$MLS CMP R2,#PHYLST ; is this the LP0 entry? BNE 20$ INC PHYFLG ; get physical for DSTAT INC LOKBLK+2 ; "user" routine for LOOKUP, MOV #RTSPC+1,LOKBLK+10 ; specify PHYSICAL LOOKUP 20$: MOV PHYFLG,R3 ; in the LP0/LS0 part? BEQ 30$ ; branch if not TST NUMDVW ; any device found yet? BNE 40$ ; get out if so. 30$: CMP NUMDVW,MAXDEV ; max number of devices reached? BLO 50$ ; branch if not. 40$: JMP 170$ ; quit looking for devices ...... 50$: .IF NE SP$MLS TST R3 ; get optional PHYSICAL bit BEQ 70$ ; branch if doing the SO series CLR SOUNIT ; otherwise, force unit=0 70$: .ENDC; NE SP$MLS ADD #DEVBLK,R3 ; add address of DSTAT reply area .DSTAT R3,R2 ; Get status of named device BCS 10$ ; no such device? CMPB DEVBLK,#SP.DVC ; is it SP? BEQ 150$ ; that's no good BITB #,DEVBLK+DS.ATT ; Is device file structured? BNE 160$ ; then that's no good. TST DEVBLK+DS.ADR ; is handler loaded? BEQ 130$ ; branch if not. ; Get device's physical name MOV R1,DEVSPC ; Put dev name into NFS DBLK .SERR .LOOKUP #LOKBLK,CODE=NOSET ; look it up ROL R1 ; save C-bit .HERR ROR R1 BCS 165$ ; .LOOKUP failed? MOV #DEVSPC,R1 ; point to RAD50 name MOVB LOKBLK,R2 ; pass channel to CSTAT CALL REALDV ; get physical name MOV @R1,DEVNAM ; save for messages CLR R0 ; For each device, .IF NE SP$MLS ; Check table for pre-existance of that device MOV #ODVTAB,R3 ; point to table entry 80$: CMP R0,#NUMDEV ; end of list? BEQ 100$ ; (unless none there) CMP @R1,OT.DEV(R3) ; already there? BEQ 110$ ; already represented. CMP R0,SOUNIT ; is this the requested unit? BNE 90$ ; branch if not MOV R3,R2 ; save pointer to output table entry 90$: ADD #OT.ESZ,R3 ; point to next entry INC R0 BR 80$ ...... 100$: MOV SOUNIT,R0 ; this unit is ok. .ENDC; NE SP$MLS ; Print a nice message and add the device to the table ADD #'0,R0 ; make unit number a digit MOVB R0,MSGOK2 ; store SO unit number MOV R1,-(SP) ; save adrs of RAD50 name MOV #DEVNAM,R0 ; address of RAD50 name MOV #MSGOK1,R1 ; point to ASCII message area CALL $FNASC ; convert RAD50 to ASCII .IF EQ SP$MLS MOV #MSGOK1,R0 ; for single-stream SPOOLer, MOV #PHYNAM,R1 .REPT 4 MOVB (R0)+,(R1)+ ; copy device name to static area .ENDR .ENDC; EQ SP$MLS ;+ ;ERROR .PRINT #MSGOK ; print STARTING message ;- MOV (SP)+,R1 ; restore address of RAD50 name INC NUMDVW ; count good device .IF NE SP$MLS MOVB LOKBLK,OT.CHA(R2) ; store channel MOV @R1,OT.DEV(R2) ; store device name in table INCB LOKBLK ; next channel 105$: BR 10$ ; try next one. ...... .IFF; NE SP$MLS MOV @R1,(R4)+ ; build SDCTAB entry - R50 name CLR (R4)+ ; type... CLR (R4)+ CLR (R4)+ CLR (R4)+ CLR (R4)+ MOV ..SPSZ,(R4)+ ; size... CLR (R4)+ BR 170$ ...... .IFT; NE SP$MLS ; .LOOKUP revealed unsuitable device. PURGE the channel, and ; try the next entry in the DEVTAB table. 110$: ADD #'0,R0 ; make unit number digit MOVB R0,MSGDU2 ; set up error message MOV #DEVNAM,R0 ; address of RAD50 name MOV #MSGDU1,R1 ; point to ASCII message area CALL $FNASC ; convert RAD50 to ASCII ;+ ;ERROR .PRINT #MSGDU0 ; Inform operator of duplicate ;- 120$: MOVB LOKBLK,R1 ; purge the channel .PURGE R1 BR 105$ ; try next entry ...... .ENDC; NE SP$MLS ; Error conditions: ; Handler is not loaded ;+ ;ERROR 130$: .PRINT #MSGNL ; Handler is not loaded ;- 132$: MOV #,R0 ; point to free space CLR -(R0) ; make a null filename MOV R1,-(R0) ; Let R0 -> RAD50 name MOV #MSGNL1,R1 ; Point to ASCII message area CALL $FNASC ; convert RAD50 to ASCII ;+ ;ERROR .PRINT #MSGNL1 ; Handler is not loaded ;- .PURGE LOKBLK 140$: .IF NE SP$MLS BR 105$ ; Try next device in list ...... .IFF; NE SP$MLS BR 10$ ; Try next device in list ...... .ENDC; NE SP$MLS ; Device is SP ;+ ;ERROR 150$: .PRINT #MSGSP ; Device is actually SP ;- BR 140$ ...... ; Device is file structured ;+ ;ERROR 160$: .PRINT #MSGFS ; Device is file structured ;- BR 132$ ...... ; LOOKUP failed on device 165$: MOV @#$ERRBY,R0 ; Get error byte BMI 166$ ; .SERR? CMP R0,#2 ; Device in use? BEQ 168$ ; Branch if so. ;+ ;ERROR .PRINT #MSGID ; Invalid device ;- BR 132$ ...... ;+ ;ERROR 166$: .PRINT #MSGDIO ; Directory I/O error ;- BR 132$ ...... ;+ ;ERROR 168$: .PRINT #MSGDIU ; Device in use ;- BR 132$ ...... ; End of processing 170$: .IF NE SP$MLS MOV NUMDVW,R0 BNE 180$ ; some SO device found? ;+ ;ERROR MOV #MSGNON,R0 ;- JMP NOGOOD ...... 180$: .ENDC; NE SP$MLS FINDSZ: MOV #AREA,R2 ; R2 -> EMT area .DSABL LSB .IF EQ SP$MLS .SBTTL Reset the spooled device control table .ASSUME B.HEAD EQ B.USED+2 .ASSUME B.TAIL EQ B.HEAD+2 .ASSUME B.BEG EQ B.TAIL+2 .ASSUME B.END EQ B.BEG+2 MOV #,R3 ; R3 => spooled device control table CLR (R3)+ ; Clear B.USED(R3) CLR (R3)+ ; Init header blk no. B.HEAD(R3) CLR (R3)+ ; TAIL = HEAD initially B.TAIL(R3) CLR (R3)+ ; Lowest useable block B.BEG(R3) MOV LWFBLK,@R3 ; Highest block B.END(R3) .ENDC; EQ SP$MLS .IF NE SP$PPS .BR PILOOK .SBTTL Lookup the Professional Interface Handler .ENABL LSB PILOOK: .GVAL R2,#$CNFG2 ; Get configuration word 2. BIC #^C,R0 ; Isolate the Bus Bits CMP R0,#PROS$ ; Is this a professional 300? BNE 30$ ; If not, can't PRINT SCREEN 10$: .GVAL R2,#$SYSGE ; Get the sysgen options word. BIT #MMGT$,R0 ; Is this XM? BEQ 30$ ; If not, cannot PRINT SCREEN 20$: .PURGE #PICHAN ; Purge PI channel .LOOKUP R2,#PICHAN,#PI ; Look PI: up on it? BCC 40$ ; Any errors? ;+ ;ERROR MOV #BADPI,R0 ; Yes, report and exit. ;- BR NOGOOD ...... 30$: CLR PRO ; No, then remember that we're not. 40$: ; Fall through. .DSABL LSB .ENDC; NE SP$PPS .SBTTL Initialize the pseudo control registers .IF NE V$JOB .SBTTL Correctly context switch the Kernel IOT vector .GVAL R2,#$CNTXT ; Get the pointer to SPOOL's MOV R0,R1 ; impure area .PEEK R2,R1 ; Get I.STATE word MOV R0,R5 BIS #VLOAD$,R5 ; Set the VLOAD$ bit .POKE R2,R1,R5 .ENDC; NE V$JOB .IF EQ V$JOB MOV @#$SYPTR,R3 ; R3 -> Base of RMON. ADD #$SPSTA,R3 ; R3 -> Spooler status word. .IFF; EQ V$JOB .PVAL R2,#$SPSTA,#ACTIVE ; Declare SPOOL ACTIVE MOV #SPCSRV,R3 ; Get pointer to pseudo $SPSTA .ENDC; EQ V$JOB MOV R3,SPCSR ; Store the pointer. .SBTTL Finished SPINIT - Go on to SPTASK .IF EQ V$JOB RETURN ; to main for overlay load .IFF; EQ V$JOB JMP SPTASK ; loop forever. .ENDC; EQ V$JOB ...... .SBTTL NOGOOD - SPOOL startup fails ;+ ; ; SPINIT has a problem starting SPOOL. Exit gracefully. ; ;- NOGOOD: .PRINT R0 ; Allow some last words .PVAL #AREA,#$SPSTA,#0 ; Declare SPOOL DEAD .EXIT ...... .SBTTL REALDV - Get physical device name ;+ ; R1 -> dev name ; R2 = channel ; CALL REALDV ;- .ENABL LSB REALDV: .CSTAT #AREA,R2,#CSDATA ; Get info about channel BCS RTSPC ; branch if error MOV #CSDATA,R0 ; R0 -> CSDATA MOV R1,-(SP) ; save address of name destination MOV CS.UNT(R0),R1 ; get CSTAT's unit no., MOV CS.NAM(R0),R0 ; get CSTAT's device name, CALL $DEVTR ; translate to phys name MOV (SP)+,R1 ; restore destination, MOV R0,@R1 ; put 'er there. RTSPC: RETURN ...... .DSABL LSB .SBTTL Message text .PSECT .TEXT.,D ; Error Error Messages ;+ ;ERROR MSGDU0: .ASCII /?SPOOL-E-Device / MSGDU1: .ASCII /xxn: already assigned to SP/ MSGDU2: .ASCIZ /0:/ MSGNL: .ASCII /?SPOOL-E-Device handler not loaded for /<200> MSGNL1: .ASCIZ /xxn:/ MSGID: .ASCII /?SPOOL-E-Invalid device /<200> MSGSP: .ASCIZ /?SPOOL-E-SO Device is SP/ MSGFS: .ASCII /?SPOOL-E-File structured device /<200> MSGDIO: .ASCII "?SPOOL-E-Directory I/O error "<200> MSGDIU: .ASCII /?SPOOL-E-Device in use /<200> ; Fatal Error Messages NOSFHN: .ASCIZ /?SPOOL-F-Work file device handler not loaded/ NOSFIL: .ASCIZ /?SPOOL-F-Cannot create work file/ TOOSMA: .ASCIZ /?SPOOL-F-Work file too small/ DIOERR: .ASCII "?SPOOL-F-Directory I/O error "<200> DIOER1: .ASCIZ "WF0:" .IF NE SP$PPS BADPI: .ASCIZ '?SPOOL-F-Cannot LOOKUP PI handler' .ENDC; NE SP$PPS .IF EQ V$JOB NOMEM: .ASCIZ '?SPOOL-F-Cannot get memory (use /BUFF:256.)' NOUSR:: .ASCII '?SPOOL-F-SET USR NOSWAP to start; it may swap ' .ASCIZ 'once running' USEVJ: .ASCIZ '?SPOOL-F-Use virtual version SPOOL.SAV' .IFF; EQ V$JOB NOXMEM: .ASCIZ /?SPOOL-F-Cannot attach SPX region/ CANTMA: .ASCIZ /?SPOOL-F-Cannot map SPX window/ NOWFMR: .ASCIZ /?SPOOL-F-Cannot create SPOOL region/ NOWFMW: .ASCIZ /?SPOOL-F-Cannot map SPOOL window/ .ENDC; EQ V$JOB .IF NE SP$MLS INVWFS: .ASCIZ /?SPOOL-F-Invalid work file size/ MSGNON: .ASCIZ /?SPOOL-F-No SO devices in system/ .ENDC; NE SP$MLS ; Informational Error Messages MSGOK: .ASCII /?SPOOL-I-Spooling started on / MSGOK1: .ASCII /xxn: through SP/ MSGOK2: .ASCIZ /n:/ ;- .EVEN .END