Trailing-Edge
-
PDP-10 Archives
-
AP-D483B-SB_1978
-
sprout.mac
There are 33 other files named sprout.mac in the archive. Click here to see a list.
TITLE SPROUT -- Spooling PRocessor for OUTput - Version 2
SUBTTL D.A. Lewine - L.S. Samberg/LSS 2 Mar 77
;Copyright (C) 1970,71,72,73,74,75,76,77
; Digital Equipment Corp., Maynard, MA.
;ASSEMBLY AND LOADING INSTRUCTIONS
;
; .COMP SPROUT
; .LOAD /REL SPROUT
; .SSAVE SPROUT
SEARCH QSRMAC ;SEARCH QUASAR-10 SYMBOLS
PROLOGUE(SPROUT)
SEARCH MACTEN,UUOSYM
%%MACT==%%MACT
%%UUOS==%%UUOS
.REQUIRE SBSCOM ;SUBSYSTEMS COMMON MODULE
.REQUIRE CSPQSR ;QUASAR INTERFACE MODULE
.REQUIRE CSPMEM ;MEMORY MANAGER
.REQUE REL:HELPER ;GET HELP TEXT PRINTER
SALL ;SUPPRESS MACRO EXPANSIONS
;VERSION INFORMATION
SPOVER==2 ;MAJOR VERSION NUMBER
SPOMIN==0 ;MINOR VERSION NUMBER
SPOEDT==2116 ;EDIT LEVEL
SPOWHO==0 ;WHO LAST PATCHED
%SPO==<BYTE (3)SPOWHO(9)SPOVER(6)SPOMIN(18)SPOEDT>
;STORE VERSION NUMBER IN JOBVER
LOC 137
.JBVER:: EXP %SPO
TWOSEG ;TWO SEQMENT PROGRAM
RELOC 400000 ;START IN HISEG
SEG==-1 ;AND FLAG IT
;THIS PROGRAM IS A COMBINATION OF THE PRE-EXISTING PROGRAMS
; PTPSPL, CDPSPL, AND PLTSPL. THESE THREE PROGRAMS
; EXISTED AS A SINGLE SOURCE FILE, SPOOL.MAC, AND
; THE DESIRED SPOOLER WAS SELECTED AT ASSEMBLY TIME. IN
; SPROUT, THIS CHOICE IS MADE AT RUNTIME BY USING ONE OF
; THE "TAPE", "CARD" OR "PLOT" COMMANDS RATHER THAN THE
; "START" COMMAND.
SUBTTL Revision History
;2000 First GALAXY-10 Field-Test release, June, 1975.
;2001 Take out code to compute when a CHECKPOINT should be taken,
; and use the Checkpoint-Request message from QUASAR.
;2002 Ignore CHECKPOINT-REQUEST message if idle.
;2003 Fix a bug in SETEOF. Change EQ.IGN to EQ.RDE.
;2004 Have CLRSEG avoid doing CORE UUOs if possible.
; Do a CLRBFI before asking for scheduling device.
;2005 Upon ignoring a message, release the page if necessary.
;2006 Implement use of CSPPSI for TTY input. Clean
; up error messages. Make EXIT and RESET commands pend
; if we are busy. Make START command clear pending commands.
;2007 Fix up limit-exceeded handling.
;2010 Numerous minor code cleanups.
;2011 OUTPIC routine used location SAVT1 which caused trouble
; now that we process commands in DEVOUT.
;2100 Make this version 2, August, 1976.
;2101 Implement new loading procedure, new call to CSPQSR, and
; new CHECKPOINT/REQUEUE format.
;2102 Could not punch 026 (BCD) files since offsets into
; code blocks were all off by 1.
;2103 Convert to version 2 database. Fix up header
; and trailer logic on PTP. Start some cleanup on
; operator message output routines.
;2104 Lots of code cleanup.
;2105 REQUEUE when off-line hung the world [SPR 10-19528].
;2106 Remove MSGLVL COMMAND AND ADD MESSAGE command
; with FILE and ERROR options.
;2107 Remove code to spool to disk.
;2110 Leave enough blank tape around the PTP trailer to allow easy breaks.
;2111 Remove TELLN UUO.
;2112 Cause SPROUT to hold on to the device rather than releasing
; at the end of every job.
;2113 Lots of code cleanup and more work on PTP headers.
;2114 More cleanup.
;;First field-test release of GALAXY release 2, Jan 1977
;2115 Remove checks for RDE jobs.
;2116 Remove code to check for DAEMON. Fix a
; bug in the PTP block letter printer (QAR #10). Ignore
; requests for checkpoint and checkpoint at the end of each copy
; instead.
SUBTTL AC and I/O Channel Definitions
IF1,<
;ACCUMULATOR DEFINITIONS
S=0 ;STATUS FLAGS
C=1
QP=2
T5=14
N=15
;INPUT-OUTPUT CHANNELS
DSK==1 ;SPOOLED DATA ON DSK
DCH==3 ;DEVICE CHANNEL
;DEVICE INDICES
D%PTP==0
D%CDP==1
D%PLT==2
> ;END OF IF1
SUBTTL Conditional Assembly Switches
ND DSKBN,4 ;4 DISK INPUT BUFFERS
ND DEVBN,2 ;2 OUTPUT BUFFERS
ND PDSIZE,200 ;SIZE OF PUSHDOWN LIST
ND SLTIME,^D5000 ;MS TO WAIT ON ?DEVICE OK
ND CPC,^D80 ;CHARACTERS PER CARD
ND CPCMON,^D81 ;CHARS PER CARD - MONITOR THINKS
ND LCPF,7 ;LOG(2) OF NUMBER OF CHARS/FOOT OF TAPE
ND CHPFLD,^D90 ;CHARACTERS PER FOLD OF PTP
ND MAXUUO,7 ;LENGTH OF EXTENDED LOOKUP/ENTER/RENAME
ND MAXERR,5 ;NUMBER OF DISK I/O ERRS BEFORE PUNTING
ND MAXLIM,10000 ;LARGEST JOB TO PROCESS
ND FACTSW,-1 ;-1 TO INCLUDE ACCOUNTING
ND MINUSY,^D1200 ;NUMBER OF MINUS Y PRIOR TO PLOT
ND PLUSX,^D300 ;NUMBER OF +X BEFORE PLOT
ND PLUSY,^D54 ;NUMBER OF +Y BEFORE PLOT
ND AUTTIM,^D20 ;AUTO-TIMEOUT IN MINUTES
;CONSTANTS
XP FCTHDR,<251000,,13> ;FACT ENTRY HEADER
XP .EQNOT,.EQLM2+1 ;ADR OF NOTE WORDS
XP .EQCFL,.EQCHK+1 ;FILE CHECKPOINT WORD
XP .EQCCP,.EQCHK+2 ;COPY CHECKPOINT WORD
SUBTTL MACROS
IF1 <
;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
>>>
;STILL IN IF1
;FREQUENTLY USED INSTRUCTIONS SEQUENCES
DEFINE ACTCHR (CH,A)<
CAIN C,"CH" ;;IS THIS A CH
XLIST
JRST A ;YES
LIST
SALL
>
;RELOC TO HISEG
DEFINE TOPSEG,<
IFE SEG,<
XLIST
LIT
SEG==-1
RELOC>
LIST
SALL
>
;RELOC TO LOWSEG
DEFINE LOWSEG,<
IFN SEG,<
XLIST
LIT
LIST
SALL
RELOC>
SEG==0
>
;STILL IN IF1
;BIT TESTING MACROS
DEFINE ON(AC,FLAG),<TXO AC,FLAG>
DEFINE OFF(AC,FLAG),<TXZ AC,FLAG> ;TURN OFF A FLAG
DEFINE IFON(AC,FLAG,WHERE),<
.XCREF ;;TURN OFF CREF INSIDE MACRO
IFB <WHERE>,<
TXNE AC,FLAG>
IFNB <WHERE>,<
YY..==400000000000&FLAG
IFN YY..,<
.CREF ;;TURN THE CREF BACK ON
JUMPL AC,WHERE>
.XCREF ;;TURN OFF CREF INSIDE MACRO
IFE YY..,<
TXNE AC,FLAG
IFNB <WHERE>, ;;ADDRESS SPECIFIED
< ;;TURN OFF LIST
XLIST
.CREF ;;TURN THE CREF BACK ON
JRST WHERE ;;GO TO WHERE.
PURGE YY..>>
LIST
SALL>
.CREF ;;TURN THE CREF BACK ON
>
;STILL IN IF1
DEFINE IFOFF(AC,FLAG,WHERE),<
.XCREF ;;TURN OFF CREF INSIDE MACRO
IFB <WHERE>,<
TXNN AC,FLAG>
IFNB <WHERE>,<
YY..==400000000000&FLAG
IFN YY..,<
.CREF ;;TURN THE CREF BACK ON
JUMPGE AC,WHERE>
.XCREF ;;TURN OFF CREF INSIDE MACRO
IFE YY..,<
TXNN AC,FLAG
IFNB <WHERE>, ;;ADDRESS SPECIFIED?
<
XLIST
.CREF ;;TURN THE CREF BACK ON
JRST WHERE
.XCREF ;;TURN OFF CREF INSIDE MACRO
PURGE YY..>>
LIST
SALL>
.CREF ;;TURN THE CREF BACK ON
>
> ;END OF IF1
DEFINE LP(SYM,VAL),<
IF1,<
XLIST
IFNDEF ...X,<...X==1000>
IFDEF SYM,<PRINTX ?PARAM SYM USED TWICE>
SYM==...X
...X==...X+VAL
IFL 2000-...X,<PRINTX ?PARAMETER AREA LONGER THAN A PAGE>
LIST
SALL
> ;END IF 1
> ;END DEFINE LP
;MACRO TO DEFINE PHASE OFFSET FOR BLT'ED CODE
DEFINE XC(A),<P$XCOD+A(AP)>
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,XXX0, ;HOLD THIS PLACE
BIT S,XXX1, ;HOLD THIS PLACE
BIT S,TELUSR, ;SENT DIRECTLY TO OUDEV(SET BY TELL)
;******* DO NOT MOVE BITS DEFINED ABOVE THIS LINE *******
BIT S,PAUSEB, ;PAUSE AT EOJ
BIT S,OPENB, ;START COMMAND GIVEN
BIT S,SCLN, ; ";" SEEN (TYI) ALSO SET BY REQUEUE
BIT S,SPAC, ; " " SEEN (TYI)
BIT S,SOME, ;SOMETHING HAS BEEN STORED (TYI)
BIT S,DSKOPN, ;DISK DATA READ GOING ON
BIT S,RQB, ;QUEUE ENTRY HAS BEEN DELETED
BIT S,PLOCK, ;DO NOT CLEAR THE PAUSE BIT
BIT S,FROZE, ;DON'T ASK TO CHANGE FORMS TYPE
BIT S,ABORT, ;THE SHIP IS SINKING
BIT S,MNTBIT, ;REQUEST FOR FORMS TO BE MOUNTED
BIT S,ISCDP, ;ITS A REAL CDP
BIT S,ANYCHR, ;CARD IS NON-BLANK
;INITIAL SETING OF STATUS REGISTER
INITS==0
;BITS TO CLEAR WHEN IDLE
IDLZ==SOME!SPAC!SCLN
;BITS TO CLEAR WHEN ACTIVE
ACTVZ==TELUSR!ABORT
;BITS TO SET WHEN A NEW ENTRY IS FOUND
ACTVO==RUNB
;STILL IN IF1
SUBTTL LUUO Definitions
;OPDEFS
OPDEF TELL [001000,,0] ;TELL UUO
;AC FIELD OF TELL UUO
OPR==10 ;SEND TO OPERATOR
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
SUBTTL Job Parameter Area
LP P$$BEG,0 ;BEGINNING OF PARAMETER AREA
;REQUEST PARAMETERS
LP P$RFLN,1 ;NUMBER OF FILES IN REQUEST
LP P$RLIM,1 ;JOB LIMIT IN EXTERNAL UNITS
;BUFFER ADDRESSES AND INFORMATION
LP P$BNUM,1 ;NUMBER OF BUFFER PAGES
LP P$BPAG,1 ;NUMBER OF FIRST BUFFER PAGE
LP P$BLPS,1 ;NUMBER OF LPT BUFFER WORDS
LP P$BLPT,1 ;ADR OF LPT BUFFER
LP P$BDSK,1 ;ADR OF DSK BUFFER
;DEVICE PARAMETERS
LP P$LBRH,1 ;BUFFER RING HEADER
LP P$LBPT,1 ;BYTE POINTER
LP P$LBCT,1 ;BYTE COUNT
LP P$LGDV,1 ;GENERIC DEVICE NAME
LP P$LDVI,1 ;DEVICE INDEX
LP P$LSTS,1 ;IO STATUS FOR OPEN UUO
LP P$LCHR,1 ;DEVTYP OF OUTPUT DEVICE
LP P$LGNM,1 ;DEVNAM GIVEN BY OPR
;DISK FILE PARAMETERS
LP P$DBRH,1 ;BUFFER RING HEADER
LP P$DBPT,1 ;BYTE POINTER
LP P$DBCT,1 ;BYTE COUNT
LP P$DPAT,<10> ;PATH BLOCK
LP P$DUUO,<MAXUUO+1> ;UUO BLOCK
LP P$DFLP,<6> ;FILOP. BLOCK
LP P$DEXT,1 ;EXTENSION,,0
LP P$DERR,1 ;NUMBER OF DEVICE ERRORS
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;CURRENT FORMS PARAMETERS
LP P$FORM,1 ;CURRENT FORMS TYPE
LP P$FPFM,1 ;PREVIOUS FORMS TYPE
;ACCOUNTING BLOCK
LP P$AFNC,1 ;DAEMON FUNCTION
LP P$AHED,1 ;TYPE,,LENGTH (251B8,,13)
LP P$APPN,1 ;PPN
LP P$ADAT,1 ;DATE (FILLED BY DAEMON)
LP P$AQUE,1 ;0-11 = QUEUE NAME
;12-17 = STATION
;18-35 = SERIAL # OF MASTER CPU
LP P$ARTM,1 ;RUNTIME IN SECS*100
LP P$ACTI,1 ;CORE-TIME INTEGRAL IN KCS*100
LP P$ADRD,1 ;DISK READS
LP P$ADWT,1 ;DISK WRITES
LP P$ADEV,1 ;PROCESSING DEVICE
LP P$ASEQ,1 ;JOB SEQUENCE NUMBER
LP P$APRT,1 ;NUMBER OF PAGES PRINTED
P$AEND==P$APRT ;END OF BLOCK
;MISCELLANY
LP P$XUPT,1 ;UPTIME AT START OF JOB
LP P$XCNT,1 ;COLUMN/FRAME COUNTER
LP P$XCOD,<200> ;COMPILE A ROUTINE TO CHECK
LP P$XSQP,1 ;SAVE POINTER TO CURRENT FILE
LP P$$END,1 ;END OF PARAMETER AREA
SUBTTL Random Impure Storage
LOWSEG
NXTJOB: BLOCK 1 ;NEXT JOB TO RUN
INTLOC: BLOCK 4 ;.JBINT BLOCK
OLDSEG: BLOCK 1 ;NON-ZERO IF NEED HISEG
MESSAG: BLOCK 1 ;ADDRESS OF RECEIVED MESSAGE
TTYFLG: BLOCK 1 ;SET TO -1 ON TTY INTERRUPT
XITFLG: BLOCK 1 ;SET TO -1 IF EXIT IS PENDING
RSTFLG: BLOCK 1 ;SET TO -1 IF RESET IS PENDING
SAVCHR: BLOCK 1 ;PLACE TO SAVE 1 CHAR
SEGBLK: BLOCK 6 ;SPACE FOR GETSEGS
PDL: BLOCK PDSIZE ;PUSHDOWN LIST
LPNOP: BLOCK 1 ;-1 IF FORMS WAIT TIMED OUT
LPCOPY: BLOCK 1 ;NUMBER OF COPIES PRINTED
MLIM: BLOCK 1 ;BIGGEST JOB THAT WILL BE RUN
MSGFIL: BLOCK 1 ;MESSAGE FILE
MSGERR: BLOCK 1 ;MESSAGE ERROR
HNGCNT: BLOCK 1 ;NUMBER OF DEVICE OK'S
JIFSEC: BLOCK 1 ;JIFFIES/SEC
JOBPAG: BLOCK 1 ;ADR OF JOB PARAMETER PAGE
CNTSTA: BLOCK 1 ;NUMBER OF CENTRAL SITE
MYSTA: BLOCK 1 ;NUMBER OF MY STATION
PAC: POINT UUSBIT,.JBUUO,UURLOC ;POINTER TO AC IN LUUO
PS: POINT SFSBIT,S,SFRLOC ;SAME FIELD IN S
;THE WORD ELFCH IS USED TO STORE WORDS FOR THE /ELEVEN PROCESSING
; IN THE PTP SPOOLER. THE BYTE POINTERS FOLLOWING IT ARE
; USED TO EXTRACT 4 BYTES FROM ELFCH. IN THE COMMENTS,
; A IS THE ORDER IN WHICH THE BYTES ARE SELECTED AND POS IS
; THE BIT POSITION IN THE WORD IN DECIMAL.
ELFCH: BLOCK 1 ;HOLDS THE WORD
ELFPTR: 101000,,ELFCH ;A=4 POS=<20,27>
001000,,ELFCH ;A=3 POS=<28,35>
321000,,ELFCH ;A=2 POS=<2,9>
221000,,ELFCH ;A=1 POS=<10,17>
SUBTTL Message Blocks
HELBLK: HEL.SZ,,.QOHEL ;HELLO BLOCK
HELPGM: BLOCK 1 ;PROGRAM NAME
HELSDV: BLOCK 1 ;SCHEDULABLE DEVICE
HELPDV: BLOCK 1 ;PROCESSING DEVICE
HELFRM: BLOCK 1 ;FORMS NAME
HELMLT: BLOCK 1 ;MLIMIT,,NEXT
HELXXX: BLOCK 1 ;UNUSED
HELSTS: BLOCK 1 ;STATUS FLAGS
RELBLK: REL.SZ,,.QOREL ;RELEASE BLOCK
RELITN: BLOCK 1 ;INTERNAL TASK NAME
REQBLK: REQ.SZ,,.QOREQ ;REQUEUE BLOCK
REQITN: BLOCK 1 ;INTERNAL TASK NAME
REQFIL: BLOCK 1 ;NUMBER OF FILES COMPLETED
REQCOP: BLOCK 1 ;NUMBER OF COPIES COMPLETED
REQPAG: BLOCK 1 ;NUMBER OF PAGES COMPLETED
REQXTR: BLOCK 1 ;EXTRA WORD
REQAFT: BLOCK 1 ;AFTER PARAMETER IN MINUTES
CHKBLK: CHE.SZ,,.QOCHE ;CHECKPOINT BLOCK
CHKITN: BLOCK 1 ;INTERNAL TASK NAME
CHKFIL: BLOCK 1 ;FILES COMPLETED
CHKCOP: BLOCK 1 ;COPIES COMPLETED
CHKPAG: BLOCK 1 ;PAGES COMPLETED
CHKXTR: BLOCK 2 ;2 EXTRA WORDS
;THIS BLOCK IS USED TO STORE THE CHECKPOINT INFORMATION GOTTEN FROM
; THE REQUEST IF IT HAS BEEN RESTARTED.
RSCFIL: BLOCK 1 ;FILES DONE
RSCCOP: BLOCK 1 ;COPIES DONE
RSCPAG: BLOCK 1 ;PAGES DONE
SUBTTL Idle Loop
TOPSEG
MAIN: SKIPE XITFLG ;EXIT PENDING
JRST DOEXIT ;YES, DO IT
SKIPE RSTFLG ;NO, IS RESET PENDING?
JRST DOREST ;YUP!
TXNN S,PLOCK ;SKIP IF PAUSE LOCK IS ON
TXNE S,PAUSEB ;TIME TO PAUSE?
PUSHJ P,DOPAUS ;YES, DO IT
TDZ S,[IDLZ!ACTVZ] ;CLEAN UP S
SLP0: PUSHJ P,CHKALL ;SOMETHING THERE?
MOVE S1,MESSAG ;GET ADDRESS OF MESSAGE
JUMPE S1,SLP1 ;NONE THERE, GO TO SLEEP
LOAD T1,.MSTYP(S1),MS.TYP ;GET THE MESSAGE TYPE
CAIE T1,.QONEX ;IS IT A JOB FOR ME?
JRST [TXNN S1,1B0 ;NO, IS IT A PAGE?
JRST SLP0 ;NO, JUST LOOP
HRRZ AP,S1 ;YES, GET ADDRESS
ADR2PG AP ;MAKE A PAGE NUMBER
PUSHJ P,M$RELP## ;RELEASE IT
JRST SLP0] ;AND LOOP
HRRZ S2,AP ;YES, GET ADR OF JOB BLOCK
HRL S2,S1 ;MAKE A BLT POINTER
LOAD T1,.MSTYP(S1),MS.CNT ;GET SIZE OF REQUEST
ADDI T1,-1(AP) ;GET END OF BLT ADR
BLT S2,(T1) ;BLT THE REQEST
HRRZ AP,S1 ;GET ADDRESS
ADR2PG AP ;MAKE A PAGE NUMBER
PUSHJ P,M$RELP## ;RELEASE THE PAGE
MOVE AP,JOBPAG ;GET AP BACK
JRST DOFILE ;AND GO DO IT
SLP1: PUSHJ P,M$CLNC## ;CLEAN UP CORE
MOVX T1,HB.RTL!HB.IPC ;LOAD HIBER ENABLE BITS
HIBER T1, ;ZZZZZZ
HALT . ;SHOULD NEVER EVER HAPPEN
JRST MAIN ;AND LOOP
SUBTTL Job Setup
;HERE WITH A RUNNABLE JOB IN THE QUEUE BLOCK
DOFILE: HRROI T1,.GTTIM ;GET THE RUNTIME
GETTAB T1, ; FROM THE MONITOR
SETZ T1, ;FAILED!!!
MOVNM T1,P$ARTM(AP) ;-VE TO FACT BLOCK
HRROI T1,.GTKCT ;GET THE TOTAL KCT'S
GETTAB T1, ; FROM THE MONITOR
SETZ T1, ;FAILED!!!
MOVNM T1,P$ACTI(AP) ;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,P$ADRD(AP) ;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,P$ADWT(AP) ;STORE -VE FOR TESTQ
LOAD T1,.EQITN(AP) ;GET THE ITN
MOVEM T1,RELITN ;SAVE IT FOR RELEASE
MOVEM T1,REQITN ;SAVE IT FOR REQUEUE
MOVEM T1,CHKITN ;SAVE IT FOR CHECKPOINT
LOAD T1,.EQSEQ(AP),EQ.SEQ ;LOAD SEQUENCE NUMBER
MOVEM T1,P$ASEQ(AP) ;AND SAVE IT
CAMN T1,NXTJOB ;IS THE SPECIFIED NXTJOB?
CLEARM NXTJOB ;YES, CLEAR IT
LOAD T1,.EQOWN(AP) ;AND DIRECTORY
MOVEM T1,P$APPN(AP) ;AND SAVE IT
TDZ S,[ACTVZ] ;CLEAR SOME BITS
MOVE T1,[%NSUPT] ;GET THE UPTIME
GETTAB T1, ;FROM THE MONITOR
SETZ T1, ;FAILED
MOVEM T1,P$XUPT(AP) ;SAVE UPTIME
CLEARM CHKFIL ;CLEAR THE CHECKPOINT WORDS
CLEARM CHKCOP ;COPIES
CLEARM CHKPAG ;PAGES
CLEARM P$APRT(AP) ;CLEAR THE LIMIT WORD
LOAD T1,.EQSPC(AP),EQ.NUM ;GET THE NUMBER OF FILES
MOVEM T1,P$RFLN(AP) ;AND SAVE IT
LOAD QP,.EQLEN(AP),EQ.LOH ;LOAD THE LEN OF HDR
ADD QP,AP ;ADD IN THE START ADDRESS
MOVEM QP,P$XSQP(AP) ;AND SAVE THE POINTER
MOVE T1,HELPDV ;GET THE DEVICE NAME
ON S,MNTBIT ;FLAG "MOUNT-WAIT"
PUSHJ P,MOUNT ;MOUNT THE CORRECT FORMS
OFF S,MNTBIT ;WE'RE BACK...
LOAD T1,.EQLM2(AP),EQ.PGS ;GET LIMIT IN PAGES
MOVEM T1,P$RLIM(AP) ;SAVE IT
TXNE S,RQB ;WERE WE REQUEUED?
JRST MAIN ;YES, RESTART
SUBTTL Per File Loop
FILE: MOVE QP,P$XSQP(AP) ;GET FILE-POINTER
SOSL T1,.EQCFL(AP) ;IS THIS A RESTARTED JOB?
JRST FIXQP ;YES, AND WE SKIP THIS FILE
AOJN T1,FILE.2 ;JUMP IF NOT 1ST TO BE PRINTED
LOAD T2,.FPINF(QP),FP.FCY ;GET COPIES TO PRINT
SUB T2,.EQCCP(AP) ;SUBTRACT COPIES TO SKIP
STORE T2,.FPINF(QP),FP.FCY ;STORE COPIES TO PRINT
SETOM .EQCCP(AP) ;AND SET A FLAG
SKIPA ;AND SKIP
FILE.2: CLEARM .EQCCP ;CLEAR THE RE-START FLAG
TXO S,ACTVO ;SET "ACTIVE" FLAGS
LOAD N,.FPSIZ(QP),FP.FHD ;GET SIZE OF FP AREA
ADD N,QP ;POINT TO FD AREA
MOVE T2,.FDNAM(N) ;GET THE FILENAME
MOVEM T2,P$DUUO+.RBNAM(AP) ;SAVE IN LOOKUP BLOCK
HLLZ T2,.FDEXT(N) ;GET THE EXTENSION
MOVEM T2,P$DUUO+.RBEXT(AP) ;SAVE IN THE UUO BLOCK
MOVEM T2,P$DEXT(AP) ;AND SAVE IT SPECIAL
MOVSI T1,P$DPAT(AP) ;ADR OF PATH BLOCK,,0
HRRI T1,P$DPAT+1(AP) ;BLT POINTER TO ZERO IT OUT
CLEARM P$DPAT(AP) ;CLEAR THE FIRST WORD
BLT T1,P$DPAT+7(AP) ;CLEAR THE REST
MOVEI T1,P$DPAT+2(AP) ;POINT TO PPN WORD
HRLI T1,.FDPPN(N) ;SETUP TO BLT THE PATH
LOAD T2,.FPSIZ(QP),FP.FFS ;GET SIZE OF FD AREA
ADDI T2,-FDMSIZ(AP) ;SUB FDMSIZ, ADD AP
BLT T1,P$DPAT+2(T2) ;BLT THE PATH
MOVEI T1,P$DPAT(AP) ;ADDRESS OF PATH BLOCK
SKIPN P$DPAT+3(AP) ;IS THERE AN SFD?
MOVE T1,P$DPAT+2(AP) ;NO, LOAD THE PPN
MOVEM T1,P$DUUO+.RBPPN(AP) ;AND SAVE IN THE UUO BLOCK
MOVEI T1,MAXUUO ;GET THE SIZE OF THE BLOCK
MOVEM T1,P$DUUO+.RBCNT(AP) ;AND SAVE IT IN RIBCNT
MOVX T1,FO.PRV+.FORED+<DSK>B17 ;FILOP SETUP
MOVEM T1,P$DFLP+.FOFNC(AP) ;STORE THE FUNCTION WORD
MOVEI T1,.IOIMG ;USE IMAGE MODE
MOVEM T1,P$DFLP+.FOIOS(AP) ;SAVE IOS
SKIPN T1,.FDSTR(N) ;GET THE STRUCTURE
MOVSI T1,'DSK' ;GUARD AGAINST CONKLIN
MOVEM T1,P$DFLP+.FODEV(AP) ;AND SAVE IT
MOVEI T1,P$DBRH(AP) ;LOAD ADR OF BUFFER RING HDR
MOVEM T1,P$DFLP+.FOBRH(AP) ;AND STORE IT
MOVEI T1,DSKBN ;NUMBER OF INPUT BUFFERS
MOVEM T1,P$DFLP+.FONBF(AP) ;STORE IT
MOVEI T1,P$DUUO(AP) ;ADDRESS OF THE LOOKUP BLOCK
MOVEM T1,P$DFLP+.FOLEB(AP) ;AND STORE IT
MOVE T4,P$BDSK(AP) ;GET ADR OF BUFFERS
EXCH T4,.JBFF ;AND SAVE IT AS JOBFF
MOVEI T1,P$DFLP(AP) ;LOAD ADR OF FILOP BLOCK
HRLI T1,6 ;LOAD THE LENGTH
FILOP. T1, ;GET THE FILE
JRST [MOVEM T4,.JBFF ;RESTORE JOBFF
JRST FILFAI] ;TYPE MESSAGE AND GO ON
MOVEM T4,.JBFF ;RESTORE JOBFF
TXNE S,ABORT ;HAVE WE KILLED HIM?
JRST DISPOS ;YES, CLEAN UP SOME
LOAD T1,.FPINF(QP),FP.IGN ;HAS THIS FILE BEEN REMOVED?
JUMPN T1,DISPOS ;JUMP IF YES!!
LOAD T1,.FPINF(QP),FP.SPL ;IS IT SPOOLED?
JUMPN T1,FILE.7 ;YES, DON'T CHKACC
LOAD T1,.FPINF(QP),FP.DEL ;GET FILE DISPOSITION
HRLI T2,.ACRED ;ASSUME JUST READ
SKIPE T1 ;IS IT DELETE?
HRLI T2,.ACREN ;YES, SEE IF WE CAN RENAME
HLRZ T3,P$DUUO+.RBPRV(AP) ;LOAD IN THE PRIV BITS
LSH T3,-^D9 ;RIGHT JUSTIFY
HRR T2,T3 ;AND COPY INTO T2
MOVE T3,P$DUUO+.RBPPN(AP) ;GET FILES DIRECTORY
TLNN T3,-1 ;LEFT HALF 0?
MOVE T3,2(T3) ;YES, GET PPN FROM PATH BLOCK.
MOVE T4,P$APPN(AP) ;USER'S PPN
MOVEI T1,T2 ;ADDRESS OF BLOCK
CHKACC T1, ;CAN WE READ THIS FILE
SKIPA ;FAILED, ASSUME NO ACCESS
JUMPE T1,FILE.7 ;YES. IF I CAN DELETE I CAN READ
HRLI T2,.ACRED ;TRY JUST READ ACCESS
MOVEI T1,T2 ;AND SETUP TO TRY AGAIN
CHKACC T1, ;DO IT,
SKIPA ;FAILED!!
CLEAR T2, ;SET UP A ZERO
STORE T2,.FPINF(QP),FP.DEL ;CLEAR THE DELETE BIT
JUMPE T1,FILE.7 ;GO ON IF WE CAN
MOVEI T1,ERPRT% ;ELSE, LOAD AN ERROR CODE
FILFAI: PUSHJ P,FILERR ;PRINT A HEADER AND ERROR MESSGE
JRST FIXQP ;AND ON TO THE NEXT FILE
FILE.7: MOVE T1,.EQJOB(AP) ;GET THE JOB NAME
SKIPE MSGFIL ;SKIPE IF NOT MESSAGE/FILE
TELL OPR,MESS1 ;GIVE A START MESSAGE
LOAD T1,.FPINF(QP),FP.FCY ;GET NUMBER OF COPIES
MOVEM T1,LPCOPY ;STORE IT
PUSHJ P,COPY ;DO THE COPY LOOP
TXNE S,RQB ;WERE WE REQUEUED?
JRST ENDJ ;YES, GO FINISH UP
CLEARM CHKCOP ;ELSE, CLEAR THE COPIES WORD
AOS CHKFIL ;CHALK UP ANOTHER FILE
DISPOS: LOAD T1,.FPINF(QP),FP.DEL ;GET THE DELETE BIT
LOAD T2,.FPINF(QP),FP.SPL ;GET THE SPOOL BIT
JUMPN T2,FILE.9 ;IF SPOOLED, DELETE IMMEDIATELY
SKIPE T1 ;/DELETE?
TXNE S,ABORT ;YES, WAS THE JOB ABORTED?
JRST FIXQP ;YES, DON'T DELETE IF ABORTED
FILE.9: CLEARB T1,T2 ;START MAKING A DELETE BLOCK
CLEARB T3,T4 ; " " " "
RENAME DSK,T1 ;DELETE THE FILE
JFCL ;WE TRIED!!
FIXQP: CLOSE DSK,100 ;CLOSE AND GIVE UP THE A.T.
RELEAS DSK, ;RELEASE THE CHANNEL
SOSG P$RFLN(AP) ;DECREMENT FILE COUNT
JRST ENDJ ;WE ARE DONE!!
PUSHJ P,TAKCHK ;TAKE A CHECKPOINT!!
LOAD T1,.FPSIZ(QP),FP.FHD ;GET SIZE OF THE FP
LOAD T2,.FPSIZ(QP),FP.FFS ;GET SIZE OF THE FD
ADDM T1,P$XSQP(AP) ;AND START BUMPING QP
ADDM T2,P$XSQP(AP) ;WITH BOTH
JRST FILE ;AND GET THE NEXT FILE
SUBTTL Per Copy Loop
COPY: ON S,DSKOPN ;DISK I/O ACTIVE
PUSHJ P,HEAD ;PUT ON A HEADER
USETI DSK,1 ;MAKE SURE WE ARE AT THE TOP
MOVEI T1,MAXERR ;NUMBER OF I/O ERROR BEFORE QUITTING
MOVEM T1,P$DERR(AP) ;STORE IN DFCB
PUSHJ P,FILOUT ;PRINT THE FILE
TXNE S,RQB ;REQUEUED?
POPJ P, ;YES, RETURN
PUSHJ P,TAIL ;PUT ON A TRAILER
OFF S,DSKOPN ;SPOOLER IDLE
TXNE S,ABORT ;DID HE HIT HIS LIMIT?
POPJ P, ;YES, FINISH HIM OFF
AOS CHKCOP ;INCREMENT COPIES WORD
SOSG LPCOPY ;DECR COPIES TO DO
POPJ P, ;DONE, RETURN
PUSHJ P,TAKCHK ;TAKE A CHECKPOINT
JRST COPY ;AND LOOP
SUBTTL End of Job
ENDJ: OFF S,DSKOPN ;TURN OFF UN-IDLE BIT
MOVEI T1,.FACT ;GET CORRECT DAEMON FUNCTION
MOVEM T1,P$AFNC(AP) ;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,P$AHED(AP) ;AND STORE IN FACT BLOCK
HRROI T1,.GTTIM ;RUNTIME
GETTAB T1, ;GET FROM MONITOR
SETZ T1, ;FAILED???
ADDB T1,P$ARTM(AP) ;ADD TO -VE START TIME
IMULI T1,^D1000 ;CONVERT TO MILLI-JIFFIES
IDIV T1,JIFSEC ;AND THEN TO MILLI-SECONDS
MOVEM T1,P$ARTM(AP) ;AND STORE AGAIN
HRROI T1,.GTKCT ;GET THE NUMBER OF KCT'S
GETTAB T1, ; FROM THE MONITOR
SETZ T1, ;FAILED!!!
ADDB T1,P$ACTI(AP) ;COMPUTE ELAPSED KCT'S
IMULI T1,144 ;CONVERT TO CENTI-JIFFIES
IDIV T1,JIFSEC ;CONVERT TO CENTI-SECONDS
MOVEM T1,P$ACTI(AP) ;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,P$ADRD(AP) ;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,P$ADWT(AP) ;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
HLLZ T1,P$LGDV(AP) ;GET GENERIC DEVICE NAME
TLZ T1,77 ;AND ZAP LAST CHARACTER
IOR T1,T2 ;MUSH TOGETHER
MOVEM T1,P$AQUE(AP) ;SAVE FOR FACT ENTRIES
IFN FACTSW,<
SKIPN FACTFL ;CAN WE CALL THE DAEMON?
JRST ENDJ.1 ;NO!!
MOVSI N,14 ;GET THE BLOCK LENGTH IN LH
HRRI N,P$AFNC(AP) ;AND THE ADDRSS IN RH
DAEMON N, ;ACTIVATE THE DAEMON
JFCL ;IGNORE THAT
> ;END OF IFN FACTSW
ENDJ.1: MOVEI T1,RELBLK ;LOAD ADDRESS OF RELEASE BLOCK
TXNN S,RQB ;DON'T SEND REL IF WE HAVE REQ'D
PUSHJ P,SNDQSR## ;SEND IT
PUSH P,P$ADEV(AP) ;SAVE DEVICE NAME
SETZM P$AFNC(AP) ;ZERO THE FIRST WORD
MOVSI T1,P$AFNC(AP) ;GET ADDRESS OF FIRST WORD
HRRI T1,P$AFNC+1(AP) ;AND SECOND WORD
BLT T1,P$AEND(AP) ;CLEAR THE TRACES
POP P,P$ADEV(AP) ;RESTORE THE DEVICE NAME
JRST MAIN ;AND LOOP TO THE BEGINNING
;SUBROUTINE TO PRINT A LOOKUP/ENTER/RENAME ERROR MESSAGE
;CALL WITH:
; MOVE T1,ERROR CODE
; PUSHJ P,LERCOD
;
;CALL "FILERR" TO PRINT A FILE HEADER FIRST
FILERR: PUSH P,T1 ;SAVE T1
PUSHJ P,HEAD ;PRINT A FILE HEADER
POP P,N ;RESTORE CODE INTO N
SKIPA ;SKIP ALTERNATE ENTRY
MOVE N,T1 ;COPY ERROR CODE INTO N
TELL USR,[ASCIZ /?LOOKUP ERROR &/]
SKIPE MSGERR ;DOES OPR WANT TO SEE?
TELL OPR,%%CAF
POPJ P, ;AND RETURN
;SUBROUTINE TO INIT THE OUTPUT DEVICE
; PUSHJ P,GETLPT
; RETURN HERE WITH DEVICE
;
GETLPT: MOVE T1,P$LSTS(AP) ;FILE STATUS
MOVE T2,HELPDV ;OUTPUT DEVICE NAME
MOVSI T3,P$LBRH(AP) ;BUFFER HEADER
OPEN DCH,T1 ;INIT THE DEVICE
JRST [TELL OPR,DEVBSY
JRST DOREST] ;LOSE
MOVE T1,P$LDVI(AP) ;GET DEVICE INDEX
SKIPE T1,[EXP 0,1400,600](T1) ;GET BYTE SIZE
MOVSM T1,P$LBPT(AP) ;SAVE IF NON-ZERO
MOVE T1,P$LDVI(AP) ;GET DEVICE INDEX
CAIE T1,D%CDP ;IS IT THE CARD-PUNCH?
JRST GETLP ;NO, SKIP THIS STUFF
MOVE T1,P$LCHR(AP) ;GET DEVICE CHARACTERISTICS
OFF S,ISCDP ;ASSUME NOT A CDP
ANDI T1,TY.DEV ;AND DOWN TO DEVICE TYPE
CAIN T1,.TYCDP ;IS IT A CDP?
ON S,ISCDP ;IT'S A REAL CDP!!
;HERE TO SETUP ALL THE BUFFER INFO
GETLP: PUSHJ P,.SAVE1## ;SAVE P1
CLEAR S1, ;ZERO BUFFER OFFSET
MOVEM S1,P$BDSK(AP) ;SAVE AS DSK BUFFER OFFSET
ADDI S1,<DSKBN*203> ;ADD IN SIZE OF DSK BUFFERS
MOVEM S1,P$BLPT(AP) ;SAVE AS DEVICE BUFFER OFFSET
ADD S1,P$BLPS(AP) ;ADD IN SIZE OF DEVICE BUFFERS
ADDI S1,777 ;ROUND UP TO A PAGE
LSH S1,-^D9 ;AND CONVERT TO PAGES
MOVEM S1,P$BNUM(AP) ;SAVE NUMBER OF PAGES
MOVE P1,AP ;SAVE AP
PUSHJ P,M$AQNP## ;GET THE PAGES
MOVEM AP,P$BPAG(P1) ;SAVE THE PAGE NUMBER
EXCH AP,P1 ;FLIP AP AND P1
LSH P1,^D9 ;MAKE AN ADDRESS
ADDM P1,P$BDSK(AP) ;MAKE ABS DSK BUFFER ADR
ADDB P1,P$BLPT(AP) ;AND DEVICE BUFFER ADR
EXCH P1,.JBFF ;FUDGE JOBFF
OUTBUF DCH,DEVBN ;ALLOCATE DEVICE BUFFERS
MOVEM P1,.JBFF ;AND RESTORE JOBFF
POPJ P,0 ;RETURN
SUBTTL Message Check Routines
LOWSEG ;PLACE IN LOW SEGMENT
;THREE ROUTINES ARE USED TO CHECK FOR VARIOUS MESSAGES:
; CHKALL -- CHECKS FOR BOTH OPERATOR TYPEIN AND IPCF MESSAGES
; CHKOPR -- CHECKS FOR OPERATOR TYPE IN
; CHKQUE -- CHECKS FOR IPCF MESSAGES
;LOCATION "MESSAG" IS RETURNED WITH THE ADDRESS OF ANY MESSAGE RECEIVED.
CHKALL: PUSHJ P,CHKSEG ;CHECK TO SEE IF WE HAVE A HISEG
PUSHJ P,CHKOP0 ;SEE IF OPR WANTS SOMETHING
PUSHJ P,CHKQU0 ;SEE IF ANYTHING'S IN THE QUEUE
POPJ P, ;AND RETURN
;CHKSEG REMEMBERS WHETHER WE HAVE A HIGH-SEG AROUND OPR COMMANDS
; PROCESSING AND IPCF MESSAGE PROCESSING. IT TREATS IT'S
; CALLER AS A CO-ROUTINE, SO WE ALWAYS RETURN THROUGH CODE
; TO RESTORE THE HISEG TO IT'S ORIGINAL STATE
;
CHKSEG: SETZM OLDSEG ;ASSUME NO HISEG IS THERE
SKIPE .JBHRL ;IS THERE ONE?
SETOM OLDSEG ;YES, REMEMBER IT
EXCH S1,0(P) ;SAVE S1 AND LOAD RETURN PC
PUSH P,S2 ;SAVE S2
PUSHJ P,(S1) ;AND CALL MY CALLER
;GET HERE WHEN THE CALLER POPJS
POP P,S2 ;RESTORE S2
POP P,S1 ;RESTORE S1
SKIPN OLDSEG ;WAS THERE A HISEG?
PJRST CLRSEG ;NO, CLEAR IT
POPJ P, ;YES, LEAVE IT THERE
CHKOPR: PUSHJ P,CHKSEG ;CHECK THE HISEG
CHKOP0: ;ENTER HERE FROM CHKALL
MOVEI S1,0 ;LOAD A 0
EXCH S1,TTYFLG ;LOAD TTYFLG AND ZERO IT
JUMPE S1,.POPJ## ;RETURN IF NOTHING THERE
SKPINL ;ELSE, CHECK
POPJ P, ;NOTHING THERE FOR REAL
PUSHJ P,GETSPL ;GET THE HISEG
PUSHJ P,SAVALL ;SAVE ALL ACS
CHKOP1: PUSHJ P,COMIN ;DO ONE COMMAND
SKPINL ;IS THERE ONE?
POPJ P, ;NO, RETURN
JRST CHKOP1 ;YES, GET ANOTHER COMMAND
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: PUSHJ P,SAVALL ;SAVE THE T REGS
CAIE S2,.QOABO ;IS IT ABORT??
POPJ P, ;NO, IGNORE ANYTHING ELSE
PUSHJ P,GETSPL ;YES, GET THE HISEG
PJRST USRKIL ;AND KILL OFF THE JOB
SUBTTL ROUTINE TO GET MY HISEG
;SUBROUTINE TO GET THE SPOOLER HISEG
;CALL WITH:
; PUSHJ P,GETSPL
; RETURN HERE
;
GETSPL: SKIPE .JBHRL ;SKIPE IF NO HISEG
POPJ P, ;ELSE SKIP SEGCON
PUSHJ P,SAVALL ;SAVE THE AC'S
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
POPJ P, ;RETURN
;SUBROUTINE TO CLEAR A HIGH SEGMENT
;CALL WITH
; PUSHJ P,CLRSEG
; RETURN HERE
;
CLRSEG: SKIPN .JBHRL ;IS THERE A HISEG TO DELETE?
POPJ P, ;NO, DON'T DELETE IT
PUSH P,T1 ;SAVE T1
MOVSI T1,1 ;SET SIZE OF HISEG TO 1 WORD
SETZM .JBHRL ;SEGCON SHOULD CLEAR THIS WORD BUT
; IT HAS A BUG AND ONLY CLEARS RH
CORE T1, ;CALL CORE0
JFCL ;IGNORE ANY ERROR
POP P,T1 ;RESTORE T1
POPJ P, ;IGNORE SUCCESS
SUBTTL COMMAND TABLES AND DISPATCHER
;FLAG BITS
BIT T2,IOACT, ;DISK FILE MUST BE OPEN
BIT T2,NOMWT, ;MUST NOT BE IN MOUNT WAIT
;COMMANDS
DEFINE NAMES,<
C EXIT,XITCOM,0
C MESSAGE,MESSGE,0
C STOP,STOP,0
C KILL,KILL,IOACT
C FORMS,FIXFRM,0
C GO,GO,0
C TAPE,TAPCOM,0
C CARDS,CARCOM,0
C PLOT,PLOCOM,0
C RESET,RESETC,0
C REQUEU,REQUE,IOACT
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,IOACT
C NEXT,NXTCOM,0
C HELP,HELP,0
C FREEZE,FREEZE,0
C UNFREE,UNFREE,0
C REPRIN,REPRNT,IOACT!NOMWT
C SKPFIL,SKPFIL,IOACT!NOMWT
C SKPCOP,SKPCOP,IOACT!NOMWT
> ;END OF NAMES MACRO
;TABLES
DEFINE C(A,B,C),<
XALL
<SIXBIT /A/>
SALL
>
TOPSEG
COMTAB: NAMES
DEFINE C(A,B,D),<
EXP D+B
>
DSPTAB: NAMES
DISPL=.-DSPTAB
SALL ;BACK TO SHORT FORM
UUMASK==TELOPR!TELUSR ;UUO BITS
;ALL IN THE LH
;HERE WHEN A COMMAND HAS BEEN TYPED
COMIN: PUSHJ P,.SAVE1## ;SAVE P1
CLEARM LPNOP ;YES VIRGINIA, THERE IS AN OPERATOR
MOVE C,SAVCHR ;GET THE CHAR WE ARE HOLDING
CAIN C,"C"-100 ;IS IT A CONTROL-C
JRST [MONRT.
JRST SETINT] ;YES, EXIT
CAIN C,"Z"-100 ;A CONTROL Z?
JRST XITCOM ;YES-- ^C OR ^Z IMPLIES EXIT.
SKPINL ;MAKE SURE COMMAND REALY TYPED
POPJ P, ; NOT ^C CONT.
MOVSI T1,(UUMASK) ;BITS TO SAVE AROUND COMMAND
AND T1,S ;EXTRACT THE BITS
TLZ S,(UUMASK) ;CLEAR THE BITS
MOVEM T1,UUSAVE# ;SAVE THEM.
PUSHJ P,SIXIN ;GET COMMAND
PJRST CUE ;NULL COMMAND
CAIE C," " ;IF THE TERM. WAS NOT A BLANK
MOVEM C,SAVCHR ; SAVE FOR NEXT TIME
CAIN C,12 ;IF TERM WAS LINE FEED
SETZM SAVCHR ; CLEAR TYPE AHEAD.
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 T4,0 ;CLEAR FLAGS
MOVSI T2,-DISPL ;SET UP LENGTH OF TABLE
COMLP: MOVE P1,COMTAB(T2) ;GET A COMMAND
CAMN P1,T1 ;AN EXACT MATCH?
JRST COMFND ;YES. THIS IS IT
TDZ P1,T3 ;CLEAR PART NOT TYPED
CAME P1,T1 ;PARTIAL MATCH
JRST COMNEQ ;NO. TRY NEXT
TROE T4,1 ;FIRST OCCURENCE
JRST NOCOM ;NO. CAN'T BE UNIQUE
MOVE N,T2 ;YES. SAVE INDEX
COMNEQ: AOBJN T2,COMLP ;ANY MORE COMMANDS
JUMPE T4,NOCOM ;NO. EXACTLY 1 MATCH
MOVE T2,N ;YES. COPY INDEX
COMFND: MOVE T2,DSPTAB(T2) ;GET ADDRESS AND BITS
IFOFF S,MNTBIT,CMCK2A ;ARE WE IN MOUNT WAIT?
IFON T2,NOMWT,CMSG2C ;YES, CAN WE HAVE IT
CMCK2A: IFOFF T2,IOACT,CMCK3A ;SHOULD I/O BE GOING
IFOFF S,DSKOPN,CMSG2B ;IS IT GOING?
CMCK3A: PUSHJ P,(T2) ;NO. RETURN HERE AFTER COMAND
LOGIT: PUSHJ P,TYI ;PLACE REST OF LINE IN BUFFER
CAIE C,12 ;ANYTHING LEFT
JRST LOGIT ;STILL MORE TO COME
JRST CUE ;WAKE UP THE OPERATOR
NOCOM: TELL OPR,BADCOM ;NOT UNIQUE
CLRBFI ;FLUSH REST OF LINE
PJRST CUE ;RETURN
CMSG2B: TXNE S,MNTBIT
JRST CMCK3A
CMSG2C: TELL OPR,NOTBSY
JRST CUEC
CUEC: CLRBFI ;EDIT 150
CUE: IFON S,RUNB ;IF RUN IS ON
TELL OPR,EXCLPT ; TYPE A !
IFOFF S,RUNB ;IF RUN IS OFF
TELL OPR,STAR ; TYPE A *
TDZ S,[UUMASK+SOME] ;CLEAR SAVED BITS
IOR S,UUSAVE ;PUT BACK ANY NEEDED
POPJ P,
SUBTTL Processing Commands -- TAPE,CARD,PLOT
TAPCOM: MOVEI T1,D%PTP ;GET DEVICE INDEX
MOVEM T1,P$LDVI(AP) ;AND SAVE IT
MOVSI T1,'PTP' ;GET GENERIC DEVICE NAME
MOVEM T1,P$LGDV(AP) ;SAVE IT
JRST START ;AND GO DO COMMON STUFF
CARCOM: MOVEI T1,D%CDP ;GET DEVICE INDEX
MOVEM T1,P$LDVI(AP) ;SAVE IT
MOVSI T1,'CDP' ;GET GENERIC DEVICE NAME
MOVEM T1,P$LGDV(AP) ;SAVE IT
JRST START ;AND GO DO COMMON STUFF
PLOCOM: MOVEI T1,D%PLT ;GET DEVICE INDEX
MOVEM T1,P$LDVI(AP) ;SAVE IT
MOVSI T1,'PLT' ;GET GENERIC DEVICE NAME
MOVEM T1,P$LGDV(AP) ;SAVE IT
JRST START ;AND DO COMMON STUFF
;COMMON CODE TO START UP A SPOOLER
START: TXNN S,OPENB ;HAVE WE BEEN STARTED ALREADY?
JRST START0 ;NO, CONTINUE
SKIPN XITFLG ;IS THERE A PENDING EXIT?
SKIPE RSTFLG ;OR A PENDING RESET?
JRST STARTA ;YES, CLEAR IT
TXZN S,PAUSEB ;NO, PENDING PAUSE?
JRST STARTB ;NO, GIVE AN ERROR
STARTA: TELL OPR,%%CPC ;TELL HIM
SETZM XITFLG ;CLEAR EXIT
SETZM RSTFLG ;AND RESET
POPJ P, ;AND RETURN
STARTB: TELL OPR,%%SAS ;TELL HIM
POPJ P, ;AND RETURN
START0: PUSHJ P,SIXIN ;GET A DEVICE NAME
MOVE T1,P$LGDV(AP) ;DEFAULT TO GENERIC DEVICE
MOVEM T1,P$LGNM(AP) ;SAVE THE GIVEN NAME
DEVNAM T1, ;GET THE REAL NAME
JRST NOSDEV ;NO SUCH DEVICE
MOVEM T1,HELPDV ;STORE REAL DEVICE NAME
MOVEM T1,HELSDV ;AND AS SCHEDULING DEVICE
MOVEM T1,P$ADEV(AP) ;AND IN FACT ENTRY ALSO
DEVTYP T1,UU.PHY ;GET ITS DEVTYP
JRST NOSDEV ;NO SUCH DEVICE?
MOVEM T1,P$LCHR(AP) ;AND STORE IT
TXNN T1,TY.SPL ;IS IT SPOOLED?
JRST START1 ;NO, CONTINUE
MOVE T1,P$LGNM(AP) ;GET THE NAME
TELL OPR,%%DIS ;TELL OPR
POPJ P, ;AND RETURN
START1: CAIE C,"=" ;DID HE SAY DEV=DEV?
JRST START2 ;NO SCAN AHEAD
PUSHJ P,SIXIN ;YES, GET THE DEVICE
MOVE T1,P$LGDV ;DEFAULT TO GENERIC DEVICE
MOVEM T1,HELSDV ;STORE IT
JRST START3 ;AND CONTINUE
START2: PUSHJ P,SIXIN ;SCAN AHEAD
JFCL ;THAT'S OK
CAIN C,"=" ;FIND AN EQUAL?
JRST START1 ;YES, LOOP AROUND
START3: MOVEI T1,.IOIMG ;LOAD THE MODE
TXO T1,UU.PHS ;SET PHYSICAL OPEN
MOVEM T1,P$LSTS(AP) ;STORE DEVICE STATUS
;"START" IS CONTINUED ON THE NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
ON S,OPENB ;WE ARE STARTED!!
START4: HLLZ T1,HELSDV ;GET SCHEDULING DEVICE
CAMN T1,P$LGDV(AP) ;IS IT THE CORRECT TYPE?
JRST START5 ;YES, CONTINUE
CLRBFI ;CLEAR ANY TYPEAHEAD
MOVE T1,P$LGDV(AP) ;NO, GET CORRECT TYPE
TELL OPR,[ASCIZ /Specified device is not a +
What device do you want to schedule jobs for: /]
INCHWL SAVCHR ;WAIT FOR SOMETHING
PUSHJ P,SIXIN ;AND GET A DEVICE
JFCL ;IGNORE THIS
MOVEM T1,HELSDV ;STORE IT
JRST START4 ;AND LOOP
START5: PUSHJ P,SETHEL ;SETUP HELLO BLOCK
MOVEI T1,HELBLK ;LOAD ADR OF BLOCK
PUSHJ P,SNDQSR## ;AND SEND IT
MOVE T1,P$LSTS(AP) ;GET IO MODE
MOVE T2,HELPDV ;AND DEVICE NAME
MOVEI T3,T1 ;LOAD ARG
DEVSIZ T3, ;FOR DEVSIZ
JRST NOSDEV ;???
MOVEI T1,DEVBN ;LOAD NUMBER OF BUFFERS
IMULI T1,(T3) ;GET TOTAL NUMBER OF WORDS
MOVEM T1,P$BLPS(AP) ;AND SAVE
PUSHJ P,GETLPT ;INIT THE DEVICE
SETOM HNGCNT ;CLEAR THE HUNG COUNTER
PJRST GO ;AND GIVE A FREE GO
NOSDEV: MOVE T1,P$LGNM(AP) ;GET THE GIVEN NAME
TELL OPR,%%DDE ;DOES NOT EXIST
POPJ P,
SUBTTL Operator Commands -- HELP - MLIMIT - EXIT - CHECKPOINT
;SUBROUTINE TO TYPE THE HELP TEXT
;CALL WITH:
; PUSHJ P,HELP
; RETURN HERE
;
HELP: MOVE S1,['SPROUT'] ;FILE TO READ
PUSHJ P,.HELPR## ;GO TYPE IT OUT
POPJ P,
;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,MLIM ;STORE AWAY
PJRST SNDSTC ;SEND A STATUS CHANGE AND RETURN
;SUBROUTINE TO EXIT FROM SPOOLER
;CALL WITH:
; PUSHJ P,XITCOM
; RETURN ONLY IF ERROR
;
XITCOM: SETOM XITFLG ;SET THE EXIT FLAG
TXNE S,DSKOPN ;ARE WE BUSY?
POPJ P, ;YES, DEFER IT
DOEXIT: PUSHJ P,SETHEL ;SETUP HELLO BLOCK
MOVX T1,HELBYE!HELSTC;GOODBYE+STATUS CHANGE
MOVEM T1,HELSTS ;STORE THEM
MOVEI T1,HELBLK ;ADDRESS OF BLOCK
PUSHJ P,SNDQSR## ;SEND IT
RESET ;RESET ALL I/O
EXIT 1, ;MONRET
JRST SPROUT
SUBTTL Operator Commands -- LIMIT
;SUBROUTINE TO CHANGE LIMIT FOR THIS JOB ONLY
;CALL WITH:
; PUSHJ P,LIMIT
; RETURN HERE
;
LIMIT: PUSHJ P,DECARG ;GET ARGUMENT
JRST BADNBR ;OOPS
JUMPE N,LIMERR ;CAN'T BE ZERO
MOVEM N,P$RLIM(AP) ;STORE
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
;
FIXFRM: PUSHJ P,SIXIN ;GET FORM TYPE
JRST TELFTP ;NONE--TELL FORMS TYPE THEN
TXNN S,DSKOPN ;ARE WE BUSY?
JRST FIXFR0 ;NO, GO ON
TELL OPR,%%CCF ;YES, TELL HIM
POPJ P, ;AND RETURN
FIXFR0: TXNE S,MNTBIT ;JUMP IF WE ARE IN MOUNT WAIT
JRST FIXFR1
MOVEM T1,P$FORM(AP) ;STORE THE NEW VALUE
SKIPA ;AND SKIP
FIXFR1: MOVEM T1,P$FPFM(AP) ;SAVE AS OLD FORMS IF WE ARE IN MOUNT WAIT
PUSHJ P,SNDSTC ;SEND A STATUS CHANGE
TELFTP: MOVE T1,P$FORM(AP) ;GET FORMS TYPE
IFON S,MNTBIT ;IF WE ARE IN MOUNT WAIT,
MOVE T1,P$FPFM(AP) ; THEN GET OLD FORMS
TELL OPR,FTYPE ;TELL THE TYPE
POPJ P,
SUBTTL Operator Commands -- KILL
;SUBROUTINE TO KILL AN ENTRY
;CALL WITH
; PUSHJ P,KILL
; RETURN HERE
;
KILL: IFOFF S,MNTBIT,KILL1 ;GOTO KILL1 IF NOT IN MOUNT WAIT
MOVE T1,P$FPFM(AP) ;ELSE, LOAD OLD FORMS
MOVEM T1,P$FORMS(AP) ;AND SAVE AS CURRENT
USRKIL: ;ENTER HERE ON RECEIPT OF ABORT MESSAGE
KILL1: PUSHJ P,SETEOF ;CAUSE EOF TO HAPPEN
ON S,ABORT ;SET ABORT FLAG
IFON S,MNTBIT,GO ;FORCE A GO IF IN MOUNT WAIT
POPJ P, ;ELSE JUST RETURN
SUBTTL Operator Commands -- GO
;SUBROUTINE TO CONTINUE FROM STOP/PAUSE
;CALL WITH:
; PUSHJ P,GO
; RETURN HERE
;
GO: ON S,RUNB
POPJ P,
;SUBROUTINE TO WAIT FOR OPR TO TYPE GO
;CALL WITH:
; PUSHJ P,GOWAIT
; RETURN HERE WHEN RUNNABLE
;
GOWAIT: INCHWL SAVCHR ;INPUT A CHAR
PUSHJ P,COMIN ;PROCESS COMMAND
IFOFF S,RUNB,GOWAIT ;WAIT IF NOT GO
POPJ P, ;RETURN
SUBTTL Operator Commands -- REPRINT - SKPCOPY - SKPFILE
;REPRINT -- ROUTINE TO START THE CURRENT COPY OF THE CURRENT
; FILE OVER AGAIN.
;CALL WITH:
; PUSHJ P,REPRNT
; RETURN HERE
;
REPRNT: AOS LPCOPY ;INCREMENT COPY COUNT
JRST SKPCOP ;AND MAKE AN END-OF-FILE
;SKPCOP -- ROUTINE TO START THE NEXT COPY OF THE CURRENT FILE
;CALL WITH:
; PUSHJ P,SKPCOP
; RETURN HERE
;
SKPCOP: PUSHJ P,SETEOF ;CAUSE AN EOF
IN DSK, ;CLEAR BUFFERING AHEAD
JRST .-1 ;KEEP UP UNTIL IT FAILS
OUTPUT DCH, ;CLEAR THE OUTPUT BUFFER
POPJ P, ;AND RETURN
;SKPFIL -- ROUTINE TO START THE NEXT FILE
;CALL WITH:
; PUSHJ P,SKPFIL
; RETURN HERE
;
SKPFIL: PUSHJ P,SETEOF ;CAUSE AN EOF
MOVEI T1,1 ;LOAD A PAGE NUMBER
MOVEM T1,LPCOPY ;SAVE IT
POPJ P, ;AND RETURN
SUBTTL Operator Commands -- PAUSE - (UN)LOCK - (UN)FREEZE
;SUBROUTINE TO CAUSE A STOP AFTER THIS JOB
;CALL WITH:
; PUSHJ P,PAUSE
; RETURN HERE
;
PAUSE: ON S,PAUSEB ;SET FLAG
PUSHJ P,SETHEL ;SETUP A HELLO BLOCK
MOVE T1,HELSTS ;GET STATUS WORD
TXO T1,HELSTC ;MAKE IT A STATUS CHANGE
TXZ T1,HELSCH ;TURN OFF SCHEDULING
MOVEM T1,HELSTS ;STORE IT
MOVEI T1,HELBLK ;LOAD ADDRESS
PJRST SNDQSR## ;SEND IT AND RETURN
;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
;ROUTINE TO ACTUALLY DO A PAUSE. CALLED FROM MAIN LOOP.
;
DOPAUS: TELL OPR,[ASCIZ ?![SPROUT is PAUSEing on $!]
/?]
OFF S,PAUSEB ;CLEAR PAUSE FLAG
OFF S,RUNB ;TURN OFF RUN FLAG
PUSHJ P,GOWAIT ;AND GO WAIT
PUSHJ P,SETHEL ;(HE TYPED GO) SETUP HELLO BLOCK
MOVX T1,HELSTC!HELSCH;TURN ON STATUS CHANGE AND SCHEDULING
IORM T1,HELSTS ;AND SET THEM
MOVEI T1,HELBLK ;GET ADDRESS
PJRST SNDQSR## ;SEND IT 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
POPJ P, ;AND RETURN
SUBTTL Operator Commands -- CURRENT
;SUBROUTINE TO GIVE THE CURRENT DEFAULTS
;CALL WITH:
; PUSHJ P,CURDEF
; RETURN HERE
;
CURDEF: MOVE N,MLIM ;PICK UP MLIMIT
TELL OPR,CURMS1 ;GIVE THE FIRST MESSAGE
TELL OPR,[ASCIZ /Messages on:/]
SKIPE T1,MSGFIL ;FILE?
TELL OPR,[ASCIZ / FILE/]
SKIPE T2,MSGERR ;ERRORS?
TELL OPR,[ASCIZ / ERRORS/]
ADD T1,T2 ;ADD IN ERROR
SKIPN T1 ;ANY OF THE ABOVE?
TELL OPR,[ASCIZ / No Conditions/]
TELL OPR,CRLF ;AND AN EOL
POPJ P,
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
POPJ P, ;RETURN
SUBTTL Operator Commands -- REQUEUE
;SUBROUTINE TO REQUEUE AN ENTRY
;CALL WITH:
; PUSHJ P,REQUE
;
REQUE: IFOFF S,MNTBIT,REQUE1 ;ARE WE IN MOUNT WAIT?
MOVE T1,P$FPFM(AP) ;YES, LOAD OLD FORMS
MOVEM T1,P$FORM(AP) ;AND STORE
PUSHJ P,SNDSTC ;AND SEND A STAUS CHANGE
MOVE T1,[REQBLK+2,,REQBLK+3]
CLEARM REQBLK+2 ;CLEAR THE FIRST WORD
BLT T1,REQBLK+REQ.SZ-1 ;CLEAR THE REST
MOVEI T1,5 ;/AFTER:5 IS DEFAULT
MOVEM T1,REQAFT ;STORE IT
REQUE1: PUSHJ P,DOSW ;SCAN FOR A /
JRST REQUE2 ;FOUND ALL SWITCHES
ACTCHR A,RQAFT ;AFTER
ACTCHR H,RQHOLD ;HOLD
ACTCHR C,RQCUR ;CURRENT
ACTCHR T,RQTOP ;TOP OF JOB
TELL OPR,BADSW ;BAD SWITCH
POPJ P, ;PUNT THE COMMAND
RQHOLD: MOVEI T1,^D720 ;12 HOURS (720 MINUTES)
MOVEM T1,REQAFT ;NEW AFTER PARAM
JRST REQUE1 ;DO NEXT SWITCH
RQAFT: PUSHJ P,FNDELM ;GET THE DELIMITER
SKIPA ;NONE
PUSHJ P,DECARG ;GET THE NUMBER
MOVEI N,^D30 ;ASSUME 30 MIN.
MOVEM N,REQAFT ;STORE AWAY
JRST REQUE1 ;LOOP FOR MORE COMPLEX STUFF
RQTOP: CLEARM REQFIL ;CLEAR THE FILE WORD
CLEARM REQCOP ;CLEAR THE COPY WORD
JRST REQUE1 ;LOOK FOR MORE SWITCHES
RQCUR: PUSHJ P,SETCUR ;SET CURRENT
JRST REQUE1 ;AND GET NEXT SWITCH
REQUE2: MOVEI T1,REQBLK ;ADR OF REQUEUE BLOCK
PUSHJ P,SNDQSR## ;SEND IT TO QUASAR
ON S,RQB ;SET REQUEUE BIT
PUSHJ P,SETEOF ;CAUSE AN EOF TO HAPPEN
TXNE S,MNTBIT ;IN MOUNT WAIT?
JRST GO ;FORCE A "GO"
POPJ P, ;RETURN
SETCUR: MOVE T1,CHKCOP ; REQUEUE BLOCK FOR
MOVEM T1,REQCOP ; REQUEUE/CURR
MOVE T1,CHKFIL
MOVEM T1,REQFIL
POPJ P, ;AND RETURN
SUBTTL Operator Commands -- WHAT
;SUBROUTINE TO GIVE CURRENT STATUS OF SPOOLER
;CALL WITH:
; PUSHJ P,WHAT
; RETURN HERE
;
WHAT: TXNE S,MNTBIT ;WAITING FOR MOUNT?
JRST WHATA ;YES, SKIP THIS STUFF
IFON S,RQB,WHATD ;IF ENTRY HAS BEEN KILLED
; DO NOT TRY AND TALK ABOUT IT.
IFOFF S,DSKOPN,WHATC ;SKIP IF NOT ACTIVE
IFON S,ABORT,WHATD ;IF KILLED, SKIP THIS STUFF
WHATA: MOVE T1,.EQJOB(AP) ;GET JOB NAME
MOVE N,P$ASEQ(AP) ;AND SEQUENCE NUMBER
TELL OPR,WHAT1 ;AND TYPE THEM
SKIPE T1,.EQUSR(AP) ;NAME?
TELL OPR,WHAT3 ;TELL OPR
TRNN T1,77 ;WAS THE LAST CHAR OF THE FIRST WORD
; A SPACE?
TELL OPR,[ASCIZ / /] ;YES--PRINT ANOUTHER SPACE SINCE
; TRAILING SPACES ARE DELETED BY
; THE SIXBIT PRINTER
MOVE T1,.EQUSR+1(AP) ;SECOND HALF OF NAME
SKIPE .EQUSR(AP) ;PRINT IFF 1 HALF WAS PRINTED
TELL OPR,WHAT4 ; ..
TELL OPR,WHAT4A ;PRINT USERS PPN
TXNE S,MNTBIT ;IN MOUNT WAIT?
JRST WHATB ;YES, SKIP FILE STUFF
MOVE T1,P$LDVI(AP) ;GET DEVICE INDEX
MOVE N,P$APRT(AP) ;GET AMOUNT PROCESSED
TELL OPR,@WHAT6(T1) ;AND TYPE IT
MOVE N,P$RLIM(AP) ;GET LIMIT
TELL OPR,@WHAT7(T1) ;AND TYPE IT
MOVE N,CHKCOP ;GET NUMBER OF COPIES PRINTED
AOS N ;GET CURRENT COPY NUMBER
TELL OPR,WHAT8 ;AND PRINT IT
LOAD N,.FPINF(QP),FP.FCY ;GET TOTAL NUMBER OF COPIES
TELL OPR,WHAT9 ;PRINT IT
TELL OPR,WHAT10 ;TYPE THE FILE NAME
LOAD T2,.FPINF(QP),FP.DEL ;GET THE DISPOSITION
MOVX T1,'PRESER' ;ASSUME PRESERVED
SKIPE T2 ;SKIP IF PRESERVED
MOVX T1,'SPOOL ' ;YES
TELL OPR,WHAT11 ;AND PRINT IT
TELL OPR,CRLF ;TYPE A CRILIF
WHATB: MOVE T1,P$FORM(AP) ;LOAD THE FORMS TYPE
TXNN S,MNTBIT ;ARE WE IN MOUNT WAIT?
JRST WHATC ;NO, CONTINUE
TELL OPR,%%WFF ;YES, TELL HIM
JRST WHATE ;AND CONTINUE
WHATC: IFOFF S,DSKOPN ;ARE WE ACTIVE
WHATD: TELL OPR,NOTBSY
WHATE: MOVE T1,P$FORM(AP) ;GET THE FORMS NAME
TXNE S,FROZE ;ARE FORMS FROZEN?
TELL OPR,%%FAF ;YES, TELL HIM
TXNE S,OPENB ;ARE WE STARTED?
JRST WHATF ;YES, CONTINUE
TELL OPR,%%WFS ;NO, TELL HIM
POPJ P, ;AND RETURN
WHATF: SKIPL HNGCNT ;IS DEVICE HUNG?
TELL OPR,DEVOK ;HUNG--COMPLAIN
TXNN S,RUNB ;ARE WE RUNNABLE?
TELL OPR,%%SIS ;NO, STOPPED
TXNE S,PAUSEB ;WILL WE PAUSE?
TELL OPR,%%SWP ;YES TELL HIM
POPJ P, ;AND RETURN
SUBTTL Operator Commands -- STOP
;SUBROUTINE TO DO A STOP
;CALL WITH:
; PUSHJ P,STOP
; RETURN HERE WHEN RUNNABLE
;
STOP: OFF S,RUNB ;CLEAR RUN
TELL OPR,STAR ;PRINT A STAR
PJRST GOWAIT ;WAIT FOR RUN TO COME BACK ON
SUBTTL Operator Commands -- MESSAGE
MESSGE: PUSHJ P,.SAVE1## ;SAVE P1
SETZ P1, ;CLEAR ARG COUNTER
MESS.0: SETZM MSGFIL ;CLEAR FILES WORD
SETZM MSGERR ;CLEAR ERROR WORD
MESS.1: PUSHJ P,SIXIN ;GET A WORD
JRST MESS.4 ;DONE, DO SOME CHECKS AND RETURN
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 P1, ;COUNT AN ARG
HRRZ T3,MSGTBL(T4) ;GET WORD TO SET
SETZ T1, ;CLEAR THE DUMMY FOR NONE
SETOM (T3) ;SET IT
JUMPN T1,MESS.0 ;IF "NONE" COME IN THRU THE TOP
MESS.4: CAIN C,"," ;IS THERE MORE?
JRST MESS.1 ;YES, LOOP
SKIPN P1 ;DID WE GET AT LEAST ONE ARG?
SETOM MSGERR ;NO, MESSAGE ERROR IS DEFAULT
POPJ P, ;NO, RETURN
MESS.5: SETOM MSGFIL ;SET JOB
SETOM MSGERR ;SET ERROR
JRST MESS.4 ;AND CONTINUE
MSGTBL: XWD 'F',MSGFIL
XWD 'E',MSGERR
XWD 'N',T1 ;DUMMY FOR 'NONE'
MSGTLN==.-MSGTBL
SUBTTL LOWSEG Operator Commands -- RESET - CHECKPOINT
LOWSEG
;SUBROUTINE TO DO A RESET
;CALL WITH:
; PUSHJ P,RESETC
; NEVER RETURNS
;ALL AC'S REFRESHED
RESETC: SETOM DOREST ;SET RESET FLAG
TXNE S,DSKOPN ;ARE WE BUSY?
POPJ P, ;YES, MAKE IT PEND
DOREST: PUSHJ P,GETSPL ;GET THE HISEG
PUSHJ P,SETHEL ;SETUP HELLO BLOCK
MOVX T1,HELSTC!HELBYE ;GOODBYE+STATUS CHANGE
MOVEM T1,HELSTS ;STORE FLAGS
MOVEI T1,HELBLK ;LOAD ADR OF BLOCK
PUSHJ P,SNDQSR## ;SEND IT
TELL OPR,%%SIR ;LPTSPL IS RESET
JRST SPROUT
;SUBROUTINE TO TAKE A CHECKPOINT
TAKCHK: MOVEI T1,CHKBLK ;LOAD THE BLOCK ADDRESS
PJRST SNDQSR## ;AND SEND IT
SUBTTL TTY I/O Routines
TOPSEG
;SUBROUTINE TO FIND A DELIMITER (ANY OF :,=,_, OR -)
;CALL WITH:
; PUSHJ P,FNDELM
; CAN'T FIND A DELIMITER
; RETURN HERE WITH DELIMITER IN C
;
FNDELM: PUSHJ P,TYI ;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
CAIE C,"_" ;LEFT ARROW
CAIN C,"-" ; OR HYPHEN
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: PUSHJ P,SIXIN ;LOOK FOR ANOTHER WORD
JRST CHKSW ;FAILURE IS EXPECTED
TELL OPR,UNEXPD ;COMPLAIN ABOUT UNEXPECTED WORD
CHKSW: MOVSI T1,-40(C) ;COPY IN CASE IT IS WRONG
LSH T1,14 ;PUT AT END OF WORD
CAIN C,12 ;END OF LINE?
POPJ P, ;RETURN
CAIN C,"/" ;IS IT A /
JRST GIVSW ;YES--YIPPIE
CAIE C," " ;IS IT A SPACE
TELL OPR,UNEXPD ;NO ANOTHER UNEXPECTED THING
JRST DOSW ;KEEP LOOKING
GIVSW: AOS (P) ;CAUSE SKIP RETURN
PJRST TYI ;PLACE NEXT CHAR IN C
;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
DECAR1: PUSHJ P,TYI ;GET A CHAR
CAIG C,71 ;IS THIS CHAR A DIGIT
CAIGE C,60 ; ..
JRST ACH ;NO. MUST BE END OF NUMBER
IMULI N,12 ;ADJUST N FOR NEXT DECADE
ADDI N,-60(C) ;NIFTY INSTRUCTION, TO INCR. N
JRST DECAR1 ;GET NEXT DIGIT
ACH: CAIE C," " ;BLANKS TABS
CAIN C,12 ; AND LINE FEEDS ARE VALID AFTER NUMBER
AOS (P) ;GOOD DELIMITER IN C
POPJ P, ;INVALID DELIMITER
;SUBROUTINE TO INPUT A SIXBIT WORD (A-Z AND 0-9 ONLY VALID CHARS.)
;CALL WITH:
; PUSHJ P,SIXIN
; RETURN HERE IF NOTHING FOUND
; RETURN HERE WITH WORD IN T1
;
SIXIN: SETZ T1, ;CLEAR RESULT
MOVE T2,[POINT 6,T1];SET UP A BYTE POINTER
SIXLPI: PUSHJ P,TYI ;GET A CHAR
CAIN C,12 ;LINE FEED
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,TYI
; RESULT IN C
TYI: PUSHJ P,TYIA1 ;GET A CHAR
CAIGE C,"A"+40 ;BIGGER THAN L.C. A
POPJ P, ;NO. U.C.
CAIG C,"Z"+40 ;BIGGER THAN L.C Z
SUBI C,40 ;NO. CONVERT TO U.C.
POPJ P, ;YES. RETURN
;HERE TO GRAB A CHAR FROM OPR
TYIA1: SKIPE C,SAVCHR ;OLD CHAR?
JRST DOCHAR ;YES. PROCESS IT
TYIA: INCHSL C ;ANYTHING TO READ?
SKIPA C,[12] ;NO--SEND A TERMINATOR (DON'T LOG)
DOCHAR: SETZM SAVCHR ;CLEAR FUDGED CHAR
CAIE C,"Z"-100 ;IS IT A CONTROL-Z OR A
CAIN C,"C"-100 ; CONTROL-C?
JRST XITCOM ;YES--MONRET
CAIE C,33 ;MAKE ALL THE
CAIN C,176 ; ALTMODES AND
MOVEI C,12 ; A ^Z LOOK LIKE
CAIE C,175 ; A LINE FEED SO
CAIN C,"Z"-100 ; THE OPERATOR CAN
MOVEI C,12 ; PLAY GAMES.
CAIE C,15 ;CARRAGE RETURN
CAIN C,177 ;RUBOUT
JRST TYIA ;GET A NEW CHAR
CAIN C,11 ;TAB?
MOVEI C,40 ;YES. SAME AS BLANK
CAIE C,12 ;LINE FEED?
JRST TYI1 ;NO. GOTO TYI1
OFF S,SCLN!SPAC ;YES. CLEAR BITS
POPJ P,
TYI1: CAIN C,";" ;COMMENT
TXOA S,SCLN ;YES,LIGHT BIT
TXNE S,SCLN ;NO, ARE WE IN A COMMENT?
JRST TYIA ;YES. IGNORE
CAIE C," " ;SPACE?
JRST TYI2 ;NO. GOTO TYI2
IFON S,SOME ;ANYTHING?
ON S,SPAC ;YES. GIVE EXACTLY 1 SPACE
JRST TYIA ;NO. IGNORE SPACE
TYI2: MOVEM C,SAVCHR ;SAVE FOR FUDGING
TXZN S,SPAC ;NEED A SPACE
JRST TYI3 ;NO. GOTO TYI3
MOVEI C," " ;YES. FUDGE TO BLANK
JRST TYI8 ;RETURN
TYI3: SETZM SAVCHR ;CLEAR FUDGE FLAG
TYI8: ON S,SOME ;SOMETING SEEN
POPJ P, ;RETURN
SUBTTL LUUO Handler
;HERE FROM LOCATOIN 40 ON THE TELL 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: MOVE P1,.JBUUO ;PICK UP THE UUO
HRLI P1,440700 ;CONVERT TO BYTE POINTER
LDB T1,PAC ;PICK UP THE AC BITS
DPB T1,PS ;SAV3 IN STATUS REG.
TLOOP: ILDB C,P1 ;GET A CHAR
JUMPE C,.POPJ## ;JUMP IF NULL
CAIE C,"!" ;THE ESCAPE CHAR?
JRST TLOOP1 ;NO, CONTINUE
ILDB C,P1 ;YES, GET NEXT CHAR
JUMPE C,.POPJ## ;FINISH UP IF NULL
PUSHJ P,SEND ;ELSE, SEND IT
JRST TLOOP ;AND LOOP
TLOOP1: PUSHJ P,DOACT ;IS THIS ACTIVE
PUSHJ P,SEND ;NO. JUST PRINT
JRST TLOOP ;DO NEXT CHAR
;SUBROUTINE TO PROCESS ACTION CHARS
;CALL WITH:
; MOVE C,CHAR-TO-CHECK
; PUSHJ P,DOACT
; NO SPECIAL ACTION
; ACTION TAKEN
;ALL ACS PRESERVEVED UNLESS ACTION SAYS OTHERWISE
DOACT: ACTCHR <^>,A5 ;PRINT FILE NAME
ACTCHR <[>,A6 ;PRINT FILES UFD NAME
ACTCHR <]>,A7 ;PRINT USERS PP,N
ACTCHR <+>,A9 ;PRINT T1 AS SIXBIT
ACTCHR <#>,A10 ;PRINT N AS DECMAL NUMBER
ACTCHR <@>,A11 ;PRINT CURRENT TIME
ACTCHR <_>,A12 ;PRINT CURRENT DATE
ACTCHR <$>,PRDEV ;PRINT OUTPUT DEVICE
ACTCHR <&>,A13 ;PRINT N AS OCTAL
POPJ P, ;RETURN - NOTHING DONE
;SUBROUTINE TO PRINT A SIXBIT VALUE PASSED TO MESSAGE HANDLER
;CALL WITH:
; PUSHJ P,A9
; NEVER RETURN HERE
; RETURN HERE
;
A9: MOVE T1,SAVT1 ;PICK UP WORD
PUSHJ P,SIXOUT ;PRINT IT
JRST .POPJ1## ;SKIP RETURN
;SUBROUTINE TO PRINT N AS DECMAL
A10: AOS (P) ;SKIP RETURN
MOVE T1,SAVN ;GET ARGUMENT
PJRST DECOUT ;PRINT AND RETURN
;SUBROUTINE TO PRINT THE TIME
A11: AOS (P) ;CAUSE A SKIP
PJRST PRTIME ;PRINT TIME THEN RETURN
;SUBROUTINE TO PRINT THE DATE
A12: AOS (P) ;CAUSE A SKIP
PJRST PRDATE ;PRINT THE DATE
;SUBROUTINE TO PRINT N IN OCTAL
A13: AOS (P)
MOVE T1,SAVN
PJRST OCTOUT
;SUBROUTINE TO PRINT A FILE NAME
;CALL WITH:
; PUSHJ P,A5
; NEVER RETURNS HERE
; ALWAYS SKIP RETURN
;USES C, T1 AND N
A5: MOVE T1,P$DFLP+.FODEV(AP) ;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,P$DUUO+.RBNAM(AP) ;PICK UP FILE NAME
PUSHJ P,SIXOUT ;AND PRINT IT
HLLZ T1,P$DUUO+.RBEXT(AP) ;GET EXTENSION
JUMPE T1,.POPJ1## ;GO AWAY IF NULL
MOVEI C,"." ;PRINT A DOT
PUSHJ P,SEND ; ..
AOS (P) ;CAUSE SKIP RETURN
PJRST SIXOUT ;AND PRINT EXT
;HERE TO PRINT CURRENT OUTPUT DEVICE
PRDEV: MOVE T1,HELPDV ;LOAD THE NAME
AOS (P) ;CASUE A SKIP BACK
PJRST SIXOUT ;PRINT IT AND RETURN
;SUBROUTINE TO TYPE A PROJECT PROGRAMMER PAIR
;CALL WITH:
; PUSHJ P,A6
; -OR-
; PUSHJ P,A7
;USES C AND T1 AND T2
A6: PUSHJ P,.SAVE2## ;SAVE AN AC
MOVEI P2,P$DPAT+2(AP) ;SET UP DIRECTORY
JRST .+3 ;SKIP USER STUFF
A7: PUSHJ P,.SAVE2## ;SAVE 2 AC'S
MOVEI P2,P$APPN(AP) ;SET UP USER
MOVE P1,(P2) ;GET PPN
MOVEI C,"[" ;TYPE A SQUARE BRACKET
PUSHJ P,SEND ; ..
HLRZ T1,P1 ;PRINT THE PROJECT NUMBER
PUSHJ P,OCTOUT ;IN OCTAL
MOVEI C,"," ;TYPE A COMMA
PUSHJ P,SEND ; BETWEEN PROJECT AND PROG
HRRZ T1,P1 ;SET UP PROG
PUSHJ P,OCTOUT ;AND PRINT IT
A7.1: AOS P2 ;POINT TO NEXT WORD
SKIPN T1,(P2) ;IS THERE AN SFD SPEC
JRST A7.2 ;NO--PRINT ] AND LEAVE
MOVEI C,"," ;SET UP A ,
PUSHJ P,SEND ; AND PRINT IT.
PUSHJ P,SIXOUT ;PRINT THE SFD
JRST A7.1 ;LOOP FOR NEXT SFD
A7.2: MOVEI C,"]" ;TYPE A CLOSE SQUARE BRACKET
AOS (P) ;CAUSE SKIP RETURN
PJRST SEND ;AND SEND LAST CHAR
;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
;
;AC CA IS CLOBBERED CUSTOMER MUST SAVE HIMSALF
;
DECOUT: SKIPA T4,TEN ;BASE TEN
OCTOUT: MOVEI T4,10 ;BASE EIGHT
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
;SUBROUTINE TO PRINT AC AS SIXBIT
;CALL WITH:
; MOVE T1,WORD-TO-PRINT
; PUSHJ P,SIXOUT
; RETURN IS ALWAYS HERE
;USES C,N AND T5
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
;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 ;TELL THE OPERATOR?
OUTCHR C ;YES!
TXNN S,TELUSR ;TELL THE USER?
TEN: POPJ P,^D10 ;NO RETURN, (NOTE RH IS A CONSTANT)
PUSH P,T1 ;YES, SAVE T1
MOVE T1,P$LDVI(AP) ;GET THE DEVICE INDEX
PUSHJ P,@SENTBL(T1) ;SEND THE CHARACTER
POP P,T1 ;RESTORE T1
POPJ P, ;AND RETURN
SENTBL: EXP PICTUR ;FOR PTP
EXP .POPJ## ;NOTHING FOR CDP
EXP .POPJ## ;NOR FOR PLT
;ROUTINE TO PRINT TIME
;CALL WITH:
; PUSHJ P,PRTIME
; RETURN HERE
;
PRTIME: PUSHJ P,.SAVE2## ;GET SOME SCRATCH AC'S
MOVX P1,%CNDTM ;UNIVERSAL DATE-TIME
GETTAB P1, ;GET IT
HALT .
HRRZS P1 ;JUST THE DATE PART
IMULI P1,^D330 ;AND CONVERT TO MILLISECONDS
IDIVI P1,^D60000 ;MILLISECS PER MIN
IDIVI P1,^D60 ;MAKE HOURS
MOVE T1,P1 ;MOVE TO BETTER AC
PUSHJ P,TWODIG ;PRINT HOURS AS TWO DIGITS
MOVEI C,":" ;PRINT A DELIMITER
PUSHJ P,SEND ; ..
MOVE P1,P2 ;PRINT HOURS
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
;SUBROUTINE TO PRINT THE DATE
;CALL WITH:
; PUSHJ P,PRDATE
; RETURN HERE
;
PRDATE: PUSHJ P,.SAVE4## ;SAVE 4 AC'S
DATE P1, ;GET THE DATE
JRST .+2 ;SKIP THE SAVE
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 P4,[POINT 7,MNTAB(P2)] ;LOAD A BYTE POINTER
MOVEI P3,5 ;CHAR COUNT
ILDB C,P4 ;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
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-/
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: TXNN S,OPENB ;ARE WE STARTED?
POPJ P, ;NO, NOT YET A KNOWN COMPONENT
PUSHJ P,SETHEL ;SET UP THE HELLO BLOCK
MOVX T1,HELSTC ;GET THE STATUS CHANGE FLAG
IORM T1,HELSTS ;STORE IT IN
MOVEI T1,HELBLK ;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 AND HELFRZ BITS IN THE STATUS WORD.
SETHEL: MOVE T1,P$FORM(AP) ;GET FORMS NAME
MOVEM T1,HELFRM ;STORE IT
MOVX T1,'SPOOL ' ;GET MY NAME
MOVEM T1,HELPGM ;SAVE IT
MOVS T1,MLIM ;GET MLIMIT WORD
HRR T1,NXTJOB ;AND THE NEXT-JOB WORD
MOVEM T1,HELMLT ;SAVE IT
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,OPENB ;HAS HE SAID START?
TXO T1,HELSCH ;YES, SET SCHEDUABLE BIT
MOVEM T1,HELSTS ;STORE IT
MOVE T1,MYSTA ;GET MY STATION
STORE T1,HELSTS,HELDSN ;STORE AS DEFAULT STATION NUMBER
POPJ P, ;AND RETURN
SUBTTL Disk File Monitor Interface
;SUBROUTINE TO FILL DISK INPUT BUFFER
;CALL WITH:
; PUSHJ P,FILL
; EOF RETURN
; DATA RETURN (DFCB UPDATED)
LOWSEG
FILL: TXNN S,RQB ;HAVE WE BEEN REQUEUE'D?
PUSHJ P,CHKQUE ;NO PROCESS ANY MESSAGES
IN DSK, ;READ BLOCK
PJRST .POPJ1## ;ALL IS OK, SKIP BACK
PUSHJ P,.SAVE1## ;SAVE AN AC
STATZ DSK,IO.EOF ;EOF?
POPJ P, ;YES.
;HERE ON DATA/DEVICE ERROR
GETSTS DSK,N ;SEE WHAT HAPPENED
MOVE P1,N ;AND PUT STATUS IN P1
TELL OPR,%%IDE
TXZ P1,IO.ERR ;CLEAR ERROR BITS
SETSTS DSK,(P1) ;SET THE STATUS BACK
SOSLE P$DERR(AP) ;TOO MANY ERRORS?
JRST .POPJ1## ;IGNORE ERROR AND HELP
TELL USR,%%FSD
SKIPE MSGERR ;SKIP IF NOT FOR OPR
TELL OPR,%%FSD
MOVEI P1,1 ;LOAD A ONE
MOVEM P1,LPCOPY ;INHIBIT PRINTING OF ADDITIONAL COPIES
POPJ P,
;SUBROUTINE TO CAUSE AN EOF ON THE NEXT INPUT CHARACTER.
;CALL WITH:
; PUSHJ P,SETEOF
; ALWAYS RETURN HERE
;
SETEOF: TXNE S,DSKOPN ;DISK FILE OPEN?
USETI DSK,-1 ;YES, SET EOF
SETOM P$DBCT(AP) ;CAUSE SOSG TO FAIL
POPJ P, ;AND RETURN
SUBTTL Interrupt Routines
;HERE ON TTY INPUT DONE INTERRUPT
TTYINT: SETOM TTYFLG ;JUST SET A FLAG
DEBRK. ;AND JEN
HALT .
HALT .
;HERE WHEN THE OUTPUT DEVICE IS HUNG
INT1: PUSH P,S1 ;SAVE S1
MOVE S1,INTLOC+2 ;NO, GET INTERRUPTED ADR
EXCH S1,0(P) ;STACK IT AND GET S1 BACK
PUSHJ P,SAVALL ;SAVE THE AC'S
HRRZ T1,INTLOC+3 ;GET THE CHANNEL
CAIN T1,DCH ;OUTPUT DEVICE?
MOVE T1,HELPDV ;LOAD DEVICE NAME
MOVEM S,UUSAVE ;STORE THE UUO
AOSG N,HNGCNT ;TELL THE OPR
TELL OPR,DEVOK ;TELL THE OPR
MOVE S,UUSAVE ;PUT BACK THE WORD
MOVEI P1,SLTIME ;DEFAULT SLEEP TIME
HRLI P1,(HB.RTL) ;WAKE ON TTY INPUT
HIBER P1, ;HIBERNATE
JFCL ;OH WELL!
;SUBROUTINE TO SET UP .JBINT
;CALL WITH:
; PUSHJ P,SETINT
; RETURN HERE
;
SETINT: MOVEI T1,INTLOC ;LOCATION OF BLOCK
MOVEM T1,.JBINT ;STORE IN JOB DATA AREA
MOVE T1,[4,,INT1] ;LH=SIZE OF BLOCK - RH=INTERUPT LOCATION
MOVEM T1,INTLOC ;SAVE IN BLOCK
MOVE T1,[400000,,ER.IDV] ;LH=DONT PRINT MSG - RH=HNGSTP CALLS
MOVEM T1,INTLOC+1 ;STORE IN BLOCK
SETZM INTLOC+2 ;CLEAR OLD PC
SETZM INTLOC+3 ;CLEAR CHANNEL #
POPJ P,
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: MOVE T1,P$FORM(AP) ;GET CURRENT FORMS
MOVEM T1,P$FPFM(AP) ;SAVE AS OLD FORMS
SKIPN T1,.EQLM1(AP) ;GET FORMS TYPE FOR REQUEST
MOVX T1,FRMNOR ;USE NORMAL IF ZERO
MOVEM T1,P$FORM(AP) ;SAVE IT
XOR T1,P$FPFM(AP) ;XOR WITH PREVIOUS TYPE
TXZ T1,FRMSK2 ;AND MASK OUT COMMON PART
JUMPE T1,.POPJ## ;NO FORMS CHANGE IF ZERO
MOVE T1,P$FORM(AP) ;ELSE, LOAD FORMS TYPE
TELL OPR,MOUNTM ;ASK OPR TO MOUNT
PJRST MOUNT1 ;AND WAIT FOR ACTION
MOUNT1: OFF S,RUNB ;TURN OFF RUN FLAG
TELL OPR,STAR ;AND TYPE A STAR
MOVEI T1,<AUTTIM>-1 ;LOAD NUMBER OF SLEEPS
MOUNT2: JUMPE T1,MOUNT3 ;TIMEOUT IF ZERO
MOVEI T2,^D60000 ;SLEEP TIME
TXO T2,HB.RTL ;TURN ON TTY INPUT WAKEUP BIT
HIBER T2, ;ZZZZ
JFCL ;HUH?
SKPINL ;ANY INPUT?
SOJA T1,MOUNT2 ;DECREMENT COUNT AND LOOP
JRST GOWAIT ;YES, GET IT
MOUNT3: TELL OPR,WAITED ;I TRIED!!
SETOM LPNOP ;AUTO-FREEZE
JRST REQUE ;AND REQUE IT
WAITED: ASCIZ /![Automatically requeing job and Freezing forms!]
/
SUBTTL Subroutine to Save all ACs
LOWSEG
;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 Process a file
TOPSEG
;ROUTINE TO DO DEVICE INDEPENDENT SETUP TO PROCESS ONE FILE
;TABLE TO LOAD INDEX OF CORRECT PROCESSING ROUTINE FOR EACH DEVICE
FILOUT: MOVEI T1,PTMXID ;GET ADR OF TABLE
ADD T1,P$LDVI(AP) ;ADD DEVICE INDEX
HRRZ T1,(T1) ;GET ADR OF ROUTINE
PUSHJ P,(T1) ;AND CALL IT
MOVE T2,P$LDVI(AP) ;LOAD DEVICE INDEX
LOAD T1,.FPINF(QP),FP.FPF ;GET PAPER FORMAT
JUMPN T1,FILO.1 ;JUMP IF ONE WAS SPECIFIED
LDB T1,[POINT 4,P$DUUO+.RBPRV(AP),12] ;ELSE GET FILE MODE
LDB T1,PTFMPT(T2) ;GET DEFAULT PAPER FORMAT
JUMPE T1,NOTYET ;NOT IMPLEMENTED
FILO.1: HLRZ T3,PTMXID(T2) ;GET MAX PAPER FORMAT
CAMLE T1,T3 ;WITHIN RANGE?
JRST NOTYET ;NO, PUNT
MOVE T2,T%MODD(T2) ;POINT TO DISP TABLE
ADD T2,T1 ;POINT TO CORRECT ENTRY
MOVEI T1,P$XCOD(AP) ;WHERE TO BLT TO
HRL T1,(T2) ;WHERE TO BLT FROM
HLRZ T3,(T2) ;HOW MUCH TO BLT
TRZ T3,700000 ;WIPE OUT THE START OFFSET
ADD T3,AP ;ADD IN THE PAGE ADR
BLT T1,P$XCOD(T3) ;AND BLT THE ROUTINE
CLEARM P$XCNT(AP) ;CLEAR UTILITY COUNTER
HLRZ T1,(T2) ;GET LENGTH AND START OFFSET
LSH T1,-^D15 ;SHIFT OFFSET RIGHT JUSTIFIED
ADDI T1,P$XCOD(AP) ;ADD IN ADDRESS OF ROUTINE
PUSH P,T1 ;STACK IT
PJRST CLRSEG ;CLEAR HISEG AND GO
; DEPENDING ON THE MODE OF THE FILE. THE TABLE AS WELL AS THE
; BYTE POINTERS FOLLOWING IT ARE ORDERED BY DEVICE INDEX.
FMDISP: BYTE (12) 1,1,2 ;MODE 0
BYTE (12) 1,1,2 ;MODE 1
BYTE (12) 0,0,0 ;MODE 2
BYTE (12) 0,0,0 ;MODE 3
BYTE (12) 0,0,0 ;MODE 4
BYTE (12) 0,0,0 ;MODE 5
BYTE (12) 0,0,0 ;MODE 6
BYTE (12) 0,0,0 ;MODE 7
BYTE (12) 2,5,1 ;MODE 10
BYTE (12) 0,0,0 ;MODE 11
BYTE (12) 0,0,0 ;MODE 12
BYTE (12) 3,5,1 ;MODE 13
BYTE (12) 4,3,1 ;MODE 14
BYTE (12) 4,0,1 ;MODE 15
BYTE (12) 4,3,1 ;MODE 16
BYTE (12) 4,3,1 ;MODE 17
;BYTE POINTERS TO FMDISP TABLE
PTFMPT: POINT 12,FMDISP(T1),11 ;PTP
CDFMPT: POINT 12,FMDISP(T1),23 ;CDP
PLFMPT: POINT 12,FMDISP(T1),35 ;PLT
;TABLE OF XWD MAX FILE FORMAT,,ADR OF DEVICE DEPENDENT SETUP
PTMXID: XWD 6,T%FILO
CDMXID: XWD 5,C%FILO
PLMXID: XWD 2,P%FILO
SUBTTL Device Dependent Setup
;PAPER-TAPE PUNCH
T%FILO: LOAD T1,.FPINF(QP),FP.FFF ;GET FILE FORMAT
CAIN T1,.FPF11 ;MACX11 FORMAT?
STORE T1,.FPINF(QP),FP.FPF ;YES STORE FOR FILOUT
POPJ P,
;CARD-PUNCH
C%FILO: POPJ P, ;RETURN
;PLOTTER
P%FILO: POPJ P,
;DISPATCH TABLES FOR EACH MODE
; FORMAT IS <START OFFSET>B2 + <LENGTH>B17 + <ADDRESS>B35
T%MODD: [0
PTASCS,,PTASC ;ASCII
PTIMAS,,PTIMA ;IMAGE
PTIBIS,,PTIBI ;IBIN
PTBINS,,PTBIN ;BINARY
PTIMAS,,PTIMA ;IMAGE
PTELFS,,PTELF] ;ELEVEN
C%MODD: [0
CDASCS,,CDASC ;ASCII
CDASCS+100000,,CDASC ;026 (=ASCII WITH OFFSET OF 1)
CDBINS,,CDBIN ;CHECKSUMMED BINARY
CDASCS,,CDASC ;ASCII
CDIMAS,,CDIMA] ;IMAGE AND IMAGE BINARY
P%MODD: [0
PLSIXS,,PLSIX ;STANDARD 6BIT INPUT
PLSIXS+200000,,PLSIX] ;SEVEN-BIT IS SIXBIT WITH OFFSET 2
SUBTTL Common Dispatch Routines
;GENERATE A FILE HEADER
HEAD: PUSH P,T1 ;SAVE T1
MOVEI T1,.+2 ;LOAD ADR OF DISPATCH TABLE
JRST COMDIS ;AND DISPATCH
EXP T%HEAD
EXP C%HEAD
EXP P%HEAD
;GENERATE A FILE TRAILER
TAIL: PUSH P,T1 ;SAVE T1
MOVEI T1,.+2 ;LOAD ADR OF DISPATCH TABLE
JRST COMDIS ;AND DISPATCH
EXP T%TAIL
EXP C%TAIL
EXP P%TAIL
COMDIS: ADD T1,P$LDVI(AP) ;ADD IN THE INDEX
MOVE T1,(T1) ;GET ADDRESS OF ROUTINE
EXCH T1,0(P) ;GET T1 AND STACK ROUTINE ADDRESS
POPJ P, ;DISPATCH!! (SORT OF)
SUBTTL Card Punch Control
XLIST ;FORCE OUT LITERALS HERE
LIT
LIST
TOPSEG
CDIMA: PHASE 0 ;WILL EXEC FROM LOWSEG
MOVSI T1,1400 ;GET 12 BIT BYTES FROM DISK
MOVEM T1,P$DBPT(AP) ;SAVE BYTE-POINTER
MOVEI T2,CPC ;SET UP COL COUNTER
CDPLP: SOSLE P$DBCT(AP) ;COUNT DOWN BUFFER
JRST XC(CDPLDB) ;ROOM - GO STORE
PUSHJ P,FILL ;REFILL THE DISK INPUT BUFFER
PJRST FINCRD ;END OF FILE -- NOW:
; FINISH THE CARD
; GET THE HISEG
; POPJ BACK TO MAIN ROUTINE
CDPLDB: ILDB C,P$DBPT(AP) ;GET A BYTE
PUSHJ P,C%DVOU ;PUNCH IT
SOJG T2,XC(CDPLP) ;JUMP IF CARD NOT FULL
PUSHJ P,OUTUUO ;IF FULL,OUTPUT CARD
MOVEI T2,CPC ;RESET COLUMN COUNTER
JRST XC(CDPLP) ;AND THEN LOOP FOR MORE
DEPHASE ;BACK TO NORMAL
CDIMAS=.-CDIMA ;SIZE OF LOOP
;THIS WILL PUNCH CHECKSUMED BINARY CARDS
CDBIN: PHASE 0 ;WILL GET MOVED TO LOWSEG
SETZ T1, ;CLEAR SUM
MOVSI T2,-32 ;AOBJN POINTER
HRRI T2,P$XCOD(AP) ;AND BASE ADR
CDBNLP: SOSLE P$DBCT(AP) ;ANY INPUT
JRST XC(CBNLDB) ;YES--GO EAT A CHAR
PUSHJ P,FILL ;READ A BUFFER
JRST XC(GOTEOF) ;GOT AN EOF
CBNLDB: ILDB C,P$DBPT(AP) ;GO GET A CHAR
ADD T1,C ;ADD TO SUM
MOVEM C,CDBUF(T2) ;STORE FOR PASS2
AOBJN T2,XC(CDBNLP) ;LOOP FOR NEXT WORD
FINBIN: HLRE C,T2 ;COPY FINAL COUNT
ADDI C,32 ;SUBTRACT FROM 32
JUMPE C,FINCRD ;(C)=0 IF EOF AT EOC
MOVNI T5,(C) ;COPY -VE COUNT
LSH C,6 ;SHIFT TO 12-4
IORI C,5 ;PUNCH OUT 7-9
PUSHJ P,C%DVOU ;PUNCH THE WORD
LSHC T1,-30 ;FOLD THE SUM
LSH T2,-14
ADD T1,T2
LSHC T1,-14
LSH T2,-30
ADD T1,T2
TRZE T1,770000
AOS T1
MOVE C,T1 ;COPY FOLDED SUM
PUSHJ P,C%DVOU ;PUNCH THE SUM
IMULI T5,3 ;CONVERT #WORDS TO #COLUMNS
HRLZ T5,T5 ;CONVERT TO AOBJN POINTER
MOVE N,XC(CBXBP) ;LOAD THE BYTE POINTER
CKSLP1: ILDB C,N ;GET A COLUMN
PUSHJ P,C%DVOU ;MAKE SOME HOLES
AOBJN T5,XC(CKSLP1) ;LOOP FOR MORE
PUSHJ P,OUTUUO ;PUSH OUT THE CARD
SKIPN XC(EOFWD) ;END OF FILE?
JRST P$XCOD(AP) ;NO--KEEP MAKING HOLES
PJRST FINCR1 ;RETURN TO TOP LEVEL
GOTEOF: SETOM XC(EOFWD) ;FLAG IT
JRST XC(FINBIN) ;AND FINISH LAST CARD
EOFWD: 0 ;FLAG
CBXBP: POINT 12,CDBUF+P$XCOD(AP)
CDBUF: BLOCK 33 ;TEMP BUFFER
LIT
DEPHASE
CDBINS=.-CDBIN
;HERE TO PUNCH ASCII OR BCD CARDS
CDASC:
PHASE 0
CDASCX: SKIPA T1,XC(CDXAS) ;GET CORRECT TABLE ENTRY
CD026X: MOVE T1,XC(CDX26) ;GET 026 ENTRY
MOVEM T1,XC(CDXCT) ;AND SAVE FOR LATER EXECUTION
MOVSI T1,700 ;READ 7 BIT BYTES FROM DISK
MOVEM T1,P$DBPT(AP) ;SAVE BYTE POINTER
CDPLP1: SOSLE P$DBCT(AP) ;ANYTHING IN BUFFER
JRST XC(CDLDB) ;YES--GO EAT
PUSHJ P,FILL ;FILL THE BUFFER
PJRST FINCRD ;EOF--GET THE HISEG
CDLDB: ILDB C,P$DBPT(AP) ;GET A CHAR
JUMPE C,XC(CDPLP1) ;IGNORE NULL BYTES
MOVE T3,P$XCNT(AP)
CAIL T3,CPC
JRST XC(ENDCRD)
CAIN C,11 ;IS THIS A TAB
JRST XC(TABBER) ;YES, CHANGE TO APPROPRIATE #SPACES
CAIN C,12 ;IS THIS A LINE FEED
JRST XC(CDPLP1) ;YES--THROW AWAY
CAIN C,15 ;IS THIS A CR?
JRST XC(SPACES) ;YES--CONVERT TO BLANKS
MOVE T1,C ;COPY CHAR
IDIVI T1,3 ;FIND BYTE
XCT XC(CDXCT) ;LOAD THE BYTE
IMULI T2,^D12 ;ADJUST MASK
LSH C,-^D24(T2) ;DIAL A BYTE
ANDI C,7777 ;MASK OUT JUNK
PUSHJ P,C%DVOU ;PUNCH
JRST XC(CDPLP1) ;GET A NEW CARD
SPACES: TXZE S,ANYCHR ;IS THIS A BLANK CARD
JRST XC(ENDCR1) ;NO
SETZ C, ;YES - WE MUST GIVE CDPSER SOMETHING
PUSHJ P,C%DVOU ;SO OUTPUT A BLANK
JRST XC(ENDCR1) ;THEN FINISH UP CARD IN USUAL WAY
TABBER: SETZ C, ;C_[0]
PUSHJ P,C%DVOU ;PUNCH A BLANK
MOVE T1,P$XCNT(AP) ;GET COLUMN #
TRNE T1,7 ;TAB STOP?
JRST XC(TABBER) ;NO--TRY AGAIN
JRST XC(CDPLP1) ;YES--WE WIN
ENDCRD: CAIE C,15 ;IS IT A CARRIAGE RETURN?
JRST XC(CDPLP1) ;NO, KEEP EATING
ENDCR1: PUSHJ P,OUTUUO ;SHOVE OUT CARD
JRST XC(CDPLP1) ;AND GO ROUND FOR MORE.
CDXAS: MOVE C,TBLASC(T1) ;INSTRUCTION FOR ASCII
CDX26: MOVE C,TBL026(T1) ;INSTRUCTION FOR 026
CDXCT: 0 ;THE CORRECT ONE
CDASCS==.-CDASCX
DEPHASE ;BACK TO NORMAL FORM
LOWSEG
;CAST OF CHARACTERS IN IMAGE FORMAT INDEXED BY ASCII VALUE
TBLASC: BYTE (12) 5403,4401,4201 ;NULL ^A ^B
BYTE (12) 4101,0005,1023 ;^C ^D ^E
BYTE (12) 1013,1007,2011 ;^F ^G ^H
BYTE (12) 4021,1021,4103 ;TAB LF VT
BYTE (12) 4043,4023,4013 ;FF CR ^N
BYTE (12) 4007,6403,2401 ;^O ^P ^Q
BYTE (12) 2201,2101,0043 ;^R ^S ^T
BYTE (12) 0023,0201,1011 ;^U ^V ^W
BYTE (12) 2003,2403,0007 ;^X ^Y ^Z
BYTE (12) 1005,2043,2023 ;^[ ^\ ^]
BYTE (12) 2013,2007,0000 ;^^ ^_ SPACE
BYTE (12) 4006,0006,0102 ;! " #
BYTE (12) 2102,1042,4000 ;$ % &
BYTE (12) 0022,4022,2022 ;' ( )
BYTE (12) 2042,4012,1102 ;* + ,
BYTE (12) 2000,4102,1400 ;- . /
BYTE (12) 1000,0400,0200 ;0 1 2
BYTE (12) 0100,0040,0020 ;3 4 5
BYTE (12) 0010,0004,0002 ;6 7 8
BYTE (12) 0001,0202,2012 ;9 : ;
BYTE (12) 4042,0012,1012 ;< = >
BYTE (12) 1006,0042,4400 ;? @ A
BYTE (12) 4200,4100,4040 ;B C D
BYTE (12) 4020,4010,4004 ;E F G
BYTE (12) 4002,4001,2400 ;H I J
BYTE (12) 2200,2100,2040 ;K L M
BYTE (12) 2020,2010,2004 ;N O P
BYTE (12) 2002,2001,1200 ;Q R S
BYTE (12) 1100,1040,1020 ;T U V
BYTE (12) 1010,1004,1002 ;W X Y
BYTE (12) 1001,4202,1202 ;Z [ \
BYTE (12) 2202,2006,1022 ;] ^ _
;FOLLOWING ALPHABETICS ARE SMALL LETTERS
BYTE (12) 0402,5400,5200 ;' A B
BYTE (12) 5100,5040,5020 ;C D E
BYTE (12) 5010,5004,5002 ;F G H
BYTE (12) 5001,6400,6200 ;I J K
BYTE (12) 6100,6040,6020 ;L M N
BYTE (12) 6010,6004,6002 ;O P Q
BYTE (12) 6001,3200,3100 ;R S T
BYTE (12) 3040,3020,3010 ;U V W
BYTE (12) 3004,3002,3001 ;X Y Z
BYTE (12) 5000,6000,3000 ;
BYTE (12) 3400,0000,0000 ;
LOWSEG
;CAST OF CHARACTERS IN IMAGE FORMAT INDEXED BY ASCII VALUE
TBL026: BYTE (12) 5403,4401,4201 ;NULL ^A ^B
BYTE (12) 4101,0003,1023 ;^C ^D ^E
BYTE (12) 1013,1007,2011 ;^F ^G ^H
BYTE (12) 4021,1021,4103 ;TAB LF VT
BYTE (12) 4043,4023,4013 ;FF CR ^N
BYTE (12) 4007,6403,2401 ;^O ^P ^Q
BYTE (12) 2201,2101,0013 ;^R ^S ^T
BYTE (12) 0023,0201,0011 ;^U ^V ^W
BYTE (12) 2003,2403,0007 ;^X ^Y ^Z
BYTE (12) 1005,2043,2023 ;^[ ^\ ^]
BYTE (12) 2013,2007,0000 ;^^ ^_ SPACE
BYTE (12) 4006,1022,1012 ;! " #
BYTE (12) 2102,1006,2006 ;$ % &
BYTE (12) 0012,1042,4042 ;' ( )
BYTE (12) 2042,4000,1102 ;* + ,
BYTE (12) 2000,4102,1400 ;- . /
BYTE (12) 1000,0400,0200 ;0 1 2
BYTE (12) 0100,0040,0020 ;3 4 5
BYTE (12) 0010,0004,0002 ;6 7 8
BYTE (12) 0001,2202,1202 ;9 : ;
BYTE (12) 4012,0102,2012 ;< = >
BYTE (12) 4202,0042,4400 ;? @ A
BYTE (12) 4200,4100,4040 ;B C D
BYTE (12) 4020,4010,4004 ;E F G
BYTE (12) 4002,4001,2400 ;H I J
BYTE (12) 2200,2100,2040 ;K L M
BYTE (12) 2020,2010,2004 ;N O P
BYTE (12) 2002,2001,1200 ;Q R S
BYTE (12) 1100,1040,1020 ;T U V
BYTE (12) 1010,1004,1002 ;W X Y
BYTE (12) 1001,2022,0006 ;Z [ \
BYTE (12) 4022,0022,0202 ;] ^ _
;FOLLOWING ALPHABETICS ARE SMALL LETTERS
BYTE (12) 0402,5400,5200 ;' A B
BYTE (12) 5100,5040,5020 ;C D E
BYTE (12) 5010,5004,5002 ;F G H
BYTE (12) 5001,6400,6200 ;I J K
BYTE (12) 6100,6040,6020 ;L M N
BYTE (12) 6010,6004,6002 ;O P Q
BYTE (12) 6001,3200,3100 ;R S T
BYTE (12) 3040,3020,3010 ;U V W
BYTE (12) 3004,3002,3001 ;X Y Z
BYTE (12) 5000,6000,3000 ;
BYTE (12) 3400,0000,0000 ;
TOPSEG
C%HEAD: PUSHJ P,.SAVE4## ;SAVE SOME ACS
MOVEI C,3776 ;ROUNDED CORNER
PUSHJ P,C%DVOU ;PUNCH
HRRZI C,7777 ;PUT SOME HOLES
PUSHJ P,C%DVOU ; IN COL. 1
MOVE T1,P$DUUO+.RBNAM(AP);PICK UP FILE NAME
PUSHJ P,PUNWD ;PUNCH IT.
PUSHJ P,PUNBLK ;PUNCH A BLANK
MOVEI C,4001 ;ROWS 12 AND 9
PUSHJ P,C%DVOU ;IN 77
PUSHJ P,C%DVOU ;AND 78
MOVEI C,7777 ;FULLY LACE
PUSHJ P,C%DVOU ;COL 79
MOVEI C,3776 ;ROUND EDGE
PUSHJ P,C%DVOU ;COL 80.
PJRST OUTUUO ;AND FLUSH CARD
PUNWD: MOVEI T3,6 ;6 CHARS PER CARD
PUNLP2: MOVEI C,4001 ;ROWS 12 AND 9
PUSHJ P,C%DVOU ;IN FIRST 3
PUSHJ P,C%DVOU ; COLS. OF
PUSHJ P,C%DVOU ; EACH CHAR.
LSHC T1,-6 ;GET LAST BYTE
LDB C,[POINT 6,T2,5] ;PUT IN C
CAIG C,'Z' ;IS IT A LETTER?
CAIGE C,'A' ; ..
JRST .+3 ;NO--SEE IF IT IS A NUMBER
MOVE P1,[LTRTAB-102(C)] ;YES--USE LETTER TABLE
JRST PUN ;AND PUNCH
CAIG C,'9' ;IS IT A NUMBER?
CAIGE C,'0' ; ..
PUNBLK: SKIPA P1,[Z OTHER] ;NO--PUNCH A PLANK
MOVE P1,[Z NUMTAB-40(C)] ;YES--USE NUMBER TABLE
PUN: LSH C,1 ;2 WORDS PER LETTER
MOVE P2,@P1 ;P2_FIRST WORD
AOS C ;POINT TO NEXT WORD
MOVE P3,@P1 ;P3_SECOND WORD
MOVEI P4,10 ;10 COLS PER LETTER
SETZ P1, ;CLEAR P1
PUNLP: LSHC P1,7 ;SHIFT IN 7 BITS
LSH P1,3 ;CENETER ON CARD
MOVEI C,4001(P1) ;TURN ON ROWS 12 AND 9
PUSHJ P,C%DVOU ;PUNCH
SETZ P1, ;CLEAR OUT WORK AC
CAMN P2,[1B0] ;END OF WORD?
MOVE P2,P3 ;YES--FLIP WORD 2 INTO PLACE
SOJG P4,PUNLP ;LOOP FOR REST OF LETTER
SOJG T3,PUNLP2 ;LOOP FOR REST OF WORD
SOS P$APRT(AP) ;DON'T CHARGE FOR THE HEADER
POPJ P, ;RETURN
C%TAIL: MOVEI N,^D80 ;PUNCH 80 COLUMNS
MOVEI T1,7417 ;LACE FOR END CARD
SOS P$APRT(AP) ;DON'T CHARGE FOR THE TRAILER
OUDEV: MOVE C,T1 ;COPY ARGUMENT
JUMPLE N,.POPJ## ;JUMP IF DO LOOP IS DONE
PUSHJ P,C%DVOU ;PUNCH IT
SOJG N,OUDEV ;LOOP FOR N COLS.
PJRST OUTUUO ;GET CARD OUT AND RETURN
LOWSEG
C%DVOU: SOSG P$LBCT(AP) ;COUNT DOWN BUFFER HEADER COUNTER
PUSHJ P,DOOUT
IDPB C,P$LBPT(AP) ;PUT BYTE IN BUFFER
ON S,ANYCHR ;REMEMBER THAT WE HAVE OUTPUT SOMETHING
AOS P$XCNT(AP) ;MAINTAIN BUFFER COUNTER
POPJ P,0 ;RETURN
FINCRD: PUSHJ P,OUTUUO ;GET THE CARD OUT
FINCR1: PJRST GETSPL ;AND GET THE HI-SEG BACK
OUTUUO: TXNE S,ISCDP ;IS IT REAL CDP?
JRST OUTCDP ;YES
SKIPN P$XCNT(AP) ;IS THIS A DUMMY OUTPUT?
PJRST DOOUT ;YES - JUST DO UUO
PUSH P,T1 ;WE MUST FILL
MOVEI T1,CPCMON ;TO 81 COLUMNS
SUB T1,P$XCNT(AP) ;FIND HOW MANY COLS TO GO
SETZ C, ;FILL WITH BLANKS
FILLER: SOJL T1,OUTFIN ;LOOP UNTIL DONE
SOSG P$LBCT(AP) ;COUNT DOWN BUFFER HEADER
PUSHJ P,DOOUT ;GET NEW BUFFER
IDPB C,P$LBPT(AP) ;DEPOSIT NULL
JRST FILLER ;GO ROUND FOR NEXT ONE
OUTCDP: PUSHJ P,DOOUT ;PUNCH CARD
CAIA
OUTFIN: POP P,T1 ;RESTORE T1 (IF NOT CDP)
SETZM P$XCNT(AP) ;ZERO COLUMN COUNTER
OFF S,ANYCHR ;CLEAR "SEEN A CHAR" FLAG
PUSH P,T1 ;SAVE T1
AOS T1,P$APRT(AP) ;INCREMENT AND LOAD AMOUNT PUNCHED
CAML T1,P$RLIM(AP) ;EXCEED QUOTA?
PJRST [POP P,T1 ;YES, RESTORE T1
JRST XCEED] ;AND GIVE THE ERROR
POP P,T1 ;NO, OK RESTORE T1
POPJ P,0 ;RETURN
TOPSEG
LTRTAB: BYTE (7) 017,030,050,110,110 (1)1 (7) 050,030,017 ;A
BYTE (7) 066,111,111,111,111 (1)1 (7) 111,111,177 ;B
BYTE (7) 042,101,101,101,101 (1)1 (7) 101,101,076 ;C
BYTE (7) 076,101,101,101,101 (1)1 (7) 101,101,177 ;D
BYTE (7) 101,101,111,111,111 (1)1 (7) 111,111,177 ;E
BYTE (7) 100,100,110,110,110 (1)1 (7) 110,110,177 ;F
BYTE (7) 046,111,111,111,101 (1)1 (7) 101,101,076 ;G
BYTE (7) 177,010,010,010,010 (1)1 (7) 010,010,177 ;H
BYTE (7) 000,101,101,177,177 (1)1 (7) 101,101,000 ;I
BYTE (7) 176,001,001,001,001 (1)1 (7) 001,001,006 ;J
BYTE (7) 101,042,024,010,010 (1)1 (7) 010,010,177 ;K
BYTE (7) 001,001,001,001,001 (1)1 (7) 001,001,177 ;L
BYTE (7) 177,040,020,010,010 (1)1 (7) 020,040,177 ;M
BYTE (7) 177,002,004,010,010 (1)1 (7) 020,040,177 ;N
BYTE (7) 076,101,101,101,101 (1)1 (7) 101,101,076 ;O
BYTE (7) 060,110,110,110,110 (1)1 (7) 110,110,177 ;P
BYTE (7) 076,101,103,105,101 (1)1 (7) 101,101,076 ;Q
BYTE (7) 061,112,114,110,110 (1)1 (7) 110,110,177 ;R
BYTE (7) 106,111,111,111,111 (1)1 (7) 111,061,000 ;S
BYTE (7) 100,100,100,177,177 (1)1 (7) 100,100,100 ;T
BYTE (7) 176,001,001,001,001 (1)1 (7) 001,001,176 ;U
BYTE (7) 170,004,002,001,001 (1)1 (7) 002,004,170 ;V
BYTE (7) 177,002,004,010,010 (1)1 (7) 004,002,177 ;W
BYTE (7) 101,042,024,010,010 (1)1 (7) 024,042,101 ;X
BYTE (7) 100,040,020,017,017 (1)1 (7) 020,040,100 ;Y
BYTE (7) 101,141,121,111,111 (1)1 (7) 105,103,101 ;Z
NUMTAB: BYTE (7) 134,042,101,121,111 (1)1 (7) 105,042,035 ;0
BYTE (7) 000,001,001,177,177 (1)1 (7) 041,001,000 ;1
BYTE (7) 061,111,101,105,101 (1)1 (7) 103,101,041 ;2
BYTE (7) 066,111,111,111,111 (1)1 (7) 111,111,101 ;3
BYTE (7) 177,010,010,010,010 (1)1 (7) 010,010,170 ;4
BYTE (7) 106,111,111,111,111 (1)1 (7) 111,171,000 ;5
BYTE (7) 017,011,011,011,011 (1)1 (7) 111,077,000 ;6
BYTE (7) 100,140,120,110,104 (1)1 (7) 102,101,100 ;7
BYTE (7) 066,111,111,111,111 (1)1 (7) 111,111,066 ;8
BYTE (7) 176,111,110,110,110 (1)1 (7) 110,110,060 ;9
OTHER: BYTE (7) 000,000,000,000,000 (1)1 (7) 000,000,000 ;BLANK
SUBTTL Plotter Control
LIT ;FLUSH LITERALS
TOPSEG
PLSIX: ;SIXBIT ENTRY POINT
PHASE 0 ;AND PHASE THE CODE
PLSIXX: MOVSI T1,600 ;6BIT BYTES FROM DISK
SKIPA
PLSVNX: MOVSI T1,700 ;7BIT BYTES FROM DISK
MOVEM T1,P$DBPT(AP) ;AND STORE THE BYTE POINTER
PLTOUT: SOSLE P$DBCT(AP)
JRST XC(PLTLDB)
PUSHJ P,CHKLIM
PUSHJ P,FILL
PJRST GETSPL
PLTLDB: ILDB C,P$DBPT(AP)
JUMPE C,XC(PLTOUT)
SOSG P$LBCT(AP)
PUSHJ P,DOOUT
IDPB C,P$LBPT(AP)
JRST XC(PLTOUT)
PLSIXS==.-PLSIXX
DEPHASE
LOWSEG
CHKLIM: MOVE T1,[%NSUPT]
GETTAB T1,
SETZ T1,
SUB T1,P$XUPT(AP) ;SUBTRACT UPTIME AT THE START
IDIV T1,JIFSEC ;CONVERT JIFFIES TO SECONDS
IDIVI T1,^D60 ;CONVERT SECONDS TO MINUTES
MOVEM T1,P$APRT(AP) ;SAVE AS AMOUNT PROCESSED
CAML T1,P$RLIM(AP) ;OVER LIMIT?
PJRST XCEED ;YES, GIVE ERROR
POPJ P, ;NO, RETURN
P%DVOU: SOSG P$LBCT(AP)
PUSHJ P,DOOUT
IDPB C,P$LBPT(AP)
POPJ P,
TOPSEG
P%HEAD: MOVEI C,40
PUSHJ P,P%DVOU
MOVEI N,MINUSY
MOVEI C,1
PUSHJ P,P%DVOU
SOJG N,.-1
MOVEI N,PLUSX
MOVEI C,4
PUSHJ P,P%DVOU
SOJG N,.-1
MOVEI N,PLUSY
MOVEI C,2
PUSHJ P,P%DVOU
SOJG N,.-1
P%TAIL: POPJ P,
SUBTTL PAPER TAPE PUNCH CONTROL
;FILE HEADER AND TRAILER MAKERS
TOPSEG
T%HEAD: PUSH P,P$APRT(AP) ;SAVE AMOUNT PRINTED
MOVEI T2,14 ;SET A COUNT
MOVE T1,[POINT 6,.EQUSR(AP)] ;SET UP POINTER
PUSHJ P,OUTPIC ;PUNCH THE PICTURE
LOAD T1,.FPINF(QP),FP.NFH;GET NO FILE HEADERS BIT
JUMPN T1,PTPCNT ;RETURN IF ON
SETZ C, ;CLEAR C
MOVEI N,^D25 ;SET COUNT
PUSHJ P,NOFC ;PUNCH THE NULLS
PUSHJ P,OUTFNM ;PRINT FILE NAME
TELL USR,[ASCIZ / ] _ @/]
MOVEI T1,^D10 ;10 SETS
HEAD1: MOVEI N,12 ;SET A COUNT
MOVEI C,0 ;NULL
PUSHJ P,NOFC ;PUNCH SOME NULLS
MOVEI N,12 ;SET THE COUNT AT 10
MOVEI C,177 ;HOLY PAPER
PUSHJ P,NOFC ;PUNCH 10 LACED FRAMES
SOJG T1,HEAD1 ;LOOP FOR MORE
PTPCNT: SETZ C, ;CLEAR C
MOVEI N,CHPFLD ;ALLOW MORE ROOM
PUSHJ P,NOFC ;BANG OUT THE NULLS
POP P,P$APRT(AP) ;RESTORE AMOUNT PUNCHED
POPJ P, ;AND RETURN
;HERE TO PUNCH FILE.EXT INTO TAPE
OUTFNM: MOVE T1,[POINT 6,P$DUUO+.RBNAM(AP)]
MOVEI T2,6 ;SET THE COUNT
PUSHJ P,OUTPIC ;PUNCH THE FILE NAME
MOVEI C,"." ;SET UP THE DOT
PUSHJ P,PICTURE ;PUNCH IT
MOVE T1,[POINT 6,P$DUUO+.RBEXT(AP)]
MOVEI T2,3 ;SET THE COUNT
PUSHJ P,OUTPIC ;PUNCH THE PICTURE
POPJ P, ;RETURN
T%TAIL: PUSH P,P$APRT(AP) ;SAVE AMOUNT PRINTED
MOVEI N,CHPFLD ;ALLOW SOME SPACE
SETZ C, ;CLEAR C
PUSHJ P,NOFC ;PUNCH SOME BLANK TAPE
MOVEI N,5
MOVEI C,232 ;EOF
PUSHJ P,NOFC ;PUNCH SOME EOF'S
SETZ C, ;AND A FEW NULLS
MOVEI N,^D20
PUSHJ P,NOFC ;GO BANG 'EM OUT
MOVE T1,[POINT 6,[SIXBIT .*EOF*.]]
TXNE S,ABORT ;JOB ABORTED FOR SOME REASON?
MOVE T1,[POINT 6,[SIXBIT .*ABORTED*.]]
MOVEI T2,5 ;LOAD A CHARACTER COUNT
TXNE S,ABORT ;CHECK AGAIN
MOVEI T2,^D9 ;AND LOAD THE COUNT
PUSHJ P,OUTPIC ;SAY END OF FILE
LOAD T1,.FPINF(QP),FP.NFH;GET NO FILE HEADERS BIT
SKIPN T1 ;SKIP FILENAME IF ON
PUSHJ P,OUTFNM ; AND FILE NAME
MOVEI N,CHPFLD ;GO TO A FOLD
SETZ C, ;PUSCH NULLS
PUSHJ P,NOFC ;GO DO IT.
POP P,P$APRT(AP) ;RESTORE AMOUNT PUNCHED
POPJ P, ;AND RETURN
;SUBROUTINE TO PUNCH A FILE IN IMAGE MODE
; BLT INTO LOWSEG THEN CALL WITH:
; PUSHJ P,PTPOUT
; EOF RETURN
;
PTIMA: PHASE 0 ;WHERE IT SHOULD BE LOCATED
PTPLP: SOSLE P$DBCT(AP) ;ANYTHING LEFT?
JRST XC(PTPLDB) ;YES--GET A WORD
PUSHJ P,FILL ;N0--FILL A BUFFER
PJRST GETSPL ;OUT OF DATA
PTPLDB: ILDB C,P$DBPT(AP) ;GET THE BYTE
PUSHJ P,T%DVOU ;PUNCH
JRST XC(PTPLP) ;LOOP
DEPHASE
PTIMAS==.-PTIMA
;SUBROUTINE TO PUNCH A FILE IN ELEVEN FORMAT
;THE FORMAT IS AS FOLLOWS:
;BYTE 1 IN BITS 10-17
; 2 IN BITS 2-09
; 3 IN BITS 28-35
; 4 IN BITS 20-27
PTELF: PHASE 0 ;WHERE IT SHOULD BE LOCATED
PTPLP: SOSLE P$DBCT(AP) ;ANYTHING LEFT
JRST XC(PTPLDB) ;YES--GET A WORD
PUSHJ P,FILL ;NO--FILL A BUFFER
PJRST GETSPL ;OUT OF DATA
PTPLDB: ILDB C,P$DBPT(AP) ;LOAD A WORD
MOVEM C,ELFCH ;STORE IT FOR LATER
MOVEI T1,3 ;FOR SELECTION OF BYTE POINTER
SUBI P1,3 ;COUNT DOWN QUOTA
CCL11: LDB C,ELFPTR(T1) ;SELECT A BYTE
PUSHJ P,T%DVOU ;PUT IT IN THE TAPE
SOJGE T1,XC(CCL11) ;COUNT DOWN
JRST XC(PTPLP) ;LOOP
DEPHASE
PTELFS==.-PTELF
;SUBROUTINE TO PUNCH A FILE IN ASCII
;CALL WITH
; PUSHJ P,PTPOUT ;AFTER BLT
; EOF RETURN
;
PTASC: PHASE 0 ;PHASED CODE
MOVSI T1,700 ;USE 7 BIT BYTES FROM DISK
MOVEM T1,P$DBPT(AP) ;SAVE THE BYTE POINTER
PTPLP1: SOSLE P$DBCT(AP) ;ANYTHING TO PUNCH?
JRST XC(PTLDB) ;YES--GO PUNCH IT
PUSHJ P,FILL ;GO GET MORE
PJRST GETSPL ;END OF FILE
PTLDB: ILDB C,P$DBPT(AP) ;GET A CHAR
JUMPE C,XC(PTPLP1) ;IGNORE NULLS
MOVEI T1,(C) ;COPY CHAR
LSH T1,-4 ;SHIFT OVER
XORI T1,(C) ;FIND DIFFERENT BITS
TRCE T1,14 ;LOOK AT 2 BITS
TRNN T1,14 ;ARE THEY THE SAME?
TRC C,200 ;YES--MAKE EVEN PARITY
TRCE T1,3 ;LOOK AT THE OTHER 2 BITS
TRNN T1,3 ;ARE THEY THE SAME?
TRC C,200 ;YES--MAKE EVEN PARITY
PTPUT: PUSHJ P,T%DVOU ;PUNCH THE CHAR
CAIE C,11 ;HORIZ. TAB?
CAIN C,213 ;VERT. TAB?
JRST XC(PTPP1) ;YES--ADD A RUBOUT
CAIE C,14 ;FORM FEED?
JRST XC(PTPLP1) ;NO-- MARCH ON.
MOVEI T1,20 ;NEED 20 NULLS
PTPU1: SETZ C, ;NULL
PUSHJ P,T%DVOU ;PUNCH
SOJG T1,XC(PTPU1) ;COUNT DOWN NULLS
JRST XC(PTPLP1) ;GET NEXT CHAR
PTPP1: MOVEI C,377 ;RUBOUT
JRST XC(PTPUT) ;PUNCH
DEPHASE
PTASCS==.-PTASC
;SUBROUTINE TO PUNCH TAPE IN BINARY MODE
;BLT TO PTPOUT
;CALL WITH:
; PUSHJ P,PTPOUT
; RETURN HERE
;
PTBIN: PHASE 0
SETZ T1, ;FORCE A CHECKSUM
BINLP: SOSLE P$DBCT(AP) ;ANY CHARS?
JRST XC(BNLDB) ;YES--GO EAT ONE
PUSHJ P,FILL ;READ A BLOCK
PJRST GETSPL ;GO IT
BNLDB: SOJG T1,XC(CHECKD) ;JUMP UNLESS WE NEED A CHECKSUM
;HERE TO COMPUTE THE FOLDED CHECKSUM. NOTE THAT THE DISK BUFFER
; MUST BE A MULTIPLE OF THE PUNCH BUFFER FOR THIS TO WORK SINCE
; IT LOOKS AHEAD IN THE INPUT BUFFER.
MOVE N,P$DBCT(AP) ;GET NUMBER OF DATA WORDS (ED.155)
CAILE N,40 ;LE 40?
MOVEI N,40 ;NO, USE BLOCKS OF 40
MOVN T2,N ;GET -VE COUNT
MOVSS T2 ;SWAP HALVES
HRR T2,P$DBPT(AP) ;GET POINTER TO DATA
AOS T2 ;INCREMENT BYTE POINTER
SETZ T1, ;CLEAR THE SUM
CKS12A: ADD T1,(T2) ;TAD IN A WORD
AOBJN T2,XC(CKS12A) ;LOOP FOR MORE
LSHC T1,-30 ;FOLD THE SUM
LSH T2,-14
ADD T1,T2
LSHC T1,-14
LSH T2,-30
ADD T1,T2
TRZE T1,770000
AOS T1
HRL N,T1 ;PUT SUM IN LEFT HALF
HRRZ T1,N ;SAVE WORD COUNT FOR LOOP
MOVEI T2,5 ;LEAVE SEVERAL BLANK FRAMES
SETZ C, ;SUPER NULL
CKS12B: PUSHJ P,T%DVOU ;THWAP!
SOJG T2,XC(CKS12B) ;GRIND OUT SOME MORE
PUSHJ P,XC(TPUNWD)
POPJ P,
CHECKD: ILDB N,P$DBPT(AP) ;GET A WORD
PUSHJ P,XC(TPUNWD) ;PUNCH IT
POPJ P,
JRST XC(BINLP)
TPUNWD: MOVE T2,XC(PTBPX) ;GET THE BYTE-POINTER
BINLP1: ILDB C,T2 ;GET THE BYTE
TRO C,200 ;SET THE BINARY BIT
PUSHJ P,T%DVOU ;PUNCH IT-- AT LAST!
TLNE T2,770000 ;DONE?
JRST XC(BINLP1) ;NO, LOOP
JRST .POPJ1## ;DONE!
PTBPX: POINT 6,N
DEPHASE
PTBINS==.-PTBIN
;SUBROUTINE TO PUNCH TAPE IN IMAGE BINARY
;BLT TO PTPOUT
;CALL WITH:
; PUSHJ P,PTPOUT
; EXIT
;
PTIBI: PHASE 0
MOVSI T1,600 ;USE 6 BIT BYTES FROM DISK
MOVEM T1,P$DBPT(AP) ;SAVE BYTE POINTER
PTPLP2: SOSLE P$DBCT(AP) ;ANYTHIN TO PUNCH?
JRST XC(PTLDB1) ;PUNCH IT
PUSHJ P,FILL ;REFILL BUFFER
PJRST GETSPL ;DONE!
PTLDB1: ILDB C,P$DBPT(AP) ;PICK UP A WORD
TRO C,200 ;ADD A BIT
PUSHJ P,T%DVOU ;PUNCH
JRST XC(PTPLP2) ;LOOP FOR MORE
DEPHASE
PTIBIS==.-PTIBI
;SUBROUTINE TO PRINT N LINES OF C(C)
;CALL WITH:
; MOVEI N,NUMBER-OF-COPIES
; MOVE C,CHAR
; PUSHJ P,NOFC
; RETURN
;
NOFC: PUSHJ P,T%DVOU ;OUTPUT A CHAR
SOJG N,.-1 ;LOOP FOR MORE
POPJ P,
;SUBROUTINE TO PRINT A PICTURE IN TAPE
;CALL WITH:
; MOVE T1,BYTE-POINTER
; MOVE T2,LENGTH
; PUSHJ P,OUTPIC
; RETURN HERE
;
OUTPIC: MOVEM T1,PSAVT1# ;SAVE POINTER
MOVEM T2,PSAVN# ;SAVE COUNT
PICLP: ILDB C,PSAVT1 ;GET A BYTE
JUMPE C,NOPUN ;IGNORE NULLS
TPUN: MOVEI C,40(C) ;CONVERT TO ASCII
PUSHJ P,PICTUR ;PUNCH
NOPUN: SOSE PSAVN ;COUNT DOWN COUNT
JRST PICLP ;LOOP FOR MORE
MOVEI C,40 ;LOAD A SPACE
PUSHJ P,PICTUR ;PUNCH IT
MOVEI C,40 ;AND ANOTHER
PJRST PICTUR ;PUNCH IT AND RETURN
;SUBROUTINE TO PUNCH 1 CHAR INTO TAPE
;CALL WITH:
; MOVE C,CHAR
; PUSHJ P,T%DVOU
; RETURN HERE
;
LOWSEG
T%DVOU: SOSG P$LBCT(AP) ;ROOM IN BUFFER
PUSHJ P,DOOUT ;NO, OUTPUT THE BUFFER
IDPB C,P$LBPT(AP) ;STORE BYTE
PUSH P,C ;SAVE C
AOS C,P$XCNT(AP) ;INCREMENT AND LOAD FRAME COUNT
TXNE C,<MASK.(LCPF,35)>;PRINT A FOOT?
JRST PTRET ;NO, RETURN
AOS C,P$APRT(AP) ;YES, INCREMENT AND LOAD AMOUNT PUNCHED
CAML C,P$RLIM(AP) ;SKIP IF UNDER QUOTA
JRST [POP P,(P) ;RESTORE THE STACK
JRST XCEED] ;AND GIVE QUOTA EXCEEDED MESSAGE
PTRET: POP P,C ;RESTORE C
POPJ P, ;AND RETURN
;SUBROUTINE TO PUNCH BLOCK CHARS. -- ART BAKER
;CALL WITH:
; MOVE C,CHAR-TO-PUNCH
; PUSHJ P,PICTURE
; RETURN HERE
;
PICTUR: PUSHJ P,.SAVE2## ;GET 2 AC'S
PUSH P,T5 ;SAVE T5 ALSO (ED.154)
MOVEI P1,5 ;HOW MANY COLUMNS
CAIGE C,40 ;CAN WE PUNCH THIS?
PJRST T5POPJ ;RESTORE T5 AND RETURN
CAILE C,"_" ;LOWER CASE?
MOVEI C,-40(C) ;YES--CONVERT TO UPPER CASE
MOVEI T1,-40(C) ;SUBTRACT 40 -- MAKE SIXBIT
MOVEI T2,20 ;A MASK FOR LATER
LOOP2: MOVE T4,[POINT 5,CHRTAB(T1)] ;POINTER TO CHARACTER
MOVEI P2,7 ;HOW MANY ROWS
SETZ C, ;NEED THIS IN AWHILE
LOOP: ILDB T5,T4 ;GET FIVE BITS FRM CHRTAB
AND T5,T2 ;USE ONLY ONE OF THEM
MOVN T3,P1 ;HOW MANY STILL LEFT?
LSH T5,10(T3) ;SHIFT IT TO THE LEFT
IOR C,T5 ;AND PUT BIT IN PLACE
LSH C,-1 ;THEN SHIFT EVERYONE RIGHT
SOJG P2,LOOP ;KEEP GOING?
PUSHJ P,T%DVOU ;OUTPUT THE BYTE (IMAGE MODE)
SOJL P1,AWAY ;ALL COLUMNS DONE?
LSH T2,-1 ;SHIFT MASK TO RIGHT
JRST LOOP2 ;AND KEEP GOING
AWAY: SETZ C, ;2 BLANK COLUMNS -- TO LOOK PRETTY
PUSHJ P,T%DVOU
PUSHJ P,T%DVOU
T5POPJ: POP P,T5 ;RESTORE T5
POPJ P, ;RETURN TO CALLER
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) 00,04,16,25,04,04,00 ;^
BYTE (5) 00,04,10,37,10,04,00 ;_
SUBTTL Common Processing Routines
;HERE WHEN USER EXCEEDS HIS QUOTA
XCEED: MOVE T1,P$APRT(AP) ;GET AMOUNT PROCESSED
ADDI T1,1000 ;GET HIM AN OVERDRAW FOR THE TRAILER
MOVEM T1,P$RLIM(AP) ;AND STORE IT
TELL USR,%%PLE ;TELL THE USER
SKIPE MSGERR ;SKIP IF NOT FOR OPR
TELL OPR,%%PLE ;GIVE A MESSAGE
ON S,ABORT ;SET ABORT FLAG
SETOM P$DBCT(AP) ;IGNORE CURRENT DISK BUFFER
PUSHJ P,SETEOF ;CAUSE EOF TO HAPPEN
OUTPUT DCH, ;DUMP LAST BUFFERFUL
POPJ P, ;AND RETURN
;HERE TO OUTPUT THE CURRENT BUFFER
DOOUT: SKIPE TTYFLG ;OPR TYPE ANYTHING?
PUSHJ P,CHKOPR ;YES, SEE WHAT HE SAID
OUT DCH, ;DUMP THE BUFFER
JRST [SETOM HNGCNT ;CLEAR THE HUNG FLAG
POPJ P,] ;AND RETURN
GETSTS DCH,N ;ELSE GET DEVICE STATUS
TELL OPR,%%ODE ;PRINT THE MESSAGE
JRST RESETC ;AND RESET
;HERE IF WE GET AN UNIMPLEMENTED FILE FORMAT
NOTYET: TELL OPR,%%RUU
POPJ P, ;AND RETURN
SUBTTL INITIALIZATION
LOWSEG
SPROUT: JRST .+2 ;SKIP IF NORMAL START
OUTSTR %%CCL ;NO CLL ENTRY
RESET ;CLEAR ALL ACTIVE I/O
MOVE T1,.JBFF ;LOAD JOBFF
CORE T1, ;MAKE THE MEMORY MANAGER RESTARTABLE
JFCL ;WELL, WE TRIED!!
JRST SPOINI ;AND GO TO THE HISEG
TOPSEG
SPOINI: MOVE P,[IOWD PDSIZE,PDL]
MOVEI S1,0 ;LET CSPQSR HANDLE INTERRUPTS
PUSHJ P,CSPINI## ;INITIALIZE THE QUASAR INTERFACE
MOVEI S1,2 ;WE WANT TWO PAGES
PUSHJ P,M$AQNP## ;GET A PAGE OR TWO
LSH AP,^D9 ;THAT'S THE JOB PARAMETER PAGE
MOVEM AP,JOBPAG ;AND SAVE THE ADDRESS
MOVE S,[INITS] ;SET OUR GLOBAL AC'S
PUSHJ P,GETSPL ;GET THE CORRECT HISEG
MOVE T1,[%CNTIC] ;GET GETTAB ADR
GETTAB T1, ;GET THE CLOCK FREQUENCY
MOVEI T1,^D60 ;ASSUME JIFSEC=60
MOVEM T1,JIFSEC ;AND STORE IT
PUSHJ P,SETINT ;FOR DEVICE O.K. INTERRUPT
MOVSI T1,'TTY' ;CONDITION NAME
MOVX T2,PS.RID ;IO REASON
MOVEI T3,TTYINT ;AND INTERRUPT ADDRESS
PUSHJ P,CSPPSI## ;AND ENABLE IT
SETZM XITFLG ;CLEAR EXIT PENDING
SETZM RSTFLG ;CLEAR RESET PENDING
SETZM MSGFIL ;CLEAR MESSAGE FILE
SETOM MSGERR ;SET MESSAGE ERROR
MOVX T2,<-2,,.GTDEV> ;GET THE HISEG DEVICE
GETTAB T2, ; ..
MOVSI T2,'DSK' ;STRANGE?
MOVX T3,<-2,,.GTPRG> ;GET HISEG PROGRAM NAME
GETTAB T3, ; ..
MOVE T3,['SPROUT'] ;GIVE THE DEFAULT
MOVX T4,<-2,,.GTPPN> ;GET THE HISEG PPN
GETTAB T4, ; ..
GETPPN T4, ;SAY SOMETHING
SVHISG: 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
MOVEI T1,.GTLOC ;GETTAB FOR CENTRAL SITE
GETTAB T1, ;GET IT
SETZ T1, ;NO WHERE!!
HRRZM T1,CNTSTA ;SAVE IT
HRROI T1,.GTLOC ;GETTAB FOR MY SITE
GETTAB T1, ;GET IT
SETZ T1, ;OH WELL,
HRRZM T1,MYSTA ;AND SAVE MY STATION
MOVX T1,FRMNOR ;GET NORMAL FORMS
MOVEM T1,P$FORM(AP) ;SAVE IT
MOVEM T1,P$FPFM(AP) ;SAVE AS PREVIOUS
CLEARM NXTJOB ;CLEAR OUT NXTJOB
MOVX T1,MAXLIM ;GET MLIMIT
MOVEM T1,MLIM ;AND STORE IT
MOVE T1,[PUSHJ P,UUOL] ;PUSHJ FOR UUO'S
MOVEM T1,.JB41 ;SAVE IN USER 41
IFN FACTSW,<
MOVE N,[1,,[EXP .FACT]] ;WRITE A ZERO LENGTH
DAEMON N, ; FACT FILE ENTRY
SKIPA N,[0] ;LOAD A ZERO
SETO N, ;LOAD A -1
MOVEM N,FACTFL# ;STORE THE FLAG
> ;END OF IFN FTFACT
NOFACT: TELL OPR,STAR ;FLASH A STAR
INILP: INCHWL SAVCHR ;GET A CHAR
PUSHJ P,COMIN ;DO THE COMMAND
IFOFF S,OPENB,INILP ;IF NOT START TRY AGAIN
MOVNI T1,1 ;FOR ME,
WAKE T1, ;WAKE ME
JFCL ;THATS STRANGE
JRST MAIN
SUBTTL MESSAGES
;THE FIRST CHAR OF EACH MESSAGE IS THE PRIORITY THE SECOND IS THE
;INITIAL LENGTH CODE. THE FOLLOWING CHARACTORS HAVE A SPECIAL MEANING:
;
; # PRINT N AS DECMAL
; & PRINT N AS OCTAL
; @ PRINT THE TIME
; _ PRINT THE DATE
; ^ PRINT THE CURRENT FILE NAME
; [ PRINT THE CURRENT UFD
; ] PRINT THE PPN OF CURRENT USER
; ; CHANGE LENGTH CODE (NEW CODE AFTER ;)
; + PRINT T1 AS A SIXBIT WORD
; $ PRINT THE CURRENT PROCESSING DEVICE
;***WARNING*** This page is in upper and lower case and
; should not be edited with TECO unless you have a Full char
; set TTY. If it is neccessary to edit on a KSR33 or
; similar TTY use an editor which will indicate lower case
; for example SOS (DECUS 10-16)
;
DEFINE TEXT,<
XLIST
WHAT1: ASCIZ /Job:+ Seq:# /
WHAT3: ASCIZ ?Name:+?
WHAT4: ASCIZ ?+, ?
WHAT4A: ASCIZ ?PPN:]
?
WHAT6: [ASCIZ ? Punched:#/?]
[ASCIZ ? Punched:#/?]
[ASCIZ ? Plotted:#/?]
WHAT7: [ASCIZ ?# feet, Copy:?]
[ASCIZ ?# cards, copy:?]
[ASCIZ ?# mins, copy:?]
WHAT8: ASCIZ ?#/?
WHAT9: ASCIZ ?#
?
WHAT10: ASCIZ ?File:^[/DISP:?
WHAT11: ASCIZ ?+?
CRLF: ASCIZ /
/
FTYPE: ASCIZ /+ forms mounted
/
UNEXPD: ASCIZ \? Unexpected string (+) found while scanning for switch - ignored
\
BADNMS: ASCIZ /? Bad Decimal number
/
BADSW: ASCIZ /Bad Switch
/
CURMS1: ASCIZ /Current defaults:
MLIMIT:#
/
%%DIS: ASCIZ /?SPODIS Device + is spooled
/
%%DDE: ASCIZ /?SPODDE Device + does not exist
/
%%WFF: ASCIZ /![SPOWFF Waiting for + forms to be mounted!]
/
%%FAF: ASCIZ /![SPOFAF + forms are frozen!]
/
%%WFS: ASCIZ /![SPOWFS Waiting for start-class command!]
/
%%SIS: ASCIZ /![SPOSIS Spooler is STOP'ed or PAUSE'ing!]
/
%%SWP: ASCIZ /![SPOSWP SPROUT will PAUSE at end of job!]
/
%%CCL: ASCIZ /%SPOCCL CCL entry is not supported
/
%%CPC: ASCIZ /![SPOCPC Clearing pending EXIT, RESET, and PAUSE commands!]
/
%%SIR: ASCIZ /![SPOSIR SPROUT is RESET on $!]
/
%%SAS: ASCIZ /%SPOSAS SPROUT is Already START'ed on $
/
%%IDE: ASCIZ /%SPOIDE Input Data Error &, recovery attempted
/
%%FSD: ASCIZ \?SPOFSD File Skipped due to I/O errors, status &
\
%%ODE: ASCIZ /?SPOODE Output Device Error on $, status &
/
%%CCF: ASCIZ /%SPOCCF Can't Change Forms in the middle of a job
/
%%PLE: ASCIZ /?SPOPLE PTP Limit Exceeded
/
%%RUU: ASCIZ /%SPORUU Request Uses Unimplemented format
/
%%ICA: ASCIZ /?SPOICA Illegal Command Argument #
/
%%ICAS: ASCIZ /?SPOICA Illegal Command Argument +
/
%%CAF: ASCIZ /?SPOCAF Can't Access File, code &
/
DEVBSY: ASCIZ /![Device $ is not available!]
/
BADCOM: ASCIZ /? + is an unknown Command
/
MOUNTM: ASCIZ .Mount + forms then type GO
.
NOTBSY: ASCIZ .Spooler is idle
.
DEVOK: ASCIZ /% Device $ is not ready
/
MESS1: ASCIZ /Job + file ^[ for ] started
/
STAR: ASCIZ !/!
EXCLPT: ASCIZ /!!/
LIST
SALL> ;CLOSE TEXT MACRO
TEXT
LOWSEG
VAR
LIT
SPLEND::END SPROUT