Trailing-Edge
-
PDP-10 Archives
-
decuslib10-10
-
43,50521/quewmu.mac
There is 1 other file named quewmu.mac in the archive. Click here to see a list.
UNIVERSAL QUEUNV - DEFINITIONS FOR CONDITIONAL ASSEMBLY OF QUEWMU
COMMENT %
TO ASSEMBLE FOR GALAXY QUEUEING SYSTEM DEFINE FTGALAXY=1
TO ASSEMBLE FOR AN MPB QUEUEING SYSTEM DEFINE FTMPB=1
TO ASSEMBLE A QUEUEING SYSTEM WHICH WILL WORK ON EITHER TOPS10 GALAXY OR MPB,
DEFINE BOTH FTGALAXY=1 AND FTMPB=1. THIS IS USEFUL WHEN RUNNING EACH
SYSTEM PART OF THE TIME, BUT IS TOO BIG FOR LONG TERM USE.
%
IFNDEF FTGALAXY,<FTGALAXY==0> ;1 IF GALAXY
IFNDEF FTMPB,<
IFE FTGALAXY,<FTMPB==1> ;1 FOR MPB
IFN FTGALAXY,<FTMPB==0>> ;0 FOR NO MPB
IFN FTGALAXY,<
SEARCH QSRMAC,SBSMAC
IFN FTJSYS,<FTMPB==0> ;NO MPB ON TOPS20
>
FTBOTH==FTGALAXY*FTMPB ;WANT BOTH ON TOPS10?
IFE FTGALAXY,<
IFE FTMPB,<
PRINTX ?FTGALAXY AND FTMPB CANNOT BOTH BE ZERO
PASS2
END
>>
DEFINE IFGALX(LABEL),< ;EXECUTE NEXT BLOCK ONLY IF GALAXY SYSTEM
IFN FTBOTH,<
IFB <LABEL>,<JUMPGE F,.+2>
IFNB <LABEL>,<JUMPGE F,LABEL>
>
>
DEFINE IFMPB(LABEL),< ;EXECUTE NEXT BLOCK ONLY IF MPB SYSTEM
IFN FTBOTH,<
IFB <LABEL>,<JUMPL F,.+2>
IFNB <LABEL>,<JUMPL F,LABEL>
>
>
; FLAG BITS IN LH OF F
GALAXY==400000 ;FLAG THAT THIS IS A GALAXY SYSTEM. MUST BE SIGN BIT
NEDREN==200000 ;FLAG IN $DOFIL THAT A RENAME IS NEEDED
LOGFIL==100000 ;FLAG TO DOFIL$ THAT THIS IS THE LOG FILE
CTLFIL==40000 ;FLAG TO DOFIL$ THAT THIS IS THE CTL FILE
IFNDEF LANGSW,<LANGSW==0> ;0 = FORTRA
;1 = COBOL
;-1 = ALGOL
IFG LANGSW,< ;IF COBOL
F40LIB==0
P=17
DEFINE HELLO(A),<
SALL
ENTRY A
A:
>
DEFINE GOODBY(A),<
POPJ P,A
>
>
IFL LANGSW,< ;IF ALGOL
F40LIB==0
P=17
.EXIT==1
DEFINE HELLO(A),<
SALL
EXTERNAL %ALGDR
ENTRY A
>
DEFINE GOODBY(A),<
JRST [MOVE 14,SAVE14# ;RESTORE AN AC
JRST .EXIT(DL)]
>
>
IF1 <
IFN FTBOTH,<PRINTX ASSEMBLING FOR TOPS10 GALAXY AND MPB>
IFE FTBOTH,<
IFN FTGALAXY,<
IFN FTJSYS,<PRINTX ASSEMBLING FOR TOPS20 GALAXY>
IFE FTJSYS,<PRINTX ASSEMBLING FOR TOPS10 GALAXY>
>
IFN FTMPB,<PRINTX ASSEMBLING FOR TOPS10 MPB>
>
IFG LANGSW,<PRINTX ASSEMBLING COBOL CALLING SEQUENCE>
IFE LANGSW,<PRINTX ASSEMBLING FORTRAN-10 CALLING SEQUENCE>
IFL LANGSW,<PRINTX ASSEMBLING ALGOL CALLING SEQUENCE>
>
PRGEND
TITLE PRINTS - ROUTINE TO ENTER FILE IN PRINT QUEUE
SUBTTL USAGE INSTRUCTIONS
SEARCH MACTEN,UUOSYM,QUEUNV
IFE LANGSW,<SEARCH FORPRM ;IF COMPILING FOR FORTRA>
IFL LANGSW,<SEARCH ALGPRM,ALGSYS ;IF COMPILING FOR ALGOL>
IFN FTGALAXY,<
SEARCH QSRMAC,SBSMAC
IFN FTJSYS,<
SEARCH MONSYS ;TOPS20 DEFINITIONS
>
>
IFN FTMPB,<
SEARCH QPRM
>
; FORPRM IS UNIVERSAL FILE FROM FOROTS
; ALGPRM IS UNIVERSAL FILE FOR ALGOL
; ALGSYS IS UNIVERSAL FILE FOR ALGOL
; QPRM IS UNIVERSAL FILE FOR QUEUE DEFINITIONS. SEE ...
; MACTEN IS UNIVERSAL FILE WITH USEFUL MACRO DEFINITIONS SEE ...
; UUOSYM IS UNIVERSAL FILE WITH UUO SYMBOLS DEFINITIONS SEE ...
; QSRMAC IS UNIVERSAL FILE FOR GALAXY
; SBSMAC IS UNIVERSAL FILE FOR GALAXY
; MONSYS IS UNIVERSAL FILE FOR TOPS20
XLIST
IFE LANGSW,< ;IF FORTRA
LIST
COMMENT %
THE PURPOSE OF THIS ROUTINE IS TO ENTER A REQUEST IN THE PRINT(SPOOL)
QUEUE FROM A FORTRAN OR MACRO PROGRAM.
CALLING SEQUENCE
CALL PRINTS('FILENAME.EXT',IARG1,IARG2,IARG3)
OR
CALL PRINTS('FILENAME.EXT',IARG1,IARG2,IARG3,IARG4)
WHERE
FILENAME 6 OR FEWER CHARACTERS.
EXT 3 OR FEWER CHARACTERS.(MAY BE NULL)
IARG1 2 IF FILE IS TO BE RENAMED OUT OF AREA.
(MPB SYSTEMS ONLY. SAME AS 1 ON GALAXY SYSTEMS)
1 IF FILE IS TO BE DELETED.
0 IF FILE IS TO BE PRESERVED.
IARG2 1 IF FORTRAN FORMATTED OUTPUT
0 IF OTHER THAN FORTRAN FORMATTED OUTPUT
IARG3 LESS THAN OR EQUAL 0 IMPLIES 1 COPY.
GREATER THAN 63 IMPLIES 1 COPY.
1-63 IMPLIES THAT NUMBER OF COPIES.
IARG4 OPTIONAL PAGE LIMIT.[DEFAULT IF OMITTED IS
(#BLOCKS WRITTEN)*COPIES+20]
%
XLIST
>
IFG LANGSW,< ;IF COBOL
LIST
COMMENT %
THE PURPOSE OF THIS ROUTINE IS TO ENTER A REQUEST IN THE PRINT(SPOOL)
QUEUE FROM A COBOL PROGRAM.
CALLING SEQUENCE
ENTER MACRO PRINTS USING FILE-NAME IARG1 IARG2 IARG3 IARG4.
WHERE
FILE-NAME 9 OR FEWER CHARACTER DISPLAY-6 OR DISPLAY-7.
ARGS ARE ALL USAGE COMPUTATIONAL OR NUMERIC LITERALS.
IARG1 2 IF FILE IS TO BE RENAMED OUT OF AREA.
(MPB SYSTEMS ONLY. SAME AS 1 ON GALAXY SYSTEMS)
1 IF FILE IS TO BE DELETED.
0 IF FILE IS TO BE PRESERVED.
IARG2 2 IF COBOL SIXBIT FORMATTED OUTPUT
1 IF FORTRAN FORMATTED OUTPUT
0 IF OTHER THAN FORTRAN FORMATTED OUTPUT
IARG3 LESS THAN OR EQUAL 0 IMPLIES 1 COPY.
GREATER THAN 63 IMPLIES 1 COPY.
1-63 IMPLIES THAT NUMBER OF COPIES.
IARG4 OPTIONAL PAGE LIMIT.[DEFAULT IF OMITTED IS
(#BLOCKS WRITTEN)*COPIES+20]
%
XLIST
>
IFL LANGSW,< ;IF ALGOL
LIST
COMMENT %
THE PURPOSE OF THIS ROUTINE IS TO ENTER A REQUEST IN THE PRINT(SPOOL)
QUEUE FROM AN ALGOL PROGRAM.
CALLING SEQUENCE
PRINTS('FILENAME.EXT',IARG1,IARG2,IARG3);
OR
PRINTP('FILENAME.EXT',IARG1,IARG2,IARG3,IARG4);
WHERE
FILENAME 6 OR FEWER CHARACTERS.
EXT 3 OR FEWER CHARACTERS.(MAY BE NULL)
IARG1 2 IF FILE IS TO BE RENAMED OUT OF AREA.
1 IF FILE IS TO BE DELETED.
0 IF FILE IS TO BE PRESERVED.
IARG2 1 IF FORTRAN FORMATTED OUTPUT
0 IF OTHER THAN FORTRAN FORMATTED OUTPUT
IARG3 LESS THAN OR EQUAL 0 IMPLIES 1 COPY.
GREATER THAN 63 IMPLIES 1 COPY.
1-63 IMPLIES THAT NUMBER OF COPIES.
IARG4 OPTIONAL PAGE LIMIT.[DEFAULT IF OMITTED IS
(#BLOCKS WRITTEN+20)*COPIES]
%
XLIST
>
LIST
SUBTTL DATA AND DEFINITIONS
; AC DEFINITIONS
F=0
A=1
S1=A
B=2
S2=B
C=3
WD=4 ;SIXBIT ANSWER FROM ASCSIX
T1=WD
BP6=5 ;SIXBIT POINTER
T2=BP6
BP7=6 ;ASCII POINTER
T3=BP7
N=7 ;NUMBER
T4=N
CH=10 ;CHARACTER
T5=CH
M=T5
V=11 ;POINTER TO ARG VECTOR
QD=12 ;QUE TYPE
QF=13 ;POINTER TO CURRENT FILE BLOCK IN QUE BLOCK
Q=14 ;POINTER TO QUE AREA
SUBTTL PRINTS - DO THE WORK
HELLO (PRINTS) ;PRINTS ENTRY
IFL LANGSW,< ;IF ALGOL
IFGE <MAJVNO-5>,<
PRTSPM: Z ;POST-MORTEM BLOCK
XWD 2,7 ;WORDS, CHARACTERS+ "*"
SIXBIT/PRINTS*/ ;SIXBIT NAME PLUS "*"
>
PRINTS: JSP AX,PARAM ;4 ARGUMENT ENTRY (DEFAULT PAGE LIMITS)
IFGE <MAJVNO-5>,<
PRTSPM ;POINTER TO POST MORTEM BLOCK
>
XWD 0,15
XWD $PRO!$N!$SIM,5
XWD $VAR!$S!$FOV,3
XWD $VAR!$I!$FOV,5
XWD $VAR!$I!$FOV,6
XWD $VAR!$I!$FOV,7
SETZM ARG5# ;NO FIFTH ARG
JRST APRNT1 ;GO ON
HELLO (PRINTP) ;5 ARGUMENT ENTRY
IFGE <MAJVNO-5>,<
PRTPPM: Z ;POST-MORTEM BLOCK
XWD 2,7 ;WORDS, CHARACTERS + "*"
SIXBIT/PRINTP*/ ;SIXBIT NAME + "*"
>
PRINTP: JSP AX,PARAM ;5 ARGUMENT ENTRY(PAGE LIMIT SPECIFIED
IFGE <MAJVNO-5>,<
PRTPPM ;POINTER TO POST MORTEM BLOCK
>
XWD 0,15
XWD $PRO!$N!$SIM,6
XWD $VAR!$S!$FOV,3
XWD $VAR!$I!$FOV,5
XWD $VAR!$I!$FOV,6
XWD $VAR!$I!$FOV,7
XWD $VAR!$I!$FOV,10
SETOM ARG5# ;HAVE FIFTH ARG
APRNT1: MOVEM 14,SAVE14#
> ;END IFL LANGSW
PUSHJ P,FIRCH$## ;GET THE PRIMARY CHANNEL
JRST NODSK ;IF ERROR, GIVE SECOND MESSAGE
SETZ QD, ;MODE IS PRINT QUEUE
PUSHJ P,GTINF$## ;GET SOME INFO AND INIT QUE BLOCK
PUSHJ P,OPDSK$## ;OPEN THE DISK
JRST NODSK
IFN FTMPB,<
IFMPB PRT1
HRRZI A,111000 ;SINGLE SPACED ASCII
IFGE LANGSW,< ;IF FORTRA OR COBOL
SKIPE B,@2(16)
>
IFL LANGSW,< ;IF ALGOL
SKIPE B,6(DL)
>
MOVEI A,112000 ;MAKE THAT FORTRAN
IFG LANGSW,< ;IF COBOL
CAIN B,2 ;UNLESS WANTS COBOL FROM COBOL
MOVEI A,113000 ;GIVE IT TO HIM
>
MOVEM A,Q.OMOD(Q)
PRT1:>
IFN FTGALAXY,<
IFGALX PRT2
MOVSI A,010101 ;SINGLE SPACED ASCII
IFGE LANGSW,< ;IF FORTRA OR COBOL
SKIPE B,@2(16)
>
IFL LANGSW,< ;IF ALGOL
SKIPE B,6(DL)
>
MOVSI A,020101 ;SINGLE SPACED FORTRAN OUTPUT
IFG LANGSW,< ;IF COBOL
CAIN B,2 ;WANT COBOL FROM COBOL?
MOVSI A,030101 ;SINGLE SPACED COBOL OUTPUT
>
TRO A,FP.NFH ;NO HEADERS
MOVEM A,.FPINF(QF) ;STORE FOR FILE
PRT2:>
MOVEI A,^D10 ;DEFAULT PRIORITY IS 10
IFN FTMPB,<
IFMPB
DPB A,[POINTR(Q.PRI(Q),QP.PRI)]
>
IFN FTGALAXY,<
IFGALX
DPB A,[POINTR(.EQSEQ(Q),EQ.PRI)]
>
IFN FTMPB,<
IFMPB PRT3
MOVEI B,.QFDDE ;ASSUME /DISP:DEL
IFGE LANGSW,< ;IF FORTRA OR COBOL
SKIPG A,@1(16) ;IS IT /DISP:PRE?
>
IFL LANGSW,< ;IF ALGOL
SKIPG A,5(DL) ;IS IT /DISP:PRE?
>
MOVEI B,.QFDPR ;YES
CAIN A,2 ;IS IT /DISP:REN
MOVEI B,.QFDRE ;YES
DPB B,[POINTR(Q.OMOD(Q),QF.DSP)]
PRT3:>
IFN FTGALAXY,<
IFGALX PRT4
MOVEI A,FP.DEL ;DELETE BIT
IFGE LANGSW,< ;IF FORTRA OR COBOL
SKIPE @1(16) ;DISPOSE:PRESERVE?
>
IFL LANGSW,< ;IF ALGOL
SKIPG 5(DL) ;DISPOSE:PRESERVE?
>
IORM A,.FPINF(QF) ;SET BIT FOR FILE
PRT4:>
PUSHJ P,FILNMO
PUSHJ P,DOFIL$## ;GO DO THE FILE THINGS
JRST NTFND ;FILE NOT FOUND
IFGE LANGSW,< ;IF FORTRA OR COBOL
SKIPLE A,@3(16) ;/COPIES
>
IFL LANGSW,< ;IF ALGOL
SKIPLE A,7(DL) ;/COPIES
>
CAILE A,^D63
MOVEI A,1
IFN FTMPB,<
IFMPB
DPB A,[POINTR(Q.OMOD(Q),QF.COP)]
>
IFN FTGALAXY,<
IFGALX
DPB A,[POINTR(.FPINF(QF),FP.FCY)]
>
IMUL A,$RBSIZ##
MOVE B,A ;MAKE A COPY
IFN FTMPB,<
IFMPB PRT5
ASH A,-^D10 ;DIVIDE BY 1024
ADDI A,1
HRRM A,Q.OSIZ(Q) ;QS.BLK
PRT5:>
IDIVI B,200
SKIPE C
ADDI B,1
IFN FTGALAXY,<
IFGALX PRT6
MOVE A,B ;COPY
IFN FTJSYS,<
ADDI A,3 ;CONVERT TO PAGES
LSH A,-2
>
HRLM A,.EQLM2(Q) ;BLOCKS*COPIES
PRT6:>
ADDI B,^D20 ;FUDGE FACTOR
IFN F40LIB,<
TLNN 16,-1 ;F10?
JRST CHKF10 ;YES
HLRZ A,4(16)
TRZ A,740
CAIE A,(JUMP 0)
JRST DEFALT
JRST F40ARG
>
IFGE LANGSW,< ;IF FORTRA OR COBOL
CHKF10: HLRE A,-1(16)
MOVMS A
CAIGE A,5 ;LIMIT ARG?
JRST DEFALT ;NO
F40ARG: SKIPLE A,@4(16)
>
IFL LANGSW,< ;IF ALGOL
SKIPN ARG5 ;FIFTH ARGUMENT?
JRST DEFALT ;NO
SKIPLE A,10(DL) ;YES
>
MOVE B,A ;ONLY ACCEPT ESTIMATE IF POSITIVE
CAILE B,777776 ;LESS THAN MAX?
MOVEI B,777776 ;NO
DEFALT:
IFN FTMPB,<
IFMPB
HRLM B,Q.OSIZ(Q) ;PAGE LIMIT (QS.LIM)
>
IFN FTGALAXY,<
IFGALX
HRRM B,.EQLM2(Q) ;PAGE LIMIT
>
PUSHJ P,$DOQUE## ;ACTUALLY QUE THE FILE
JFCL ;ALREADY GAVE ERROR MESSAGE
RETPRT: PUSHJ P,XUUO$## ;MAKE SURE WE GIVE BACK PRIMARY CHANNEL
RELEAS 0,
GOODBY 200004 ;AT LEAST FOUR ARG RETURN
NODSK: OUTSTR [ASCIZ\
CANNOT INIT DISK!
\]
JRST RETPRT
NTFND: OUTSTR [ASCIZ\
FILE NOT FOUND!
\]
JRST RETPRT
FILNMO: SETZB A,B
IFE LANGSW,< ;IF FORTRAN
MOVEI BP7,@(16)
MOVEI N,^D9 ;NINE POSSIBLE CHARACTERS.
HRLI BP7,440700 ;MAKE POINTER TO STRING.
>
IFG LANGSW,< ;IF COBOL
MOVE T1,(16) ;GET ARG
MOVE BP7,(T1) ;GET POINTER
LDB C,[POINT 6,BP7,11] ;DISPLAY SIZE
HRRZ N,1(T1) ;GET CHARACTER COUNT
CAILE N,^D9 ;MORE THAN 9?
MOVEI N,^D9 ;JUST 9
>
IFL LANGSW,<
MOVE BP7,3(DL) ;GET BYTE POINTER
IFL <MAJVNO-5>,<
TLO BP7,440700 ;BE SURE
>
HRRZ N,4(DL) ;GET BYTE COUNT
CAILE N,^D10 ;TOO BIG?
MOVEI N,^D10 ;YES. SHRINK
>
MOVE BP6,[POINT 6,A]
GETCHR: ILDB CH,BP7
IFE LANGSW,< ;IF FORTRA
JUMPE CH,CPOPJ
CAIN CH,"."
JRST [MOVEI N,3
MOVE BP6,[POINT 6,B]
JRST GETCHR]
>
IFG LANGSW,< ;IF COBOL
CAIN C,7 ;ALREADY SIXBIT?
>
IFL LANGSW,< ;IF ALGOL
JUMPE CH,CPOPJ
CAIN CH,"."
JRST [CAILE N,4
MOVEI N,4 ;REDUCE TO EXT + 1
MOVE BP6,[POINT 6,B] ;FOR EXT
SOJG N,GETCHR ;ANY EXTENSION?
JRST CPOPJ ] ;NO
>
SUBI CH,40
IDPB CH,BP6
SOJG N,GETCHR
CPOPJ: POPJ P,
PRGEND
TITLE QUEOUT - ROUTINES TO MAKE OUTPUT QUEUE ENTRIES
SUBTTL USAGE INSTRUCTIONS
SEARCH MACTEN,UUOSYM,QPRM,QUEUNV
IFE LANGSW,<SEARCH FORPRM ;IF COMPILING FOR FORTRA>
IFL LANGSW,<SEARCH ALGPRM,ALGSYS ;IF COMPILING FOR ALGOL>
IFN FTGALAXY,<
SEARCH QSRMAC,SBSMAC
IFN FTJSYS,<
SEARCH MONSYS ;TOPS20 DEFINITIONS
>
>
; FORPRM IS UNIVERSAL FILE FROM FOROTS
; ALGPRM IS UNIVERSAL FILE FOR ALGOL
; ALGSYS IS UNIVERSAL FILE FOR ALGOL
; QPRM IS UNIVERSAL FILE FOR QUEUE DEFINITIONS. SEE ...
; MACTEN IS UNIVERSAL FILE WITH USEFUL MACRO DEFINITIONS SEE ...
; UUOSYM IS UNIVERSAL FILE WITH UUO SYMBOLS DEFINITIONS SEE ...
; QSRMAC IS UNIVERSAL FILE FOR GALAXY
; SBSMAC IS UNIVERSAL FILE FOR GALAXY
; MONSYS IS UNIVERSAL FILE FOR TOPS20
XLIST
IFE LANGSW,< ;IF FORTRA
LIST
COMMENT %
USAGE CALL QUEOUT(DEVICE,FILENAME,QUE,VECTOR,ERROR)
WHERE
DEVICE - IS DEVICE FILE IS ON. (MUST BE SOME KIND OF DSK)
FILENAME - IS TWO WORD ASCII FILENAME TO OUTPUT
QUE - IS ASCII NAME OF QUEUE TO PUT FILE IN
(MAY BE LPT, CDP, PTP, OR PLT)
IERR - IS ERROR CODE
VALUE MEANING
0 OK
1 UNDEFINED QUE
2 ILLEGAL DEVICE OR OPEN FAILED
3 ILLEGAL FILE NAME
4 NO SUCH FILE
5 ILLEGAL ARGUMENT IN VECTOR
6 CANNOT OPEN QUE DEVICE
7 CANNOT ENTER QUEUE COMMAND FILE
VECTOR - IS A FOURTEEN(14) WORD INTEGER ARRAY OF ARGUMENTS
VECTOR(1) /FILE: ARGUMENT
1=ASCII (DEFAULT)
2=FORTRAN DATA
3=COBOL
4=CREF(NOT IMPLEMENTED. ASSUMES ASCII)
5=RUNOFF(NOT IMPLEMENTED. ASSUMES ASCII)
6=ELEVEN
VECTOR(2) /LIMIT: ARGUMENT
VECTOR(3) /COPIES:N (FROM 1 TO 63)
VECTOR(4) /DISP:
1=PRESERVE
2=RENAME (ONLY FOR MPB SYSTEMS. ON GALAXY
SYSTEMS EQUIVALENT TO DELETE)
3=DELETE
VECTOR(5) AFTER SWITCH PART ONE
TIME OF DAY OR PLUS TIME IN MINUTES
PLUS TIME IS INDICATED BY A NEGATIVE IN VECTOR(6)
VECTOR(6) AFTER SWITCH PART TWO
DATE IN 15 BIT FORMAT OR ZERO FOR TODAY
NEGATIVE INDICATES TIME IS PLUS FORMAT
VECTOR(7) DEADLINE SWITCH PART ONE. SAME AS AFTER
VECTOR(8) DEADLINE SWITCH PART TWO. SAME AS AFTER
VECTOR(9) /PRIORITY:(N+1)
GIVE NUMBER IN RANGE 1 TO 63. ACTUAL
PRIORITY IS ONE LESS. DEFAULT IS 10
VECTOR(10) /PAPER: ARGUMENT
VALUE MEANING
LPT CDP PTP PLT
1 ARROW(*) ASCII(*) ASCII(*) IMAGE
2 ASCII 026 IMAGE ASCII(*)
3 OCTAL BINARY IMG BIN BINARY
4 SUPPRESS D029 BINARY
5 IMAGE
VECTOR(11) /HEAD:N
0=NO HEADER
1=FILE HEADER
VECTOR(12) /SPACING: ARGUMENT
1=SINGLE
2=DOUBLE
3=TRIPLE
VECTOR(13) /FORMS:NAME
FIRST FIVE CHARACTERS
VECTOR(14) REMAINING CHARACTER TO FORMS NAME
ASCII NAME OF SPECIAL FORMS TO USE
%
XLIST
>
IFG LANGSW,< ;IF COBOL
LIST
COMMENT %
USAGE ENTER MACRO QUEOUT USING DEVICE,FILENAME,QUE,VECTOR,ERROR.
WHERE
DEVICE - IS DEVICE FILE IS ON. (MUST BE SOME KIND OF DSK)
DISPLAY-6 OR DISPLAY-7.
FILENAME - IS NAME OF FILE TO OUTPUT
DISPLAY-6 OR DISPLAY-7.
QUE - IS NAME OF QUEUE TO PUT FILE IN
(MAY BE LPT, CDP, PTP, OR PLT)
DISPLAY-6 OR DISPLAY-7.
ERROR - IS ERROR CODE (COMPUTATIONAL.)
VALUE MEANING
0 OK
1 UNDEFINED QUE
2 ILLEGAL DEVICE OR OPEN FAILED
3 ILLEGAL FILE NAME
4 NO SUCH FILE
5 ILLEGAL ARGUMENT IN VECTOR
6 CANNOT OPEN QUE DEVICE
7 CANNOT ENTER QUEUE COMMAND FILE
VECTOR - IS A THIRTEEN(13) WORD INTEGER ARRAY OF ARGUMENTS
VECTOR(1) /FILE: ARGUMENT
1=ASCII (DEFAULT)
2=FORTRAN DATA
3=COBOL
4=CREF(NOT IMPLEMENTED. ASSUMES ASCII)
5=RUNOFF(NOT IMPLEMENTED. ASSUMES ASCII)
6=ELEVEN
VECTOR(2) /LIMIT: ARGUMENT
VECTOR(3) /COPIES:N (FROM 1 TO 63)
VECTOR(4) /DISP:
1=PRESERVE
2=RENAME (ONLY FOR MPB SYSTEMS. ON GALAXY
SYSTEMS EQUIVALENT TO DELETE)
3=DELETE
VECTOR(5) AFTER SWITCH PART ONE
TIME OF DAY OR PLUS TIME IN MINUTES
PLUS TIME IS INDICATED BY A NEGATIVE IN VECTOR(6)
VECTOR(6) AFTER SWITCH PART TWO
DATE IN 15 BIT FORMAT OR ZERO FOR TODAY
NEGATIVE INDICATES TIME IS PLUS FORMAT
VECTOR(7) DEADLINE SWITCH PART ONE. SAME AS AFTER
VECTOR(8) DEADLINE SWITCH PART TWO. SAME AS AFTER
VECTOR(9) /PRIORITY:(N+1)
GIVE NUMBER IN RANGE 1 TO 63. ACTUAL
PRIORITY IS ONE LESS. DEFAULT IS 10
VECTOR(10) /PAPER: ARGUMENT
VALUE MEANING
LPT CDP PTP PLT
1 ARROW(*) ASCII(*) ASCII(*) IMAGE
2 ASCII 026 IMAGE ASCII(*)
3 OCTAL BINARY IMG BIN BINARY
4 SUPPRESS D029 BINARY
5 IMAGE
VECTOR(11) /HEAD:N
0=NO HEADER
1=FILE HEADER
VECTOR(12) /SPACING: ARGUMENT
1=SINGLE
2=DOUBLE
3=TRIPLE
VECTOR(13) /FORMS:NAME
NAME OF SPECIAL FORMS TO USE
MUST BE ZERO OR DISPLAY-6 NAME.
%
XLIST
>
IFL LANGSW,< ;IF ALGOL
LIST
COMMENT %
USAGE QUEOUT(DEVICE,FILENAME,QUE,VECTOR,ERRCOD);
WHERE
DEVICE - IS DEVICE FILE IS ON. (MUST BE SOME KIND OF DSK)
STRING VARIABLE (ASCII).
FILENAME - IS NAME OF FILE TO OUTPUT
STRING VARIABLE (ASCII).
QUE - IS NAME OF QUEUE TO PUT FILE IN
(MAY BE LPT, CDP, PTP, OR PLT)
STRING VARIABLE (ASCII).
ERRCOD - IS ERROR CODE (INTEGER.)
VALUE MEANING
0 OK
1 UNDEFINED QUE
2 ILLEGAL DEVICE OR OPEN FAILED
3 ILLEGAL FILE NAME
4 NO SUCH FILE
5 ILLEGAL ARGUMENT IN VECTOR
6 CANNOT OPEN QUE DEVICE
7 CANNOT ENTER QUEUE COMMAND FILE
VECTOR - IS A FOURTEEN(14) WORD INTEGER ARRAY OF ARGUMENTS
VECTOR(1) /FILE: ARGUMENT
1=ASCII (DEFAULT)
2=FORTRAN DATA
3=COBOL
4=CREF(NOT IMPLEMENTED. ASSUMES ASCII)
5=RUNOFF(NOT IMPLEMENTED. ASSUMES ASCII)
6=ELEVEN
VECTOR(2) /LIMIT: ARGUMENT
VECTOR(3) /COPIES:N (FROM 1 TO 63)
VECTOR(4) /DISP:
1=PRESERVE
2=RENAME (ONLY FOR MPB SYSTEMS. ON GALAXY
SYSTEMS EQUIVALENT TO DELETE)
3=DELETE
VECTOR(5) AFTER SWITCH PART ONE
TIME OF DAY OR PLUS TIME IN MINUTES
PLUS TIME IS INDICATED BY A NEGATIVE IN VECTOR(6)
VECTOR(6) AFTER SWITCH PART TWO
DATE IN 15 BIT FORMAT OR ZERO FOR TODAY
NEGATIVE INDICATES TIME IS PLUS FORMAT
VECTOR(7) DEADLINE SWITCH PART ONE. SAME AS AFTER
VECTOR(8) DEADLINE SWITCH PART TWO. SAME AS AFTER
VECTOR(9) /PRIORITY:(N+1)
GIVE NUMBER IN RANGE 1 TO 63. ACTUAL
PRIORITY IS ONE LESS. DEFAULT IS 10
VECTOR(10) /PAPER: ARGUMENT
VALUE MEANING
LPT CDP PTP PLT
1 ARROW(*) ASCII(*) ASCII(*) IMAGE
2 ASCII 026 IMAGE ASCII(*)
3 OCTAL BINARY IMG BIN BINARY
4 SUPPRESS D029 BINARY
5 IMAGE
VECTOR(11) /HEAD:N
0=NO HEADER
1=FILE HEADER
VECTOR(12) /SPACING: ARGUMENT
1=SINGLE
2=DOUBLE
3=TRIPLE
VECTOR(13) /FORMS:NAME
NAME OF SPECIAL FORMS TO USE
(ASCII IN INTEGER FIELD?)
VECTOR(14) REST OF NAME
%
XLIST
>
LIST
SUBTTL DEFINITIONS AND DATA
; BITS THAT WE MUST DEFINE BECAUSE FORPRM AND UUOSYM DISAGREE
DV.DSK==1B1 ;DEVICE IS A DSK
DV.TTY==1B14 ;DEVICE IS A TTY
; AC DEFINITIONS
F=0
A=1
S1=A
B=2
S2=B
C=3
WD=4 ;SIXBIT ANSWER FROM ASCSIX
T1=WD
BP6=5 ;SIXBIT POINTER
T2=BP6
BP7=6 ;ASCII POINTER
T3=BP7
N=7 ;NUMBER
T4=N
CH=10 ;CHARACTER
T5=CH
M=T5
V=11 ;POINTER TO ARG VECTOR
QD=12 ;QUE TYPE
QF=13 ;POINTER TO CURRENT FILE BLOCK IN QUE BLOCK
Q=14 ;POINTER TO QUE AREA
IFE LANGSW,< ;IF FORTRA
QUENAM: ASCII/LPT /
ASCII/CDP /
ASCII/PTP /
ASCII/PLT /
>
IFN LANGSW,< ;IF COBOL OR ALGOL
QUENAM: SIXBIT/LPT/
SIXBIT/CDP/
SIXBIT/PTP/
SIXBIT/PLT/
>
QUESZ==.-QUENAM
; TABLE OF MAXIMUM LEGAL PAPER MODES BY DEVICE
MAXPAP: %QFLSU ;LPT
%QFCIM ;CDP
%QFTBI ;PTP
%QFPBI ;PLT
; TABLE OF DIVISORS FOR CALCULATING DEFAULT LIMITS
LIMDIV: 1 ;LPT
1 ;CDP
1 ;PTP
^D20 ;PLT
; TABLE OF ADDITIONAL QUANTA FOR CALCULATING DEFAULT LIMITS
LIMADD: ^D20 ;LPT
^D100 ;CDP
^D20 ;PTP
^D5 ;PLT
; TABLE OF DEFAULT MODES FOR CDP(LH),PTP(RH)
PUNMOD: XWD %QFCAS,%QFTAS
XWD %QFCAS,%QFTAS
XWD 77, 77
XWD 77, 77
XWD 77, 77
XWD 77, 77
XWD 77, 77
XWD 77, 77
XWD %QFCIM,%QFTIM
XWD 77, 77
XWD 77, 77
XWD %QFCIM,%QFTIB
XWD %QFCBI,%QFTBI
XWD 77,%QFTBI
XWD %QFCBI,%QFTBI
XWD %QFCBI,%QFTBI
FILDEV: BLOCK 1 ;DEVICE FILE IS ON
FILNAM: BLOCK 2 ;FILE NAME
FILEXT=FILNAM+1 ;EXTENSION
SUBTTL QUEOUT - INITIALIZATION CODE
HELLO (QUEOUT) ;ENTRANCE
IFL LANGSW,< ;IF ALGOL
IFGE <MAJVNO-5>,<
QOUTPM: Z ;POST-MORTEM BLOCK
XWD 2,7 ;WORDS, CHARACTERS+ "*"
SIXBIT/QUEOUT*/ ;SIXBIT NAME PLUS "*"
>
QUEOUT: JSP AX,PARAM ;ENTRY
IFGE <MAJVNO-5>,<
QOUTPM ;POINTER TO POST-MORTEM BLOCK
>
XWD 0,16
XWD $PRO!$N!$SIM,6
XWD $VAR!$S!$FOV,3
XWD $VAR!$S!$FOV,5
XWD $VAR!$S!$FOV,7
XWD $ARR!$I!$FON,11
XWD $VAR!$I!$FON,13
MOVEM 14,SAVE14# ;SAVE AN AC
>
IFE LANGSW,< ;IF FORTRA
SKIPN A,@2(16) ;SPECIFYING OUTPUT QUEUE?
>
IFN LANGSW,< ;IF COBOL OR ALGOL
IFG LANGSW,< ;IF COBOL
MOVE BP7,2(16) ;QUEUE ARG
>
IFL LANGSW,< ;IF ALGOL
MOVE BP7,7(DL) ;QUEUE ARG
>
PUSHJ P,ASC6.6## ;GET WORD
JFCL ;IGNORE ERRORS
SKIPN A,WD ;ARG GIVEN?
>
MOVE A,QUENAM ;NO. ASSUME LPT
MOVSI QD,-QUESZ ;FIND IT IN TABLE
CAME A,QUENAM(QD) ;MATCH?
AOBJN QD,.-1 ;NO. TRY NEXT
JUMPGE QD,NOSUCH ;ANY MATCH?
TLZ QD,-1 ;JUST KEEP INDEX
PUSHJ P,FIRCH$## ;GET PRIMARY CHANNEL
JRST ILLDEV ;GIVE SECOND ERROR
PUSHJ P,GTINF$## ;GET QUE DEVICE, OTHER INFO
PUSHJ P,GETDEV ;GET THE DEVICE NAME
JRST ILLDEV ;ILLEGAL
PUSHJ P,GETNAM ;GET THE FILE NAME
JRST ILLNAM ;ILLEGAL
MOVEI A,16 ;DUMP MODE
MOVE B,FILDEV ;DEVICE
SETZ C, ;NO BUFFERS
PUSHJ P,XUUO$## ;DO NEXT LINE WITH APPROPRIATE CHANNEL
OPEN 0,A ;OPEN DEVICE
JRST ILLDEV ;CAN'T
SUBTTL QUEOUT - PICK UP VECTOR ARGUMENTS
IFGE LANGSW,< ;IF FORTRA OR COBOL
MOVEI V,@3(16) ;SET ADDRESS OF ARG VECTOR
IFG LANGSW,< ;IF COBOL
LDB A,[POINT 4,3(16),12]
CAIN A,15 ;IS IT SIXBIT/ASCII (IE LEVEL 01)?
HRRZ V,(V) ;YES. GET REAL ADDRESS
>
>
IFL LANGSW,< ;IF ALGOL
HRRZ V,11(DL) ;VECTOR ADDRESS
ADDI V,1 ;POINT RIGHT TO IT
>
SKIPG A,(V) ;GET FILE:XX ARG
MOVEI A,.QFFAS ;DEFAULT IS ASCII
CAILE A,.QFF11 ;LEGAL ARG?
JRST ILLARG ;NO. ERROR
CAIE A,.QFFCR ;CREF?
CAIN A,.QFFRU ;RUNOFF?
MOVEI A,.QFFAS ;TREAT AS ASCII
IFN FTMPB,<
IFMPB
DPB A,[POINTR(Q.OMOD(Q),QF.FFM)]
>
IFN FTGALAXY,<
IFGALX
DPB A,[POINTR(.FPINF(QF),FP.FFF)]
>
SKIPG A,2(V) ;GET /COPIES:N
MOVEI A,1 ;DEFAULT ONE COPY
CAILE A,^D63 ;LEGAL NUMBER?
MOVEI A,^D63 ;NO. MAXIMUM
MOVEM A,COPIES# ;REMEMBER
IFN FTMPB,<
IFMPB
DPB A,[POINTR(Q.OMOD(Q),QF.COP)]
>
IFN FTGALAXY,<
IFGALX
DPB A,[POINTR(.FPINF(QF),FP.FCY)]
>
SKIPG A,3(V) ;GET /DISP:
MOVEI A,.QFDPR ;DEFAULT IS PRESERVE
CAILE A,.QFDDE ;LEGAL DISPOSITION?
JRST ILLARG ;NO. ERROR
IFN FTMPB,<
IFMPB
DPB A,[POINTR(Q.OMOD(Q),QF.DSP)]
>
IFN FTGALAXY,<
IFGALX OUT1
MOVEI B,FP.DEL ;DELETE BIT
CAIE A,.QFDPR ;PRESERVE?
IORM B,.FPINF(QF) ;NO. DELETE
OUT1:>
DMOVE A,4(V) ;GET /AFTER WORDS
PUSHJ P,DDAFT$## ;CONVERT TO PROPER FORMAT
IFN FTMPB,<
IFMPB
MOVEM C,Q.AFTR(Q) ;STORE
>
IFN FTGALAXY,<
IFGALX
MOVEM C,.EQAFT(Q) ;STORE
>
DMOVE A,6(V) ;GET /DEADLINE WORDS
PUSHJ P,DDAFT$## ;CONVERT TO PROPER FORMAT
IFN FTMPB,<
IFMPB
MOVEM C,Q.DEAD(Q) ;STORE
>
IFN FTGALAXY,<
IFGALX
MOVEM C,.EQDED(Q) ;STORE
>
SKIPG A,^D8(V) ;GET /PRIORITY:N
MOVEI A,^D11 ;DEFAULT IS 10
CAILE A,^D63 ;LEGAL?
MOVEI A,^D63 ;MAXIMUM
SUBI A,1 ;REAL RANGE IS 0-62
IFN FTMPB,<
IFMPB
DPB A,[POINTR(Q.PRI(Q),QP.PRI)]
>
IFN FTGALAXY,<
IFGALX
DPB A,[POINTR(.EQSEQ(Q),EQ.PRI)]
>
SKIPG A,^D9(V) ;GET /PAPER:XXX SWITCH (PRINT,PLOT,PUNCH,TAPE)
PUSHJ P,DEFPAP ;GET DEFAULT PAPER MODE
CAMLE A,MAXPAP(QD) ;LEGAL?
JRST ILLARG ;NO. ERROR
IFN FTMPB,<
IFMPB
DPB A,[POINTR(Q.OMOD(Q),QF.PFM)]
>
IFN FTGALAXY,<
IFGALX
DPB A,[POINTR(.FPINF(QF),FP.FPF)]
>
IFN FTMPB,<
IFMPB OUT2
MOVSI A,(QF.NFH) ;GET /HEAD:N
SKIPLE ^D10(V) ;WANT A HEADER?
IORM A,Q.OMOD(Q) ;YES. SET IT
OUT2:>
IFN FTGALAXY,<
IFGALX OUT3
MOVEI A,FP.NFH ;GET /HEAD:N
SKIPG ^D10(V) ;WANT A HEADER?
IORM A,.FPINF(QF) ;NO. DON'T GIVE IT TO HIM
OUT3:>
SKIPG A,^D11(V) ;GET /SPACE:XXX
MOVEI A,1 ;DEFAULT IS SINGLE
CAILE A,3 ;LEGAL?
JRST ILLARG ;NO. ERROR
IFN FTMPB,<
IFMPB
DPB A,[POINTR(Q.OMOD(Q),QF.SPC)]
>
IFN FTGALAXY,<
IFGALX
DPB A,[POINTR(.FPINF(QF),FP.FSP)]
>
IFLE LANGSW,< ;IF FORTRA OR ALGOL
MOVEI BP7,^D12(V) ;GET /FORMS SWITCH
PUSHJ P,ASC6.6## ;WHICH IS IN ASCII
JFCL ;ANY TERMINATOR OK
>
IFG LANGSW,< ;IF COBOL
MOVE WD,^D12(V) ;GET /FORMS SWITCH
>
IFN FTMPB,<
IFMPB
MOVEM WD,Q.OFRM(Q) ;STORE IT
>
IFN FTGALAXY,<
IFGALX
MOVEM WD,.EQLM1(Q) ;STORE IT
>
DMOVE A,FILNAM ;GET FILE NAME
;AND EXTENSION
PUSHJ P,DOFIL$## ;DO NECESSARY THINGS TO FILE
JRST NOFILE ;FILE NOT FOUND
MOVE A,COPIES ;GET COPIES BACK
IMUL A,$RBSIZ## ;COMPUTE BLOCKS*COPIES/8
IFN FTMPB,<
IFMPB OUT4
IDIVI A,^D1024
ADDI A,1
HRRM A,Q.OSIZ(Q) ;QS.BLK
OUT4:>
IFN FTGALAXY,<
IFGALX OUT5
IDIVI A,200 ;TO BLOCKS
SKIPE B
ADDI A,1
IFN FTJSYS,<
ADDI A,3 ;CONVERT TO PAGES
LSH A,-2
>
HRLM A,.EQLM2(Q) ;STORE
OUT5:>
SKIPG A,1(V) ;GET /LIMIT:N
PUSHJ P,DEFLIM ;GET DEFAULT LIMIT BASED ON FILE SIZE
CAILE A,777776 ;LEGAL SIZE?
MOVEI A,777776 ;NO. MAKE MAXIMUM
IFN FTMPB,<
IFMPB
HRLM A,Q.OSIZ(Q) ;QS.LIM
>
IFN FTGALAXY,<
IFGALX
HRRM A,.EQLM2(Q) ;STORE LIMIT
>
PUSHJ P,$DOQUE## ;GO ACTUALLY DO THE QUEING
JRST ERRRET ;ERROR RETURN
SETZ 1, ;NO ERROR
JRST ERRRET ;TO STORE IT
SUBTTL SUBROUTINE TO STORE COMPLEX DEFAULTS
DEFPAP: JUMPE QD,DFPAPL ;LPT.
LDB B,[POINT 4,$RBPRV##,12] ;GET FILE MODE
CAIN QD,3 ;PLOTTER?
JRST DFPAPP ;YES
CAIN QD,1 ;CDP?
JRST DFPAPC ;YES
DFPAPT: HRRZ A,PUNMOD(B) ;PTP. GET /TAPE BASED ON FILE MODE
POPJ P,
DFPAPP: MOVEI A,%QFPAS ;PLOT. ASSUME DEFAULT IS ASCII
CAILE B,1 ;IS IT ASCII FILE?
MOVEI A,%QFPIM ;NO. USE OTHER MODE
POPJ P,
DFPAPC: HLRZ A,PUNMOD(B) ;CDP. GET /PUNCH BASED ON FILE MODE
POPJ P,
DFPAPL: MOVEI A,%QFLAR ;LPT. DEFAULT IS ARROW
POPJ P,
DEFLIM: MOVE A,$RBSIZ## ;GET FILE SIZE IN WORDS
IMUL A,COPIES ;TIMES COPIES
IDIVI A,^D128 ;CONVERT TO BLOCKS
SKIPE B
ADDI A,1 ;AND FRACTION
IDIV A,LIMDIV(QD) ;CALCULATE LIMIT
ADD A,LIMADD(QD) ;BASED ON DEVICE
POPJ P, ;RETURN
SUBTTL SUBROUTINES TO READ ASCII ARGS
GETNAM:
IFE LANGSW,< ;IF FORTRA
MOVEI BP7,@1(16) ;GET ADDRESS OF ARGUMENT
PUSHJ P,ASC6.6## ;READ THE FILE NAME
JRST GETNM1 ;FUNNY TERMINATOR
ILDB CH,BP7 ;GET THE TERMINATOR
GETNM1: JUMPE WD,CPOPJ ;ERROR
MOVEM WD,FILNAM ;STORE FILE NAME
SETZM FILEXT
CAIG CH," " ;NO EXTENSION?
JRST CPOPJ1 ;YES. OK
CAIE CH,"." ;EXTENSION COMING?
POPJ P, ;NO. ERROR
MOVEI N,3 ;NOW GET EXTENSION
PUSHJ P,ASC6.C## ;CONTINUING ON
JRST GETNM3 ;TERMINATOR
GETNM2: HLLZM WD,FILEXT ;STORE EXTENSION
>
IFG LANGSW,< ;IF COBOL
SETZM FILNAM ;CLEAR FILE NAME
SETZM FILEXT ;AND EXTENSION
MOVE BP6,[POINT 6,FILNAM]
MOVE B,1(16) ;PREPOINTER TO ARG
MOVE BP7,(B) ;POINTER
HRRZ N,1(B) ;CHARACTERS
CAILE N,^D9 ;MORE THAN 9?
MOVEI N,^D9 ;YES. JUST TAKE 9
PUSHJ P,ASC6.C## ;DO CONVERSION
JRST GETNM3 ;TERMINATOR
GETNM2:>
IFL LANGSW,< ;IF ALGOL
SETZM FILNAM ;ZERO FILE NAME
SETZM FILEXT ;AND EXTENSION
MOVE BP7,5(DL) ;GET POINTER
IFL <MAJVNO-5>,<
TLO BP7,440700 ;BE SURE
>
HRRZ N,6(DL) ;GET BYTE COUNT
CAILE N,6 ;MAX SIX TO START
MOVEI N,6
PUSHJ P,ASC6.C## ;GET NAME
JRST GETNM0 ;FUNNY TERMINATOR
JUMPE WD,CPOPJ ;ERROR IF NONE
MOVEM WD,FILNAM ;STORE NAME
HRRZ N,6(DL) ;GET TOTAL COUNT AGAIN
SUBI N,6 ;MINUS THE SIX WE PROCESSED
JUMPLE N,CPOPJ1 ;DONE?
ILDB CH,BP7 ;GET NEXT (TERMINATOR)
JRST GETNM1 ;CONTINUE
GETNM0: JUMPE WD,CPOPJ ;ERROR IF NO NAME
MOVEM WD,FILNAM ;STORE THE NAME
HRRZ T1,6(DL) ;GET BYTE COUNT AGAIN
ADD N,T1 ;ADD COUNT TO REMAINDER
CAILE T1,6 ;MIN WITH 6
MOVEI T1,6
SUB N,T1 ;MINUS ORIGINAL
GETNM1: SUBI N,1 ;COUNT TERMINATOR
CAIG CH," " ;VALID END?
JRST CPOPJ1 ;YES. DONE
CAIE CH,"." ;EXTENSION COMING?
POPJ P, ;NO. ERROR
CAILE N,3 ;MAX OF THREE
MOVEI N,3
JUMPLE N,CPOPJ1 ;OK IF STOPPED WITH .
PUSHJ P,ASC6.C## ;GET IT
JRST GETNM3 ;TERMINATOR OK?
GETNM2: HLLZM WD,FILEXT ;STORE EXTENSION
>
CPOPJ1: AOS (P) ;SKIP RETURN. GOOD NAME
CPOPJ: POPJ P,
GETNM3: CAIG CH," " ;VALID TERMINATOR FOR EXT?
JRST GETNM2 ;YES. STORE IT
POPJ P, ;NO. ERROR
GETDEV:
IFE LANGSW,< ;IF FORTRA
MOVEI BP7,@0(16) ;GET ADDRESS OF ARGUMENT
PUSHJ P,ASC6.5## ;FIVE CHARACTERS
JRST GETDV2 ;IGNORE COLON IF PRESENT
>
IFG LANGSW,< ;IF COBOL
MOVE BP7,0(16) ;POINTER TO ARG
PUSHJ P,ASC6.6##
>
IFL LANGSW,< ;IF ALGOL
MOVE BP7,3(DL) ;GET POINTER
HRRZ N,4(DL) ;BYTE COUNT
CAILE N,6
MOVEI N,6 ;MIN WITH 6
PUSHJ P,ASC6.C## ;TRANSLATE
JRST GETDV2 ;TERMINATOR
>
GETDV1: JUMPN WD,.+2 ;GIVE A DEVICE?
MOVSI WD,'DSK' ;NO. ASSUME DISK
MOVEM WD,FILDEV
DEVCHR WD, ;GET CHARACTERISTICS
TLNN WD,(DV.TTY) ;IS IT A REAL DISK?
TLNN WD,(DV.DSK) ;SINCE NUL: HAS DV.DSK SET TOO
POPJ P, ;NO. ERROR
JRST CPOPJ1 ;GOOD DEVICE
GETDV2: CAIE CH," " ;END WITH SPACE
CAIN CH,":" ;OR COLON?
JRST GETDV1 ;YES. OK
POPJ P, ;NO. ERROR
SUBTTL ERROR ROUTINES
NOSUCH: MOVEI 1,1 ;UNDEFINED QUEUE
ERRRET: PUSHJ P,XUUO$## ;MAKE SURE RELEASE PRIMARY CHANNEL
RELEAS 0,
IFGE LANGSW,<
MOVEM 1,@4(16) ;STORE ERROR CODE
>
IFL LANGSW,<
MOVE 0,1 ;MOVE IT
XCT 14(DL) ;RETURN IT
>
GOODBY (5) ;RETURN
ILLDEV: MOVEI 1,2 ;ILLEGAL DEVICE
JRST ERRRET ;RETURN
ILLNAM: MOVEI 1,3 ;ILLEGAL FILE NAME
JRST ERRRET ;RETURN
NOFILE: MOVEI 1,4 ;NO SUCH FILE
JRST ERRRET ;RETURN
ILLARG: MOVEI 1,5 ;ILLEGAL ARGUMENT IN VECTOR
JRST ERRRET ;RETURN
PRGEND
TITLE SUBMIT - ROUTINES TO MAKE INPUT QUEUE ENTRIES
SUBTTL USAGE INSTRUCTIONS
SEARCH MACTEN,UUOSYM,QUEUNV
IFE LANGSW,<SEARCH FORPRM ;IF COMPILING FOR FORTRA>
IFL LANGSW,<SEARCH ALGPRM,ALGSYS ;IF COMPILING FOR ALGOL>
IFN FTGALAXY,<
SEARCH QSRMAC,SBSMAC
IFN FTJSYS,<
SEARCH MONSYS ;TOPS20 DEFINITIONS
>
>
IFN FTMPB,<
SEARCH QPRM
>
; FORPRM IS UNIVERSAL FILE FROM FOROTS
; ALGPRM IS UNIVERSAL FILE FOR ALGOL
; ALGSYS IS UNIVERSAL FILE FOR ALGOL
; QPRM IS UNIVERSAL FILE FOR QUEUE DEFINITIONS. SEE ...
; MACTEN IS UNIVERSAL FILE WITH USEFUL MACRO DEFINITIONS SEE ...
; UUOSYM IS UNIVERSAL FILE WITH UUO SYMBOLS DEFINITIONS SEE ...
; QSRMAC IS UNIVERSAL FILE FOR GALAXY
; SBSMAC IS UNIVERSAL FILE FOR GALAXY
; MONSYS IS UNIVERSAL FILE FOR TOPS20
XLIST
IFE LANGSW,< ;IF FORTRA
LIST
COMMENT %
USAGE CALL SUBMIT(VECTOR)
OR CALL SUBMIT(VECTOR,IERR)
WHERE VECTOR IS AN 19 WORD SINGLE PRECISION ARRAY CONTAINING
VECTOR(1) NAME OF CTL FILE. MAX. OF FIVE CHARACTERS ASCII.
EXT IS ALWAYS .CTL
VECTOR(2) NAME OF LOG FILE. MAX. OF FIVE CHARACTERS ASCII.
EXT IS ALWAYS .LOG. DEFAULT IS SAME AS CTL FILE
VECTOR(3) DISPOSITION FOR CTL FILE.
0=PRESERVE
1=DELETE
VECTOR(4) DISPOSITION FOR LOG FILE.
0=PRESERVE
1=DELETE
VECTOR(5) TIME LIMIT IN SECONDS. DEFAULT IS 60.
VECTOR(6) PAGE LIMIT. DEFAULT IS 200
VECTOR(7) CARD LIMIT. DEFAULT IS 0
VECTOR(8) PAPER TAPE LIMIT. DEFAULT IS 0
VECTOR(9) PLOTER LIMIT. DEFAULT IS 0
VECTOR(10) CORE LIMIT. DEFAULT IS CORMAX
VECTOR(11) RESTARTABLITY.
0=YES
1=NO
VECTOR(12) UNIQUENESS.
0=RUN ANY NUMBER OF JOBS UNDER PPN
OTHER=GUARANTEE UNIQUE UNDER PPN
VECTOR(13) PRIORITY (1-62) STANDARD IS 10
VECTOR(14) OUTPUT SWITCH (0,1,2,3,4)
FOR GALAXY SYSTEM, ZERO IS /OUTPUT:NOLOG
ALL OTHERS ARE /OUTPUT:LOG
VECTOR(15) DEPENDENCY SWITCH (0-177777)
VECTOR(16) AFTER SWITCH PART ONE
TIME OF DAY OR PLUS TIME IN MINUTES
PLUS TIME IS INDICATED BY A NEGATIVE IN VECTOR(17)
VECTOR(17) AFTER SWITCH PART TWO
DATE IN 15 BIT FORMAT OR ZERO FOR TODAY
NEGATIVE INDICATES TIME IS PLUS FORMAT
VECTOR(18) DEADLINE SWITCH PART ONE. SAME AS AFTER
VECTOR(19) DEADLINE SWITCH PART TWO. SAME AS AFTER
IERR - IS AN OPTIONAL ERROR CODE RETURNED
VALUE MEANING
0 NO ERROR - JOB SUBMITTED
2 OPEN FAILED ON DSK
3 ILLEGAL FILE NAME
4 FILE NOT FOUND
6 CANNOT OPEN QUE DEVICE
7 CANNOT ENTER QUEUE COMMAND FILE
%
XLIST
>
IFG LANGSW,< ;IF COBOL
LIST
COMMENT %
USAGE ENTER MACRO SUBMIT USING CTLFIL,LOGFIL,VECTOR.
OR ENTER MACRO SUBMIT USING CTLFIL,LOGFIL,VECTOR,IERR.
WHERE CTLFIL IS FILE NAME OF CTL FILE. EXT IS ALWAYS .CTL
(DISPLAY-6 OR DISPLAY-7)
LOGFIL IS FILE NAME OF LOG FILE. EXT IS ALWAYS LOG.
DEFAULT IS SAME AS CTL FILE.
(DISPLAY-6 OR DISPLAY-7)
VECTOR IS AN 17 WORD COMPUTATIONAL ARRAY CONTAINING
VECTOR(1) DISPOSITION FOR CTL FILE.
0=PRESERVE
1=DELETE
VECTOR(2) DISPOSITION FOR LOG FILE.
0=PRESERVE
1=DELETE
VECTOR(3) TIME LIMIT IN SECONDS. DEFAULT IS 60.
VECTOR(4) PAGE LIMIT. DEFAULT IS 200
VECTOR(5) CARD LIMIT. DEFAULT IS 0
VECTOR(6) PAPER TAPE LIMIT. DEFAULT IS 0
VECTOR(7) PLOTER LIMIT. DEFAULT IS 0
VECTOR(8) CORE LIMIT. DEFAULT IS CORMAX
VECTOR(9) RESTARTABLITY.
0=YES
1=NO
VECTOR(10) UNIQUENESS.
0=RUN ANY NUMBER OF JOBS UNDER PPN
OTHER=GUARANTEE UNIQUE UNDER PPN
VECTOR(11) PRIORITY (1-63) STANDARD IS 10
VECTOR(12) OUTPUT SWITCH (0,1,2,3,4)
VECTOR(13) DEPENDENCY SWITCH (0-777777)
VECTOR(14) AFTER SWITCH PART ONE
TIME OF DAY OR PLUS TIME IN MINUTES
PLUS TIME IS INDICATED BY A NEGATIVE IN VECTOR(15)
VECTOR(15) AFTER SWITCH PART TWO
DATE IN 15 BIT FORMAT OR ZERO FOR TODAY
NEGATIVE INDICATES TIME IS PLUS FORMAT
VECTOR(16) DEADLINE SWITCH PART ONE. SAME AS AFTER
VECTOR(17) DEADLINE SWITCH PART TWO. SAME AS AFTER
IERR - IS AN OPTIONAL ERROR CODE RETURNED (COMPUTATIONAL)
VALUE MEANING
0 NO ERROR - JOB SUBMITTED
2 OPEN FAILED ON DSK
3 ILLEGAL FILE NAME
4 FILE NOT FOUND
6 CANNOT OPEN QUE DEVICE
7 CANNOT ENTER QUEUE COMMAND FILE
%
XLIST
>
IFL LANGSW,< ;IF ALGOL
LIST
COMMENT %
USAGE SUBMIT(CTLFIL,LOGFIL,VECTOR);
OR SUBMIT(CTLFIL,LOGFIL,VECTOR,IERR);
WHERE CTLFIL IS FILE NAME OF CTL FILE. EXT IS ALWAYS .CTL
STRING VARIABLE (ASCII).
LOGFIL IS FILE NAME OF LOG FILE. EXT IS ALWAYS LOG.
DEFAULT IS SAME AS CTL FILE.
STRING VARIABLE (ASCII).
VECTOR IS AN 17 WORD INTEGER ARRAY CONTAINING
VECTOR(1) DISPOSITION FOR CTL FILE.
0=PRESERVE
1=DELETE
VECTOR(2) DISPOSITION FOR LOG FILE.
0=PRESERVE
1=DELETE
VECTOR(3) TIME LIMIT IN SECONDS. DEFAULT IS 60.
VECTOR(4) PAGE LIMIT. DEFAULT IS 200
VECTOR(5) CARD LIMIT. DEFAULT IS 0
VECTOR(6) PAPER TAPE LIMIT. DEFAULT IS 0
VECTOR(7) PLOTER LIMIT. DEFAULT IS 0
VECTOR(8) CORE LIMIT. DEFAULT IS CORMAX
VECTOR(9) RESTARTABLITY.
0=YES
1=NO
VECTOR(10) UNIQUENESS.
0=RUN ANY NUMBER OF JOBS UNDER PPN
OTHER=GUARANTEE UNIQUE UNDER PPN
VECTOR(11) PRIORITY (1-63) STANDARD IS 10
VECTOR(12) OUTPUT SWITCH (0,1,2,3,4)
VECTOR(13) DEPENDENCY SWITCH (0-777777)
VECTOR(14) AFTER SWITCH PART ONE
TIME OF DAY OR PLUS TIME IN MINUTES
PLUS TIME IS INDICATED BY A NEGATIVE IN VECTOR(15)
VECTOR(15) AFTER SWITCH PART TWO
DATE IN 15 BIT FORMAT OR ZERO FOR TODAY
NEGATIVE INDICATES TIME IS PLUS FORMAT
VECTOR(16) DEADLINE SWITCH PART ONE. SAME AS AFTER
VECTOR(17) DEADLINE SWITCH PART TWO. SAME AS AFTER
IERR - IS AN OPTIONAL ERROR CODE RETURNED (INTEGER)
VALUE MEANING
0 NO ERROR - JOB SUBMITTED
2 OPEN FAILED ON DSK
3 ILLEGAL FILE NAME
4 FILE NOT FOUND
6 CANNOT OPEN QUE DEVICE
7 CANNOT ENTER QUEUE COMMAND FILE
%
XLIST
>
LIST
SUBTTL DEFINITIONS AND DATA
; BITS THAT WE MUST DEFINE BECAUSE FORPRM AND UUOSYM DISAGREE
DV.DSK==1B1 ;DEVICE IS A DSK
DV.TTY==1B14 ;DEVICE IS A TTY
; AC DEFINITIONS
F=0
A=1
S1=A
B=2
S2=B
C=3
WD=4 ;SIXBIT ANSWER FROM ASCSIX
T1=WD
BP6=5 ;SIXBIT POINTER
T2=BP6
BP7=6 ;ASCII POINTER
T3=BP7
N=7 ;NUMBER
T4=N
CH=10 ;CHARACTER
T5=CH
M=T5
V=11 ;POINTER TO ARG VECTOR
QD=12 ;QUE TYPE
QF=13 ;POINTER TO CURRENT FILE BLOCK IN QUE BLOCK
Q=14 ;POINTER TO QUE AREA
SUBTTL SUBMIT - INITIALIZATION CODE
HELLO (SUBMIT)
IFL LANGSW,< ;IF ALGOL
IFGE <MAJVNO-5>,<
SUBMPM: Z ;POST-MORTEM BLOCK
XWD 2,7 ;WORDS, CHARACTER+ "*"
SIXBIT/SUBMIT*/ ;SIXBIT NAME PLUS "*"
>
XWD DL,13 ;WORD FOR VARIABLE LENGTH
SUBMIT: JSP AX,PAR0 ;VARIABLE LENGTH CALL
IFGE <MAJVNO-5>,<
SUBMPM ;POINTER TO POST MORTEM BLOCK
>
XWD 0,14
XWD $PRO!$N!$SIM,5
XWD $VAR!$S!$FOV,3
XWD $VAR!$S!$FOV,5
XWD $ARR!$I!$FON,7
XWD $VAR!$I!$FON,11
MOVEM 14,SAVE14# ;SAVE AN AC
>
PUSHJ P,FIRCH$## ;GET PRIMARY CHANNEL
JRST NODSK ;GIVE SECOND ERROR MESSAGE
MOVEI QD,4 ;INP QUEUE
PUSHJ P,GTINF$## ;GET QUE DEVICE, OTHER INFO
IFE LANGSW,< ;IF FORTRA
MOVEI V,@0(16) ;GET ADDRESS OF ARGUMENT VECTOR
>
IFG LANGSW,< ;IF COBOL
MOVEI V,@2(16) ;GET POSSIBLE VECTOR ADDRESS
LDB A,[POINT 4,2(16),12];GET ARG TYPE
CAIN A,15 ;IS IT SIXBIT/ASCII (IE LEVEL 01)?
HRRZ V,(V) ;YES. GET REAL ADDRESS
SUBI V,2 ;NOW MAKE IT LOOK LIKE THE FORTRAN CALL
>
IFL LANGSW,< ;IF ALGOL
MOVE V,7(DL) ;GET VECTOR ADDRESS
SUBI V,1 ;MINUS TWO PLUS ONE FOR OFFSET
>
IFN FTMPB,<
IFMPB SUB1
MOVEI A,111301 ;SET DEFAULT BITS ON CTL,LOG FILE MODES
MOVEM A,Q.CMOD(Q)
TLO A,(QF.LOG) ;SET LOG BIT TOO
MOVEM A,Q.LMOD(Q)
SUB1:>
IFN FTGALAXY,<
IFGALX SUB2
MOVE A,[XWD 010101,FP.NFH+1] ;SET DEFAULT BITS ON CTL, LOG FILE MODES
MOVEM A,.FPINF(QF) ;CTL FILE
TRO A,FP.FLG ;LOG BT
MOVEM A,LOGFB$##+.FPINF ;LOG FILE
SUB2:>
IFE LANGSW,< ;IF FORTRA
MOVEI BP7,(V) ;GET ADDRESS OF CTL NAME
>
IFG LANGSW,< ;IF COBOL
MOVE BP7,0(16) ;GET FIRST ARGUMENT
>
IFL LANGSW,< ;IF ALGOL
MOVE BP7,3(DL) ;GET STRING POINTER
>
PUSHJ P,ASC6.5## ;FIVE CHARACTERS
JFCL ;IGNORE TERMINATOR
JUMPE WD,ERRNAM ;ZERO NAME ILLEGAL
MOVE A,WD
MOVSI B,'CTL'
IFN FTMPB,<
IFMPB
MOVEI QF,Q.CSTR(Q) ;ADDRESS OF CTL FILE BLOCK
>
IFN FTGALAXY,<
IFGALX
MOVEI QF,CTLFB$## ;ADDRESS OF CTL FILE BLOCK
>
PUSHJ P,OPDSK$## ;OPEN UP THE DISK
JRST NODSK ;OOPS
TLO F,CTLFIL ;CTL FILE
PUSHJ P,DOFIL$## ;DO THE FILE THINGS
JRST NTFND ;OOPS
TLZ F,CTLFIL ;NOT CTL FILE NOW
IFE LANGSW,< ;IF FORTRA
MOVEI BP7,1(V) ;GET ADDRESS OF LOG FILE NAME
>
IFG LANGSW,< ;IF COBOL
MOVE BP7,1(16) ;GET SECOND ARGUMENT
>
IFL LANGSW,<
MOVE BP7,5(DL) ;GET STRING POINTER
>
PUSHJ P,ASC6.5## ;FIVE CHARACTERS
JFCL
IFN FTMPB,<
IFMPB SUB18
SKIPN A,WD ;NOW DO THIS FILE
MOVE A,Q.LNAM(Q) ;DEFAULT IS CTL NAME
SUB18:>
IFN FTGALAXY,<
IFGALX SUB19
SKIPN A,WD ;NOW DO THIS FILE
MOVE A,.EQJOB(Q) ;DEFAULT IS CTL NAME
SUB19:>
MOVSI B,'LOG' ;SET EXTENSION
PUSHJ P,OPDSK$## ;OPEN UP THE DISK
JRST NODSK ;OOPS
TLO F,LOGFIL ;LOG NOW
IFN FTMPB,<
IFMPB
MOVEI QF,Q.LSTR(Q) ;ADDRESS OF LOG FILE BLOCK
>
IFN FTGALAXY,<
IFGALX
MOVEI QF,LOGFB$## ;ADDRESS OF CTL FILE BLOCK
>
PUSHJ P,DOFIL$## ;DO THE FILE THINGS
JRST NTFND ;ERROR IF LOG DOESN'T EXIST AND CAN'T MAKE ONE
TLZ F,LOGFIL ;NOT LOG FILE NOW
IFN FTMPB,<
IFMPB SUB3
MOVE A,Q.PPN(Q) ;ASSUME NO SFDS
MOVEM Q.IDDI(Q) ;IN DEFAULT PATH
SUB3:>
IFN FTGALAXY,<
IFGALX SUB4
IFN FTUUOS,<
MOVE A,.EQOWN(Q) ;ASSUME NO SFDS
MOVEM A,.EQPAT(Q) ;IN DEFAULT PATH
>
SUB4:>
HRLO A,THSJB$## ;GET OUR DEFAULT PATH
MOVEM A,PTHBL$##
MOVE A,[XWD ^D8,PTHBL$##]
PATH. A,
JRST SUBARG ;JUST PPN
MOVSI A,PTHBL$##+2 ;MOVE IT
IFN FTMPB,<
IFMPB SUB5
HRRI A,Q.IDDI(Q)
BLT A,Q.IDDI+5(Q)
SUB5:>
IFN FTGALAXY,<
IFGALX SUB6
IFN FTUUOS,<
HRRI A,.EQPAT(Q)
BLT A,.EQPAT+5(Q)
>
SUB6:>
SUBTTL SUBMIT - PICK UP VECTOR ARGUMENTS
SUBARG: SKIPL A,2(V) ;/DISPOSE .CTL
CAILE A,1 ;LEGAL?
MOVEI A,1 ;DEFAULT IS DELETE
IFN FTMPB,<
IFMPB SUB7
MOVEI B,.QFDDE
SKIPN A ;DELETE?
MOVEI B,.QFDPR ;PRESERVE
DPB B,[POINTR(Q.CMOD(Q),QF.DSP)]
SUB7:>
IFN FTGALAXY,<
IFGALX SUB8
MOVEI B,FP.DEL ;DELETE BIT
SKIPE A ;PRESERVE?
IORM B,.FPINF(QF) ;NO. SET DELETE
SUB8:>
SKIPL A,3(V) ;/DISPOSE .LOG
CAILE A,1 ;LEGAL?
MOVEI A,1 ;NO
IFN FTMPB,<
IFMPB SUB9
MOVEI B,.QFDDE
SKIPN A ;DELETE?
MOVEI B,.QFDPR ;PRESERVE
DPB B,[POINTR(Q.LMOD(Q),QF.DSP)]
SUB9:>
IFN FTGALAXY,<
IFGALX SUB10
MOVEI B,FP.DEL ;DELETE BIT
SKIPE A ;PRESERVE
IORM B,LOGFB$##+.FPINF ;NO. SET DELETE
SUB10:>
SKIPG A,4(V) ;GET /TIME
MOVEI A,^D60 ;DEFAULT IS 60 SECONDS
TLNE A,-1 ;TOO LONG?
MOVEI A,777777 ;YES
IFN FTMPB,<
IFMPB
HRRM A,Q.ILIM(Q)
>
IFN FTGALAXY,<
IFGALX
HRRM A,.EQLM2(Q)
>
SKIPG A,5(V) ;GET /PAGES
MOVEI A,^D200 ;DEFAULT IS 200 PAGES
TLNE A,-1 ;TOO LARGE
MOVEI A,777777 ;YES
IFN FTMPB,<
IFMPB
HRLM A,Q.ILM2(Q)
>
IFN FTGALAXY,<
IFGALX
HRLM A,.EQLM3(Q)
>
SKIPG A,6(V) ;GET /CARDS
MOVEI A,0 ;USE DEFAULT LIMITS
TLNE A,-1 ;TOO LARGE?
MOVEI A,777777 ;YES
IFN FTMPB,<
IFMPB
HRRM A,Q.ILM2(Q)
>
IFN FTGALAXY,<
IFGALX
HRRM A,.EQLM3(Q)
>
SKIPG A,7(V) ;GET /FEET (PAPER TAPE)
MOVEI A,0 ;USE DEFAULT LIMITS
TLNE A,-1 ;TOO LARGE?
MOVEI A,777777 ;YES
IFN FTMPB,<
IFMPB
HRLM A,Q.ILM3(Q)
>
IFN FTGALAXY,<
IFGALX
HRLM A,.EQLM4(Q)
>
SKIPG A,^D8(V) ;GET /TPLOT (PLOT TIME)
MOVEI A,0 ;USE DEFAULT LIMITS
TLNE A,-1 ;TOO LARGE?
MOVEI A,777777 ;YES
IFN FTMPB,<
IFMPB
HRRM A,Q.ILM3(Q)
>
IFN FTGALAXY,<
IFGALX
HRRM A,.EQLM4(Q)
>
SKIPG A,^D9(V) ;GET /CORE
PUSHJ P,DEFCOR ;GET DEFAULT LIMIT
CAIGE A,^D512 ;AT LEAST ONE PAGE?
LSH A,^D10 ;NO. MUST MEAN K
TLNE A,-1 ;TOO BIG?
MOVEI A,777777 ;YES
IFN FTMPB,<
IFMPB
HRLM A,Q.ILIM(Q)
>
IFN FTGALAXY,<
IFGALX SUB11
ADDI A,1 ;CONVERT WORDS TO PAGES
LSH A,-^D9 ;ROUNDING
HRLM A,.EQLM2(Q) ;STORE
SUB11:>
IFN FTMPB,<
IFMPB SUB12
SKIPE A,^D10(V) ;RESTARTABLE?
MOVSI A,(QI.NRS) ;NO. SAY SO
IORM A,Q.IDEP(Q)
SUB12:>
IFN FTGALAXY,<
IFGALX SUB13
SKIPE A,^D10(V) ;RESTARTABLE?
MOVSI A,(EQ.NRS) ;NO. SAY SO
IORM A,.EQLM1(Q)
SUB13:>
IFN FTMPB,<
IFMPB SUB14
SKIPE A,^D11(V) ;UNIQUENESS
MOVEI A,.QIUSD ;NO. USE DEFAULT
DPB A,[POINTR(Q.IDEP(Q),QI.UNI)]
SUB14:>
IFN FTGALAXY,<
IFGALX SUB15
SKIPE A,^D11(V) ;UNIQUENESS
MOVEI A,1 ;NO. USE DEFAULT
DPB A,[POINTR(.EQLM1(Q),EQ.UNI)]
SUB15:>
SKIPLE A,^D12(V) ;/PRIORITY
CAILE A,^D62 ;LEGAL?
MOVEI A,^D10 ;NO. USE DEFAULT
IFN FTMPB,<
IFMPB
DPB A,[POINTR(Q.PRI(Q),QP.PRI)]
>
IFN FTGALAXY,<
IFGALX
DPB A,[POINTR(.EQSEQ(Q),EQ.PRI)]
>
IFN FTMPB,<
IFMPB SUB16
SKIPL A,^D13(V) ;/OUTPUT
CAILE A,.QIOAL
MOVEI A,.QIOAL ;INVALID. USE DEFAULT
DPB A,[POINTR(Q.IDEP(Q),QI.OUT)]
SUB16:>
IFN FTGALAXY,<
IFGALX SUB17
SKIPL A,^D13(V) ;/OUTPUT
CAILE A,4 ;LEGAL?
MOVEI A,4 ;NO. DEFAULT
MOVEI B,%EQOLG ;CONVERT TO QUASAR
SKIPN A
MOVEI B,%EQONL ;NO LOG ONLY IF /OUTPUT:0
DPB B,[POINTR(.EQLM1(Q),EQ.OUT)]
SUB17:>
SKIPG A,^D14(V) ;DEPENDENCY
MOVEI A,0 ;DEFAULT IS ZERO
CAILE A,177777 ;LEGAL?
MOVEI A,177777 ;USE MAX IF ILLEGAL
IFN FTMPB,<
IFMPB
DPB A,[POINTR(Q.IDEP(Q),QI.DEP)]
>
IFN FTGALAXY,<
IFGALX
HRRM A,.EQLM1(Q) ;DEPENDENCY
>
DMOVE A,^D15(V) ;GET TWO WORDS OF /AFTER
PUSHJ P,DDAFT$## ;CONVERT TO INTERNAL FORMAT
IFN FTMPB,<
IFMPB
MOVEM C,Q.AFTR(Q) ;STORE AFTER TIME
>
IFN FTGALAXY,<
IFGALX
MOVEM C,.EQAFT(Q) ;STORE AFTER TIME
>
DMOVE A,^D17(V) ;GET TWO WORDS OF /DEAD
PUSHJ P,DDAFT$## ;CONVERT TO INTERNAL FORMAT
IFN FTMPB,<
IFMPB
MOVEM C,Q.DEAD(Q) ;STORE DEADLINE TIME
>
IFN FTGALAXY,<
IFGALX
MOVEM C,.EQDED(Q) ;STORE DEADLINE TIME
>
PUSHJ P,$DOQUE## ;GO ACTUALLY DO THE QUEING
JRST ERRXIT ;ERROR RETURN
SETZ 1, ;NO ERROR
JRST RETCOD
SUBTTL SUBROUTINE TO STORE COMPLEX DEFAULTS
DEFCOR: MOVE A,[%NSCMX] ;GET CORMAX
GETTAB A,
MOVEI A,^D26*^D1024 ;DEFAULT IS 26 K
SETO B, ;LESS ONE PAGE IF KI OR KL
AOBJN B,.+1
SKIPN B ;KA?
SUBI A,^D512 ;KI OR KL
POPJ P,
SUBTTL ERROR ROUTINES
NTFND: OUTSTR [ASCIZ/
% FILE NOT FOUND IN SUBMIT!
/]
MOVEI 1,4 ;FILE NOT FOUND ERROR CODE
RETCOD:
ERRXIT: PUSHJ P,XUUO$## ;EXECUTE RELEASE WITH CHANNEL
RELEAS 0,
IFGE LANGSW,< ;IF FORTRA OR COBOL
IFN F40LIB,<
TLNN 16,-1 ;F40 CALL?
JRST CHKF10 ;NO. F10
HLRZ 0,1(16) ;GET NEXT INSTRUCTION
TRZ 0,740 ;CLEAR AC FIELD
CAIE 0,(JUMP 0) ;ARG?
GOODBY 1 ;NO. DONE
JRST STOCOD
>
CHKF10: HLRE 0,-1(16) ;GET ARG COUNT
MOVM 0,0 ;PLUS
IFE LANGSW,< ;IF FORTRA
CAIGE 0,2 ;TWO ARGS?
>
IFG LANGSW,< ;IF COBOL
CAIGE 0,4 ;FOUR ARGS?
>
GOODBY 1 ;NO
>
STOCOD:
IFE LANGSW,< ;IF FORTRA
MOVEM 1,@1(16) ;STORE ERROR CODE
>
IFG LANGSW,< ;IF COBOL
MOVEM 1,@3(16) ;STORE ERROR CODE
>
IFL LANGSW,< ;IF ALGOL
MOVE 0,1 ;COPY ERROR CODE
MOVE 1,13(DL) ;GET ARG COUNT
CAILE 1,4 ;ERROR ARG GIVEN?
XCT 12(DL) ;YES. RETURN ERROR CODE
>
GOODBY 400001
NODSK: OUTSTR [ASCIZ/
% CANNOT OPEN DISK!
/]
MOVEI 1,2 ;BAD DEVICE ERROR
JRST ERRXIT
ERRNAM: OUTSTR [ASCIZ/% FILE NAME ILLEGAL. JOB NOT SUBMITTED.
/]
MOVEI 1,3 ;ILLEGAL FILE NAME
JRST RETCOD ;RETURN CODE
PRGEND
TITLE MISC. - DO /DEADLINE , /AFTER , CONVERT ASCII TO SIXBIT
SUBTTL DEFINITIONS AND DATA
SEARCH QUEUNV
IFE LANGSW,<SEARCH FORPRM ;IF COMPILING FOR FORTRA>
IFL LANGSW,<SEARCH ALGPRM,ALGSYS ;IF COMPILING FOR ALGOL>
IFN FTGALAXY,< SEARCH QSRMAC,SBSMAC
IFN FTJSYS,< SEARCH MONSYS>
>
ENTRY DDAFT$
; FORPRM IS UNIVERSAL FILE FROM FOROTS
; ALGPRM IS UNIVERSAL FILE FOR ALGOL
; ALGSYS IS UNIVERSAL FILE FOR ALGOL
; AC DEFINITIONS
F=0
A=1
S1=A
B=2
S2=B
C=3
WD=4 ;SIXBIT ANSWER FROM ASCSIX
T1=WD
BP6=5 ;SIXBIT POINTER
T2=BP6
BP7=6 ;ASCII POINTER
T3=BP7
N=7 ;NUMBER
T4=N
CH=10 ;CHARACTER
T5=CH
M=T5
V=11 ;POINTER TO ARG VECTOR
QD=12 ;QUE TYPE
QF=13 ;POINTER TO CURRENT FILE BLOCK IN QUE BLOCK
Q=14 ;POINTER TO QUE AREA
SUBTTL SUBROUTINES TO DO /DEADLINE AND /AFTER
DDAFT$::SETZ C, ;ASSUME NO TIME
JUMPL A,CPOPJ ;NEGATIVE TIME IS ILLEGAL
DATE T1, ;GET DATE
MSTIME T2, ;AND TIME
IDIVI T2,^D1000*^D60 ;IN MINUTES
JUMPL B,PLSTIM ;NEGATIVE DATE IS FLAG FOR PLUS TIME
JUMPN B,DEDAF1 ;ANY DATE GIVEN?
JUMPE A,CPOPJ ;NO. ANY ARG AT ALL?
MOVE B,T1 ;NO DATE. USE TODAY
DEDAF1: PUSHJ P,CNVDAT ;CONVERT DATE TO INTERNAL FORMAT
HRLZ C,T3 ;AND STORE IN C
MOVE T3,A ;GET TIME
MUL T3,[1000000] ;* 2^18
DIVI T3,^D24*^D60 ;/MINUTES PER DAY
ADD C,T3 ;ALLOW TO OVERFLOW INTO DAYS
IFN FTGALAXY,<
IFN FTJSYS,<
MOVE S2,C ;DO TOPS20 CONVERSIONS
MOVX T2,IC%DSA+IC%UTZ ;LOAD FORMAT FLAGS
ODCNV ;BREAK UP THE DATE
TLZ T2,-1 ;CLEAR THE FLAGS
IDCNV ;RE-COMBINE
JFCL ;IGNORE HTE ERROR
MOVE C,S2 ;PUT ANSWER IN PLACE
>>
CPOPJ: POPJ P,
PLSTIM: MOVE B,T1 ;TODAYS DATE
ADD A,T2 ;TIME PLUS CURRENT TIME
JRST DEDAF1 ;AND PROCESS THAT
RADIX 10
DATOFS==38395
CNVDAT: PUSH P,T1
PUSH P,T2
MOVE T2,B ;GET DATE
IDIVI T2,12*31 ;T2=YEARS-1964
IDIVI T3,31 ;T3=MONTHS-JAN, T4=DAYS-1
ADD T4,DAYTAB(T3) ;T4=DAYS-JAN 1
MOVEI T5,0 ;LEAP YEAR ADDITIVE IF JAN,FEB
CAIL T3,2 ;CHECK MONTH
MOVEI T5,1 ;ADDITIVE IF MAR-DEC
MOVE T1,T2 ;SAVE YEARS FOR REUSE
ADDI T2,3 ;MAKE LEAP YEARS COME OUT RIGHT
IDIVI T2,4 ;HANDLE REGULAR LEAP YEARS
CAIE T3,3 ;SEE IF THIS IS LEAP YEAR
MOVEI T5,0 ;NO--WIPE OUT ADDITIVE
ADDI T4,DATOFS(T2)
MOVE T2,T1 ;RESTORE YEARS SINCE 1964
IMULI T2,365 ;DAYS SINCE 1964
ADD T4,T2 ;T4 = DAYS EXCEPT FOR 100 YR. FUDGE
HRREI T2,64-99(T1) ;T2=YEARS SINCE 2000
JUMPLE T2,CNVDT1 ;ALL DONE IF NOT YET 2000
IDIVI T2,100 ;GET CENTURIES SINCE 2000
SUB T4,T2 ;ALLOW FOR LOST LEAP YEARS
CAIE T3,99 ;SEE IF THIS IS A LOST L.Y.
CNVDT1: ADD T4,T5 ;ALLOW FOR LEAP YEAR THIS YEAR
MOVE T3,T4 ;RETURN IN T3
POP P,T2 ;RESTORE T2
POP P,T1 ;T1
POPJ P,
DAYTAB: EXP 0,31,59,90,120,151,181,212,243,273,304,334
RADIX 8
SUBTTL SUBROUTINES TO READ ASCII ARGS
IFLE LANGSW,< ;IF FORTRA OR ALGOL
ENTRY ASC6.5,ASC6.6,ASC6.C
ASC6.5::SKIPA N,[5] ;GET FIVE CHARACTERS
ASC6.6::MOVEI N,6 ;GET SIX CHARACTERS
HRLI BP7,440700 ;SET UP ASCII BYTE POINTER
ASC6.C::SETZ WD, ;START WITH A BLANK
MOVE BP6,[POINT 6,WD]
ASCSIX: ILDB CH,BP7 ;GET A CHARACTER
CAIG CH," " ;BREAK?
MOVEI CH," " ;MAKE IT A SPACE
CAIL CH,140 ;LOWER CASE?
CAILE CH,172 ;...
CAIA ;NO
SUBI CH,40 ;YES. MAKE UPPER
CAIL CH,"0" ;ALPHANUMERIC?
CAILE CH,"Z" ;...
POPJ P, ;NO.
CAILE CH,"9" ;...
CAIL CH,"A" ;...
TRCA CH,40 ;YES. CONVERT TO SIXBIT
POPJ P, ;NO. ERROR
TLNE BP6,770000 ;IF THERE IS ROOM,
IDPB CH,BP6 ;STORE IT
SOJG N,ASCSIX ;LOOP FOR N CHARACTERS
AOS (P) ;GIVE GOOD RETURN
POPJ P,
>
IFG LANGSW,< ;IF COBOL
ENTRY ASC6.5,ASC6.6,ASC6.C
ASC6.C::PUSH P,B
PUSH P,C
LDB C,[POINT 6,BP7,11] ;DISPLAY TYPE
JRST ASCSIX
ASC6.5::
ASC6.6::PUSH P,B ;SAVE SOME SPACE
PUSH P,C
MOVE B,BP7 ;COPY ARG POINTER
MOVE BP7,0(B) ;GET POINTER
HRRZ N,1(B) ;GET CHAR COUNT
CAILE N,^D6 ;SIX MAXIMUM
MOVEI N,^D6
LDB C,[POINT 6,BP7,11] ;DISPLAY TYPE
SETZ WD, ;START CLEAR
MOVE BP6,[POINT 6,WD]
ASCSIX: ILDB CH,BP7 ;GET A CHARACTER
CAIN C,6 ;SIXBIT?
ADDI CH,40 ;YES. MAKE ASCII
CAIN CH," " ;IMBEDDED SPACE?
JRST ASCSX1 ;YES. OK
CAIG CH," " ;BREAK?
MOVEI CH," " ;MAKE IT A SPACE
CAIL CH,140 ;LOWER CASE?
CAILE CH,172 ;...
CAIA ;NO
SUBI CH,40 ;YES. MAKE UPPER
CAIL CH,"0" ;ALPHANUMERIC?
CAILE CH,"Z" ;...
JRST ACPOPJ ;NO.
CAILE CH,"9" ;...
CAIL CH,"A" ;...
ASCSX1: TRCA CH,40 ;YES. CONVERT TO SIXBIT
JRST ACPOPJ ;NO. ERROR
IDPB CH,BP6 ;STORE IT
SOJG N,ASCSIX ;LOOP FOR N CHARACTERS
AOS -2(P) ;GIVE GOOD RETURN
ACPOPJ: POP P,C ;RESTORE ACS
POP P,B
POPJ P,
>
PRGEND
TITLE QUEUES - ROUTINES TO MAKE INPUT/OUTPUT QUEUE ENTRIES
SUBTTL DEFINITIONS AND DATA
SEARCH MACTEN,UUOSYM,QUEUNV
IFE LANGSW,<SEARCH FORPRM ;IF COMPILING FOR FORTRA>
IFL LANGSW,<SEARCH ALGPRM,ALGSYS ;IF COMPILING FOR ALGOL>
IFN FTGALAXY,<
SEARCH QSRMAC,SBSMAC
IFN FTJSYS,<
SEARCH MONSYS ;TOPS20 DEFINITIONS
>
>
IFN FTMPB,<
SEARCH QPRM
>
; FORPRM IS UNIVERSAL FILE FROM FOROTS
; ALGPRM IS UNIVERSAL FILE FOR ALGOL
; ALGSYS IS UNIVERSAL FILE FOR ALGOL
; QPRM IS UNIVERSAL FILE FOR QUEUE DEFINITIONS. SEE ...
; MACTEN IS UNIVERSAL FILE WITH USEFUL MACRO DEFINITIONS SEE ...
; UUOSYM IS UNIVERSAL FILE WITH UUO SYMBOLS DEFINITIONS SEE ...
; QSRMAC IS UNIVERSAL FILE FOR GALAXY
; SBSMAC IS UNIVERSAL FILE FOR GALAXY
; MONSYS IS UNIVERSAL FILE FOR TOPS20
ENTRY DOFIL$,GTINF$,OPDSK$,$DOQUE
; BITS THAT WE MUST DEFINE BECAUSE FORPRM AND UUOSYM DISAGREE
DV.DSK==1B1 ;DEVICE IS A DSK
DV.TTY==1B14 ;DEVICE IS A TTY
; AC DEFINITIONS
F=0
A=1
S1=A
B=2
S2=B
C=3
WD=4 ;SIXBIT ANSWER FROM ASCSIX
T1=WD
BP6=5 ;SIXBIT POINTER
T2=BP6
BP7=6 ;ASCII POINTER
T3=BP7
N=7 ;NUMBER
T4=N
CH=10 ;CHARACTER
T5=CH
M=T5
V=11 ;POINTER TO ARG VECTOR
QD=12 ;QUE TYPE
QF=13 ;POINTER TO CURRENT FILE BLOCK IN QUE BLOCK
Q=14 ;POINTER TO QUE AREA
DEFINE FAIL(MSG)<
JRST [MOVEI T1,[ASCIZ\MSG\]
JRST FAIL.]
> ;END OF DEFINE FAIL
; MACRO SAME AS FAIL BUT NOT SKIPABLE
DEFINE FAIL1(MSG)<
MOVEI T1,[ASCIZ\MSG\]
XLIST
JRST FAIL.
LIST
SALL
> ;END OF DEFINE FAIL1
QUESIX: SIXBIT/LPT/
SIXBIT/CDP/
SIXBIT/PTP/
SIXBIT/PLT/
SIXBIT/INP/
IFN FTGALAXY,<
FBSIZE==FPXSIZ+FDXSIZ ;THE LARGEST FD/FP WE CAN BUILD
FBAREA==FBSIZE ;THE LARGEST FILE BLOCK/MESSAGE NEEDED
>
IFN FTMPB,<
SPLNAM: SIXBIT/LPTSPL/
SIXBIT/CDPSPL/
SIXBIT/PTPSPL/
SIXBIT/PLTSPL/
SIXBIT/BATCON/
Q.LGTO==Q.OMOD ;LENGTH OF OUTPUT QUE
Q.LGTI==Q.LMOD ;LENGTH OF INPUT QUE
Q.LGTH==Q.LMOD ;LENGTH OF MAXIMUM QUE RECORD
>
IFN FTBOTH,<
QLEN==Q.LGTH+1 ;ASSUME GMANGR BIGGER
IFL <QLEN-<.EQPSZ+2*FBAREA>>,<QLEN==.EQPSZ+2*FBAREA> ;GALAXY BIGGER?
>
IFE FTBOTH,<
IFN FTMPB,<QLEN==Q.LGTH+1>
IFN FTGALAXY,<QLEN==.EQPSZ+2*FBAREA>
>
QHEAD: BLOCK QLEN ;ROOM FOR QUEUE ENTRY
QEND==.-1 ;LAST WORD TO ZERO
IFN FTMPB,<
QUEBLK=QHEAD+1 ;ACTUAL RECORD FOR QMANGR
OLIST: IOWD Q.LGTH,QUEBLK
0
QUEDIR: BLOCK 1 ;PPN FOR QUE
QUESTR: BLOCK 1 ;STR FOR QUE
>
IFN FTGALAXY,<
IFN FTUUOS,<
CTLFB$=:QHEAD+.EQPSZ ;WHERE CONTROL FILE (FIRST FILE) IS
>
IFN FTJSYS,<
CTLFB$=:QHEAD+EQHSIZ ;WHERE CONTROL FILE (FIRST FILE) IS
>
LOGFB$=:CTLFB$+FBAREA
SAVEP: BLOCK 1
SAVREL: BLOCK 1
PAGTAB: BLOCK 3
IFN FTJSYS,<
MYPID: BLOCK 1 ;MY PID (NECESSARY FOR SEND/RECEIVE)
>
QSRPID: BLOCK 1 ;PID OF SYSTEM QUASAR
FBTEMP: BLOCK FBAREA ;LARGEST FILE BLOCK THAT CAN BE BUILT FROM MPB DATA
;ALSO USED TO SEND/RECEIVE "SHORT" MESSAGES
STRBLK: BLOCK 5 ;AREA FOR DETERMINING STR FROM UNIT
;ALSO USED FOR SOME SCRATCH STORAGE
>
RTYCNT: BLOCK 1 ;RETRY COUNTER WHEN SEND TO QUASAR FAILS
;OR ENTER TO QUE AREA FAILS
THSJB$::BLOCK 1
CHAN: BLOCK 2
$RBBLK::.RBDEV ;INCLUDE FILE STR/UNIT ARG
BLOCK .RBDEV ;ROOM FOR ARGUMENTS
$RBPPN=:$RBBLK+.RBPPN
$RBNAM=:$RBBLK+.RBNAM
$RBEXT=:$RBBLK+.RBEXT
$RBPRV=:$RBBLK+.RBPRV
$RBSIZ=:$RBBLK+.RBSIZ
$RBVER=:$RBBLK+.RBVER
$RBSPL=:$RBBLK+.RBSPL
$RBEST=:$RBBLK+.RBEST
$RBALC=:$RBBLK+.RBALC
$RBPOS=:$RBBLK+.RBPOS
$RBFT1=:$RBBLK+.RBFT1
$RBNCA=:$RBBLK+.RBNCA
$RBMTA=:$RBBLK+.RBMTA
$RBDEV=:$RBBLK+.RBDEV
PTHBL$::BLOCK 10
IFN FTMPB,<
SUBTTL COMMON CODE FOR OUTPUT, SUBMIT
$DOQUE::IFMPB DOQUEG ;DO GALAXY QUEUE IF NOT MPB
MOVE A,QUESIX(QD) ;GET GENERIC OUTPUT DEVICE
MOVEM A,Q.DEV(Q) ;AND STORE THAT
CAIN QD,4 ;INP: ?
MOVSI A,'LPT' ;USE LPT FOR BATCH
WHERE A, ;FIND STATION FOR REQUEST
SETZ A, ;ASSUME CENTRAL
HRRM A,Q.DEV(Q) ;STORE IT
SETOM RTYCNT ;WANT TO TRY ENTER TWICE
DOQUER: MOVE A,[XWD 400000,16] ;PHYSICAL OPEN
MOVE B,QUESTR ;QUE DEVICE
SETZ C, ;NO BUFFERS
PUSHJ P,XUUO$ ;EXECUTE THE OPEN WITH CHANNEL
OPEN 0,A ;OPEN IT
JRST NOQUE ;CAN'T
MOVSI T3,'QUE' ;EXTENSION FOR UNINAM
PUSHJ P,UNINAM ;GET A UNIQUE NAME
LOOKUP 0,T2 ;CHANNEL ZERO. T2-T5
MOVSI T4,177000 ;NOW ENTER IT AND PROTECT IT
PUSHJ P,XUUO$ ;EXECUTE ENTER
ENTER 0,T2 ;ENTER IT
JRST [AOSG RTYCNT ;FIRST TRY?
JRST DOQUER ;YES. TRY AGAIN
JRST NOENT ] ;NO, GIVE ERROR
MOVNI A,Q.LGTO ;NEGATIVE LENGTH OF OUTPUT ENTRY
CAIN QD,4 ;INP:?
MOVNI A,Q.LGTI ;NEGATIVE LENGTH OF INPUT ENTRY
HRLM A,OLIST ;FIX IOWD
PUSHJ P,XUUO$ ;EXECUTE OUTPUT
OUTPUT 0,OLIST ;WRITE IT
PUSHJ P,XUUO$ ;EXECUTE RELEASE
RELEAS 0, ;RELEAS IT
MOVE A,[%NSHJB] ;GET HIGHEST JOB NUMBER
GETTAB A,
MOVEI A,^D64 ;??
MOVEI B,1
CREDN2: HRLZ C,B ;LOOK AT JOB NAMES
HRRI C,.GTPRG ;IN MONITOR
GETTAB C,
JRST CPOPJ1
CAME C,SPLNAM(QD) ;WHO WE QUEUED FOR?
JRST CREDN3 ;NO. LOOK AT MORE
MOVE C,B ;WAKE HIM
WAKE C,
JFCL ;OH WELL
CREDN3: CAIGE B,(A) ;LOOKED AT ALL JOBS?
AOJA B,CREDN2 ;NO. CONTINUE
JRST CPOPJ1 ;SKIP RETURN TO USER
SUBTTL SUBROUTINES TO DO COMMON THINGS FOR INPUT/OUTPUT
; GET COMMON INFO
GTINF$::MOVEI Q,QHEAD ;SET ADDRESS OF QUEUE BLOCK
SETZB F,QHEAD ;START WITH NO FLAGS
MOVE T1,[XWD QHEAD,QHEAD+1]
BLT T1,QEND ;CLEAR QUEUE BLOCK
MOVX T4,%CNST2 ;IS THIS GALAXY OR MPB SYSTEM
GETTAB T4,
SETZ T4, ;ASSUME MPB
TXNN T4,ST%GAL ;GALAXY?
JRST GTINF1 ;NO.
MOVX T4,%SIQSR ;MAYBE. CHECK MORE
GETTAB T4,
SETZ T4,
JUMPE T4,GTINF1 ;GALAXY? (NONZERO PID)
IFE FTBOTH,<
FAIL (<CMQ Cannot do MPB QUEUE on GALAXY system.>)
>
IFN FTBOTH,<
TLO F,GALAXY ;SET GALAXY BIT
IFMPB GTINFG ;DO GALAXY QUEUE IF NOT MPB
>
GTINF1: MOVEI QF,Q.OSTR(Q) ;ASSUME OUTPUT, FIRST FILE. SUBMIT WILL CORRECT
MOVE A,[BYTE (9).QOHED,Q.FMOD+1(18)1] ;ASSUME OUTPUT REQUEST
CAIN QD,4 ;INP REQUEST?
MOVE A,[BYTE(9).QIHED,Q.FMOD+1(18)2] ;INP REQUEST
MOVEM A,Q.LEN(Q) ;STORE QUE HEADER
MOVEI A,12001 ;VERSION 1, US, CREATE
MOVEM A,Q.OPR(Q) ;STORE IT
HRROI A,.GTNM1 ;GET USER NAME
GETTAB A,
SETZ A,
MOVEM A,Q.USER(Q) ;REMEMBER IT
HRROI A,.GTNM2 ;GET REST OF USER NAME
GETTAB A,
SETZ A,
MOVEM A,Q.USER+1(Q) ;REMEMBER THAT TOO
HRROI A,.GTCNO ;GET CHARGE NUMBER
GETTAB A,
SETZ A,
MOVEM A,Q.CNO(Q) ;REMEMBER THAT
MOVE A,[%LDSTP] ;GET STANDARD PROTECTION
GETTAB A,
MOVSI A,055000 ;DEFAULT
LSH A,-^D27 ;REALIGN
DPB A,[POINTR(Q.PRI(Q),QP.PRO)]
PJOB A, ;GET OUR JOB NUMBER
MOVEM A,THSJB$ ;REMEMBER IT
GETPPN A, ;GET OUR PPN
JFCL ;JUST IN CASE
MOVEM A,Q.PPN(Q) ;STORE IT IN QUE BLOCK
MOVSI A,'QUE' ;FIND QUE DEVICE
DEVCHR A, ;SEE WHAT IT IS
TLNE A,(DV.DSK) ;REAL DISK?
TLNE A,(DV.TTY) ;MAYBE
JRST PUBQUE ;NO
MOVSI A,'QUE' ;GET PPN ASSOCIATED
DEVPPN A,
MOVE A,Q.PPN(Q)
CAME A,Q.PPN(Q) ;IS IT HIMSELF?
JRST PUBQUE ;NO. PUBLIC QUEUE
MOVSI B,'QUE' ;GET ASSOCIATED STR
DEVNAM B,
MOVSI B,'DSK'
JRST STOQUE ;STORE QUE
PUBQUE: MOVE A,[%LDQUE] ;GET QUE PPN
GETTAB A,
MOVE A,[XWD 3,3] ;DEFAULT
MOVE B,[%LDQUS] ;GET QUE STR
GETTAB B,
MOVSI B,'DSK'
STOQUE: MOVEM A,QUEDIR ;STORE QUE PPN
MOVEM B,QUESTR ;STORE QUE STR
POPJ P,
DOFIL$::SETZM $RBPPN ;CLEAR UUO BLOCK
MOVE T1,[XWD $RBPPN,$RBNAM]
BLT T1,$RBDEV
MOVEM A,$RBNAM ;SET NAME TO FIND
MOVEM B,$RBEXT ;EXTENSION TOO
IFMPB DOFILG ;DO GALAXY QUEUE IF NOT MPB
MOVEM A,Q.FNAM(QF) ;AND IN QUE BLOCK
MOVEM A,Q.JOB(Q) ;STORE AS NAME OF JOB
;(MAKES DEFAULT JOB NAME LOG NAME)
MOVEM B,Q.FEXT(QF) ;AND IN QUE BLOCK
HRRZ B,CHAN+0
LSH B,-5 ;GET PPN ASSOCIATED WITH DEVICE
DEVPPN B,
MOVE B,Q.PPN(Q) ;ASSUME SELF
MOVEM B,$RBPPN ;PPN OF FILE
MOVEM B,Q.FDIR(QF) ;AND IN QUE BLOCK
MOVEI A,.QFDPR
CAME B,Q.PPN(Q) ;IS IT HIS PPN?
DPB A,[POINTR(Q.FMOD(QF),QF.DSP)] ;NO. MAKE IS DISP:PRES
HISFIL: TLZ F,NEDREN ;ASSUME NO RENAME NEEDED
MOVEI A,1 ;START AT BEGINNING
DPB A,[POINTR(Q.FBIT(QF),QB.SLN)]
; MAY COME BACK HERE IF DIS:REN FAILS
REFILE: PUSHJ P,XUUO$ ;EXECUTE LOOKUP
LOOKUP 0,$RBBLK ;IS FILE THERE?
JRST [ ;NOT THERE. MAY BE NEW LOG
TLNN F,LOGFIL ;LOG FILE?
POPJ P, ;NO. ERROR
MOVSI A,(QF.DEF) ;FILE DOESN'T EXIST YET
IORM A,Q.LMOD(Q) ;ONLY ON LOG
JRST REL0 ;RELEAS CHANNEL AND SKIP RETURN
]
MOVE A,$RBDEV ;GET DEVICE FILE IS ON
MOVEM A,Q.FSTR(QF) ;STORE IT
SETZM PTHBL$ ;SET ARG TO PATH
MOVE A,[XWD ^D8,PTHBL$]
PATH. A, ;GET FULL PATH TO FILE
JRST NOPTHM ;JUST PPN
MOVSI A,PTHBL$+2 ;GET PPN AND SFDS
HRRI A,Q.FDIR(QF) ;INTO FILE DESCRIPTION
BLT A,Q.FDIR+5(QF) ;JUST SIX WORDS
NOPTHM: MOVSI A,Q.CSTR(Q)
HRRI A,Q.LSTR(Q)
TLNE F,CTLFIL ;IS THIS THE CTL FILE
BLT A,Q.LNAM(Q) ;DEFAULT WHERE TO FIND LOG
; INCLUDED STR,PATH,NAME. NOT EXT
LDB A,[POINT 9,$RBPRV,8]
MOVEI B,177 ;MAKE SURE FILE IS PROTECTED IF WE RENAME
DPB B,[POINT 9,$RBPRV,8]
TRNE A,700 ;IS IT PROTECTED?
JRST PROTOK ;YES
TLO F,NEDREN ;FLAG TO DO A RENAME
MOVSI A,(QB.APF) ;MARK ARTIFICIALLY PROTECTED
IORM A,Q.FBIT(QF)
PROTOK: LDB A,[POINTR(Q.FMOD(QF),QF.DSP)]
CAIE A,.QFDRE ;IS IT DISPOSE RENAME?
JRST NOCROS ;NO. SKIP THIS
PUSHJ P,NEXCH$ ;GET SECONDARY CHANNEL
JRST NOREN ;NO RENAME IF NO CHANNEL
MOVE A,[XWD 400000,16]
MOVE B,$RBDEV
SETZ C,
PUSHJ P,XUUO$ ;EXECUTE THE OPEN
OPEN 1,A ;OPEN THE STR
JRST NOREN ;CAN'T. THEREFORE NO DIS:REN
MOVSI T3,'QUD' ;EXTENSION FOR UNINAM
PUSHJ P,UNINAM ;FIND UNIQUE NAME VIA NEXT LOOKUP
LOOKUP 1,T2 ;SECONDARY CHANNEL
PUSHJ P,XUUO$ ;EXECUTE THE RELEAS
RELEAS 1, ;SECONDARY CHANNEL
HRR T3,$RBEXT ;GET BLOCK WAY WE WANT IT
MOVE T4,$RBPRV ;INCLUDING DATES, PROTECTIONS, ETC
PUSHJ P,XUUO$ ;EXECUTE LOOKUP
RENAME 0,T2 ;RENAME ACROSS DIRECTORIES
JRST NOREN ;FAILED
MOVEM T2,Q.FRNM(QF) ;STORE RENAMED NAME
REL0: PUSHJ P,XUUO$ ;EXECUTE RELEASE
RELEAS 0,
JRST CPOPJ1 ;SKIP RETURN
NOREN: OUTSTR [ASCIZ/
% Cannot do DISPOSE:RENAME. DISPOSE:DELETE assumed.
/]
MOVEI A,.QFDDE ;CHANGE DISP TO DELETE
DPB A,[POINTR(Q.FMOD(QF),QF.DSP)]
TLNN F,NEDREN ;NEED RENAME?
JRST REL0 ;NO. WE'RE DONE
JRST REFILE ;YES. GET FILE BACK
NOCROS: TLNN F,NEDREN ;NEED RENAME?
JRST REL0 ;NO. WE'RE DONE
PUSHJ P,XUUO$ ;EXECUTE RENAME
RENAME 0,$RBBLK ;YES. DO IT
JFCL ;OOPS?
JRST REL0 ;DONE
; SUBROUTINE TO FIND A UNIQUE QUE NAME
; CALL IS
; MOVSI T3,'EXT'
; PUSHJ P,UNINAM
; LOOKUP CHAN,T2
; RETURNS HERE ALWAYS
; WITH NAME IN T2, EXT IN T3, QUEDIR IN T5
; USES A, T1-T5
UNINAM: MOVE T1,@(P) ;GET THE LOOKUP
MOVEM T1,UNINMX ;STORE IT
MSTIME T1, ;FIND A UNIQUE NAME
IDIVI T1,^D100
UNINM1: MOVE T2,QUESIX(QD) ;QUE NAME
MOVE A,[POINT 6,T2,11]
ADD T1,THSJB$
MOVE T4,T1
UNINM2: IDIVI T4,^D10
ADDI T5,'0'
IDPB T5,A
TLNE A,(77B5) ;FILLED OUT SIX CHAR NAME YET?
JRST UNINM2 ;NO
TRZ T3,-1 ;JUST THE EXTENSION
SETZ T4,
MOVE T5,QUEDIR
PUSHJ P,XUUO$ ;EXECUTE THE RIGHT LOOKUP
UNINMX: HALT . ;MODIFIED FOR RIGHT LOOKUP
TRNE T3,-1 ;NO SUCH FILE?
JRST UNINM1 ;IT EXISTS
MOVE T5,QUEDIR ;NAME IS UNIQUE. RETURN PPN
JRST CPOPJ1
>
; SUBROUTINE TO OPEN DSK, CHANNEL ZERO
OPDSK$::MOVEI T1,16 ;OPEN DSK IN DUMP MODE
MOVSI T2,'DSK'
SETZ T3,
PUSHJ P,XUUO$ ;EXECUTE OPEN
OPEN 0,T1
POPJ P,
CPOPJ1: AOS (P) ;SKIP RETURN TO USER
CPOPJ: POPJ P,
; SUBROUTINES TO FIND FREE CHANNELS, AND TO DO IO OPS ON THEM
FIRCH$::MOVEI A,20
MOVEM A,TRYCHN#
SETOM CHAN ;SAY CHANNELS NOT IN USE
SETOM CHAN+1
TDZA A,A
NEXCH$::MOVEI A,1
NEYCHN: SOSGE B,TRYCHN
JRST NOCHN
DEVCHR B,
JUMPN B,NEYCHN
MOVE B,TRYCHN
LSH B,5
MOVEM B,CHAN(A)
JRST CPOPJ1
;ROUTINE TO EXECUTE UUO WITH PROPER CHANNEL INSERTED
XUUO$:: PUSH P,F ;SAVE A REGISTER TO WORK
MOVE F,@-1(P)
TLZN F,(17B12)
JRST XUUO0 ;DO CHANNEL 0
SKIPGE CHAN+1 ;IN USE?
JRST FPOPJ1 ;NO. RETURN
TLO F,@CHAN+1
JRST XUUO2 ;CONTINUE AND DO IT
XUUO0: SKIPGE CHAN+0 ;IN USE?
JRST FPOPJ1 ;NO. RETURN
TLO F,@CHAN
XUUO2: AOS -1(P)
XCT F
SOS -1(P)
FPOPJ1: POP P,F ;RESTORE REGISTER
JRST CPOPJ1
NOCHN: OUTSTR [ASCIZ/NO FREE CHANNELS!
/]
POPJ P,
IFN FTMPB,<
SUBTTL ERROR ROUTINES
NOQUE: MOVEI 1,6 ;CAN'T OPEN QUE DEVICE
OUTSTR [ASCIZ/
% CANNOT OPEN QUEUE DEVICE!
% PLEASE NOTIFY OPERATOR!
/]
POPJ P, ;RETURN
NOENT: MOVEI 1,7 ;CAN'T ENTER QUEUE FILE
OUTSTR [ASCIZ/
% CANNOT ENTER QUEUE REQUEST IN QUE UFD!
% PLEASE NOTIFY OPERATOR!
/]
POPJ P, ;RETURN ERROR.
> ;END IFN FTMPB
IFN FTGALAXY,<
SUBTTL COMMON CODE FOR OUTPUT, SUBMIT
IFN FTBOTH,<DOQUEG:>
IFE FTBOTH,<$DOQUE::>
PUSH P,.JBFF## ;SAVE .JBFF
MOVEM P,SAVEP ;SAVE PDL
MOVE T1,.JBREL## ;SAVE .JBREL
MOVEM T1,SAVREL
ADDI T1,1 ;GET A PAGE
MOVE M,T1 ;FROM MONITOR
CORE T1,
FAIL (<CGC Cannot get core for QUEUE message>)
MOVE T1,M ;COPY MESSAGE ADDRESS
HRLI T1,QHEAD ;WHERE HEADER IS
HLRZ T2,.MSTYP(Q) ;LENGTH OF HEADER
ADD T2,M ;UPPER ADDRESS PLUS ONE
BLT T1,-1(T2) ;MOVE HEADER
MOVE T1,T2 ;WHERE NEXT GROUP GOES
HRLI T1,CTLFB$ ;FROM
HRRZ T3,CTLFB$ ;COMPUTE LENGTH
ADDI T3,FPXSIZ
ADD T2,T3
BLT T1,-1(T2) ;MOVE THIS BLOCK
CAIE QD,4 ;INP QUE?
JRST DOQUE1 ;NO. DONE
MOVE T1,T2 ;YES. GET LOG FILE
HRLI T1,LOGFB$ ;FORM
HRRZ T3,LOGFB$ ;COMPUTE LENGTH
ADDI T3,FPXSIZ
ADD T2,T3
BLT T1,-1(T2) ;MOVE IT
DOQUE1: SUB T2,M ;TOTAL LENGTH
HRLM T2,.MSTYP(M) ;STORE IT AWAY
MOVSI T1,(1B0) ;SET ACK REQUEST
IORM T1,(M) ;IN MESSAGE
TLO M,(1B0) ;AND PAGE MODE MESSAGE IN M
PUSHJ P,MSGSND ;SEND THE MESSAGE
PUSHJ P,RCVACK ;GET ACK
IFN FTJSYS,<
SKIPN T2,MYPID ;DO I OWN A PID
JRST QMRX.1 ;NO, JUST RETURN
MOVEI S1,2 ;TWO WORDS
MOVEI S2,T1 ;IN T1 AND T2
MOVEI T1,.MUDES ;DESTROY PID IN T2
MUTIL ;EXECUTE IT
JFCL ;NICE TRY
>
PUSHJ P,XUUO$ ;EXECUTE RELEASE
RELEAS 0,
PUSHJ P,CHKCOR ;CLEAN UP OUR CORE
POP P,.JBFF ;RESTORE .JBFF
JRST CPOPJ1
SUBTTL SUBROUTINES TO DO COMMON THINGS FOR INPUT/OUTPUT
;GET COMMON INFO
IFE FTBOTH,<
GTINF$::MOVX T4,%CNST2 ;GET SECOND STATES WORD
GETTAB T4, ;TO LOOK FOR GALAXY-10
ZERO T4 ;WHAT!!
TXNN T4,ST%GAL ;SYSTEM HAVE SUPPORT FOR GALAXY-10
FAIL(<NGS No GALAXY-10 Support in this monitor>)
MOVEI Q,QHEAD ;ADDRESS OF QUEUE AREA
SETZB F,QHEAD ;CLEAR IT OUT
MOVE T1,[XWD QHEAD,QHEAD+1]
BLT T1,QEND
>
IFN FTBOTH,<GTINFG:>
MOVEI QF,CTLFB$ ;ADDRESS OF FIRST FILE BLOCK
PJOB A, ;COPY JOB NUMBER
MOVEM A,THSJB$ ;TO MEMORY
MOVE T1,[XWD EQHSIZ,.QOCRE] ;ASSUME OUTPUT REQUEST
CAIN QD,4 ;INP REQUEST?
IFN FTUUOS,<
HRLI T1,.EQPSZ ;SIZE OF INP REQUEST
>
IFN FTJSYS,<
HRLI T1,EQHSIZ ;SIZE OF INP REQUEST
>
MOVEM T1,.MSTYP(Q)
IFN FTUUOS,<
MOVE T1,[XWD %%.QSR,.EQPSZ] ;LENGTH WORD
CAIE QD,4 ;INP?
HRRI T1,EQHSIZ ;NO
>
IFN FTJSYS,<
MOVE T1,[XWD %%.QSR,EQHSIZ] ;LENGTH WORD
>
MOVEM T1,.EQLEN(Q)
MOVE T1,QUESIX(QD) ;QUEUE DEVICE
MOVEM T1,.EQRDV(Q)
HRROI T1,.GTLOC ;GET LAST LOCATE(EVEN IF NO LPT!)
GETTAB T1,
SETZ T1,
DPB T1,[POINTR(.EQSEQ(Q),EQ.DSN)]
MOVE T1,[%LDSTP] ;GET DEFAULT SYSTEM PROTECTION
GETTAB T1,
MOVSI T1,055000 ;DEFAULT
LSH T1,-^D27 ;RIGHT JUSTIFY
DPB T1,[POINTR(.EQSPC(Q),EQ.PRO)]
MOVEI T1,1 ;DEFAULT NUMBER OF FILES
CAIN QD,4 ;UNLESS INP
MOVEI T1,2 ;TWO FOR THAT
DPB T1,[POINTR(.EQSPC(Q),EQ.NUM)]
IFN FTUUOS,<
HRROI T1,.GTNM1 ;GET USER NAME
GETTAB T1,
SETZ T1,
MOVEM T1,.EQUSR(Q)
HRROI T1,.GTNM2
GETTAB T1,
SETZ T1,
MOVEM T1,.EQUSR+1(Q)
GETPPN T1, ;GET PPN
JFCL
MOVEM T1,.EQOWN(Q)
PUSHJ P,QUEFLS ;FLUSH THE RECEIVE QUEUE FIRST
>
IFN FTJSYS,<
PUSHJ P,DOACCT ;FILL THE ACCOUNTING STRING
>
POPJ P,
IFN FTJSYS,<
DOACCT: PUSH P,S1 ;SAVE S1
PUSH P,S2 ;SAVE S2
SETO S1, ;MY JOB
HRROI S2,.EQACT(M) ;POINT TO BLOCK FOR STRING
GACCT ;GET ACCOUNT FOR MY JOB
TXC S2,5B2 ;FLIP THOSE BITS
TXNE S2,5B2 ;IF THEY ARE BOTH 0 THEY WERE 1
JRST DOAC.2 ;TWAS A STRING, RETURN
MOVE S1,[POINT 7,.EQACT(M)] ;ELSE MAKE A BYTE POINTER
MOVE T1,S2 ;GET ACCOUNT NUMBER
PUSHJ P,DOAC.1 ;CONVERT TO STRING
DOAC.2: POP P,S2 ;RESTORE S2
POP P,S1 ;RESTORE S1
POPJ P, ;AND RETURN
DOAC.1: IDIVI T1,12 ;GET DIGIT MOD 10
PUSH P,T2 ;STACK IT
SKIPE T1 ;DONE IF 0
PUSHJ P,DOAC.1 ;ELSE, RECURSE
POP P,T1 ;GET THE DIGIT BACK
ADDI T1,"0" ;CONVERT TO ASCII
IDPB T1,S1 ;DEPOSIT IT
POPJ P, ;AND RETURN
>
IFE FTBOTH,<
DOFIL$::SETZM $RBPPN ;CLEAR LOOKUP BLOCK
MOVE T1,[XWD $RBPPN,$RBPPN+1]
BLT T1,$RBDEV
MOVEM A,$RBNAM ;SAVE NAME IN LOOKUP BLOCK
MOVEM B,$RBEXT ;SAVE EXTENSION IN LOOKUP BLOCK
>
IFN FTBOTH,<DOFILG:>
MOVEM A,.EQJOB(Q) ;ALSO JOB NAME (MAKES SAME AS LOG FILE)
IFN FTUUOS,<
MOVEM A,FPXSIZ+.FDNAM(QF)
HLLZM B,FPXSIZ+.FDEXT(QF)
>
HRRZ B,CHAN+0
LSH B,-5 ;CHANNEL FOR PRIMARY
DEVPPN B, ;PPN OF FILE DEVICE
IFN FTUUOS,<
MOVE B,.EQOWN(Q) ;US
>
IFN FTJSYS,<
SETZ B, ;??
>
MOVEM B,$RBPPN ;FOR LOOKUP
IFN FTUUOS,<
MOVEM B,FPXSIZ+.FDPPN(QF) ;FILE BLOCK
MOVEI A,FP.DEL ;DELETE BIT
CAME B,.EQOWN(Q) ;SELF?
ANDCAM A,.FPINF(QF) ;NO. CLEAR DELETE REQUEST
>
REFILG: PUSHJ P,XUUO$ ;EXECUTE THE LOOKUP
LOOKUP 0,$RBBLK ;LOOKUP FOR FILE
JRST MAKFIL ;OOPS
IFN FTUUOS,<
MOVE T1,$RBDEV ;GET STR
MOVEM T1,STRBLK+.DCNAM ;SET UP DSKCHR
MOVE T1,[XWD 5,STRBLK]
DSKCHR T1, ;DO IT
JRST REFIL1 ;OOPS
JUMPE T1,REFIL1 ;NUL!
SKIPA T1,STRBLK+.DCSNM ;REAL STR NAME
REFIL1: MOVE T1,$RBDEV ;JUST AS LOOKUP UP
MOVEM T1,FPXSIZ+.FDSTR(QF) ;STORE STR NAME
SETZM PTHBL$ ;GET PATH
MOVEI B,FDMSIZ ;MINIMUM BLOCK SIZE
MOVE A,[XWD ^D8,PTHBL$]
PATH. A, ;GET PATH
JRST NOPTHG ;OOPS
MOVSI T1,-5 ;COPY IT ALL
REFIL2: MOVE A,PTHBL$+3(T1) ;GET AN SFD
JUMPE A,NOPTHG ;DONE ON ZERO
MOVEM A,FPXSIZ+.FDPAT(T1)
ADDI B,1 ;ONE LONGER FILE BLOCK
AOBJN T1,REFIL2 ;LOOP
NOPTHG: HRLI B,FPXSIZ ;SET UP HEADER
MOVEM B,.FPSIZ(QF) ;STORE
>
IFN FTJSYS,<
MOVEI T3,.FPSTG(QF) ;WHERE TO STORE STRING
HRLI T3,(POINT 7,0) ;BYTE POINTER
MOVE A,[4,,T1] ;LENGTH,,ARGS
MOVEI T1,3 ;FUNCTION 3, PPN TO STRING
MOVE T2,$RBPPN ;THE PPN, BYTE POINTER IS IN T3
MOVE T4,$RBDEV ;GET STRUCTURE
COMPT. A,
FAIL (<CDD Cannot determine directory of file owner>)
MOVEI T1,$RBNAM ;FILE NAME
PUSHJ P,BLDSTG ;INTO THE STRING
STCHR <"."> ;MORE PUNCTUATION
HLLZS $RBEXT ;JUST EXTENSION
MOVEI T,$RBEXT ;NOW POINT TO IT
PUSHJ P,BLDSTG ;INTO THE STRING
STCHR 0 ;ADD A NULL TO TERMINATE THE STRING
HRRZS T3 ;NOW COMPUT THE LENGTH
SUBI T3,.FPSTG-1(QF) ;THE NUMBER OF WORDS IN THE STRING
HRLI T3,.FPXSIZ ;PARAMETER LENGTH
MOVEM T3,.FPSIZ(QF) ;STORE
>
PUSHJ P,XUUO$ ;EXECUTE RELEASE
RELEAS 0, ;FREE DEVICE
JRST CPOPJ1
MAKFIL: TLNN F,LOGFIL ;LOG FILE?
JRST RELERR ;NO. ERROR
HRRZ T1,$RBEXT ;GET ERROR
JUMPN T1,RELERR ;ERROR IF EXISTS
PUSHJ P,XUUO$ ;EXECUTE THE ENTER
ENTER 0,$RBBLK ;MAKE THE FILE
JRST RELERR ;OOPS!
PUSHJ P,XUUO$ ;EXECUTE THE CLOSE
CLOSE 0, ;CLOSE IT
JRST REFILG ;NOW DO IT
RELERR: PUSHJ P,XUUO$ ;EXECUTE THE RELEASE
RELEAS 0, ;FREE DEVICE
POPJ P,
IFN FTJSYS,<
; SIXBIT TO ASCII CONVERSION UTILITY
BLDSTG: HRLI T1,(POINT 6,0) ;A SIXBIT BYTE
BLSTG1: ILDB T2,T1 ;GET ONE
JUMPE T2,CPOPJ ;DONE ON A NULL (SPACE)
ADDI T2," " ;ASCII-IZE IT
IDPB T2,T3 ;INTO CURRENT STRING
TLNE T1,770000 ;OFF THE END YET
JRST BLSTG1 ;NO, GET ANOTHER
POPJ P, ;RETURN WITH CHRS AND BP UPDATED
> ;END OF IFN FTJSYS
> ;END IFN FTGALAXY
SUBTTL Subroutines
;SUBROUTINE TO TYPE OUT A MESSAGE AND BOMB.. CALLED BY THE 'FAIL' & 'FAIL1' MACROS
FAIL.: PUSHJ P,TTCRLF ;START THE LINE
OUTSTR [ASCIZ/?QMR/] ;ADD PREFIX
OUTSTR (T1) ;OUTPUT SUFFIX AND MESSAGE AFTER PREFIX
PUSHJ P,TTCRLF ;END THE LINE
FAIEXI: EXIT 1, ;EXIT AFTER THE OUTPUT
FAIL1(<CNC Can't CONTINUE -- try REENTER>)
;TTY OUTPUT SUBROUTINES
TTCRLF: OUTSTR [BYTE (7) .CHCRT, .CHLFD, 0]
POPJ P,
IFN FTGALAXY,<
TTYSIX: MOVE T2,[POINT 6,T1] ;THE INITIAL BYTE POINTER
TYSIX1: ILDB T3,T2 ;GET A CHARACTER
JUMPE T3,CPOPJ ;STOP AT A NULL (BLANK)
ADDI T3," " ;ASCII-IZE IT
OUTCHR T3 ;DUMP IT OUT
TLNE T2,770000 ;END OF THE WORD
JRST TYSIX1 ;NO, GET ANOTHER
POPJ P, ;ALL DONE
; CORE MANIPULATION ROUTINES
CHKCOR: MOVE T1,.JBREL## ;GET CURRENT .JBREL
CAMG T1,SAVREL ;GREATER THAN SHOULD BE?
POPJ P, ;NO. DONE
LSH T1,-^D9 ;GET PAGE NUMBER
TLO T1,(1B0) ;SET DELETE BIT
MOVEM T1,PAGTAB+1 ;AND PAGE
MOVEI T1,1 ;ONE PAGE TO DELETE
MOVEM T1,PAGTAB
MOVE T1,[XWD .PAGCD,PAGTAB]
PAGE. T1,
JRST .+2 ;OOPS
JRST CHKCOR ;SKRINK MORE?
MOVE T1,SAVREL ;CAN'T DO PAGE.
CORE T1, ;SO DO CORE - SHOULD BE SAFE
FAIL (<CCC Cannot cutback core.>)
POPJ P, ;RETURN
;SUBROUTINES TO FLUSH THE RECEIVE QUEUE (NEEDED FOR TOPS10 ONLY)
IFN FTUUOS,<
QUEFLS: PUSHJ P,QUEQRY ;QUERY THE QUEUE
PJUMPE S2,CPOPJ ;RETURN WHEN EMPTY
PUSHJ P,QUEIGN ;IGNORE THE ENTRY
JRST QUEFLS ;AND KEEP GOING
QUEQRY: SETZB T1,T2 ;CLEAR QUERY BLOCK
SETZB T3,T4 ;FOR GOOD MEASURE
MOVE S2,[4,,T1] ;LENGTH,,ARGUMENTS
IPCFQ. S2, ;FIND OUT WHATS THERE
SETZ T4, ;NOTHING, CLEAR T4
MOVE S2,T4 ;COPY QUEUE STATUS INTO S2
JUMPE S2,CPOPJ ;RETURN IF NOTHING THERE
CAMN T2,QSRPID ;FROM QUASAR
POPJ P, ;YES, RETURN NOW
PUSHJ P,QUEIGN ;FLUSH THE JUNK MAIL
JRST QUEQRY ;LOOK AGAIN
QUEIGN: ANDX T1,IP.CFV ;CLEAR ALL BUT PAGE MODE BIT
TXO T1,IP.CFT ;SET TO TRUNCATE
SETZB T2,T3 ;CLEAR THEM AGAIN
MOVEI T4,1 ;LENGTH = 0 , LOC = 1
MOVE S2,[4,,T1] ;SET UP LENGTH AND BLOCK ADDRESS
IPCFR. S2, ;THROW AWAY THE MESSAGE
FAIL(<CFR Cannot flush the IPCF receive queue>)
POPJ P, ;RETURN
QUEWAT: PUSHJ P,QUEQRY ;FIND OUT WHATS THERE
JUMPN S2,CPOPJ ;SOMETHING, RETURN
MOVX S2,<HB.IPC+^D2000> ;FLAGS,,NAP TIME
HIBER S2, ;WAIT FOR A REASONABLE TIME
JFCL ;WATCH THIS LOOP
JRST QUEWAT ;TRY NOW
> ;END OF IFN FTUUOS
; SUBROUTINE TO RECEIVE AN EXPECTED "ACK" FROM QUASAR
; IT RETURNS TO THE CALLER AFTER RECEIVING A "GOOD" ONE
; ISSUES AN ERROR MESSAGE AND QUITS ON A "BADDY"
RCVACC: PUSHJ P,CHKCOR ;CLEAN UP CORE
RCVACK: MOVEI M,FBTEMP ;AREA FOR SHORT RECEIVE
IFN FTUUOS,<
PUSHJ P,QUEWAT ;WAIT FOR A RETURNED MESSAGE
ANDX T1,IP.CFV ;CLEAR ALL BUT THE PAGE MODE BIT
SETZB T2,T3 ;CLEAR THESE AGAIN
HRRI T4,(M) ;WHERE TO RECEIVE INTO
TXNN T1,IP.CFV ;IS IT A PAGE
JRST RCVA.1 ;NO, GO GET IT
MOVE M,.JBREL## ;GET A PAGE TO RECEIVE INTO
MOVEI M,777(M) ;ROUND UP
ADR2PG M ;CONVERT TO PAGE NUMBER
HRRI T4,(M) ;SET THE ADDRESS
HRLI T4,1000 ;LENGTH OF A PAGE
PG2ADR M ;STILL NEED TO POINT TO IT
RCVA.1: MOVE S2,[4,,T1] ;READY TO GET IT
IPCFR. S2, ;GET THE ACK FROM QUASAR
FAIL(<ARF Acknowledgement Receive Failed>)
> ;END OF IFN FTUUOS
IFN FTJSYS,<
SETZB T1,T2 ;CLEAR FLAGS, SENDER
MOVE T3,MYPID ;RECEIVER
HRLI T4,FBAREA ;SIZE OF SHORT MESSAGE
HRRI T4,FBTEMP ;TEMPORARY BLOCK
PUSH P,S1 ;SAVE USER AREA BASE
MOVEI S1,4 ;FOUR WORDS
MOVEI S2,T1 ;IN T1-T4
MRECV ;RECEIVE THE ACK
FAIL(<ARF Acknowledgement Receive Failed>)
POP P,S1 ;RESTORE USER BASE
> ;END OF IFN FTJSYS
LOAD S2,TEX.ST(M) ;GET THE MESSAGE STATUS WORD
TXNE S2,TX.NMS ;NORMAL "ACK" (NO MESSAGE ASSOCIATED)
JRST RCVA.3 ;YES, SEE IF IT IS TIME TO RETURN
TXNN S2,TX.MOR ;FIRST OF MANY
JRST RCVA.4 ;NO, OUTPUT THE MESSAGE
JRST RCVACC ;THROW THIS AWAY
;FALL ONTO THE NEXT PAGE FOR THE OUTPUT OF THE MESSAGE RECEIVED
;HERE TO OUTPUT THE BODY OF THE ACK MESSAGE
RCVA.4: MOVEI T1,"[" ;CHARACTER FOR INFORMATIONAL MESSAGES
TXNN S2,TX.FAT!TX.WRN ;FATAL OR WARNING
JRST RCVA.2 ;NEITHER, JUST REPORT THE TEXT
MOVEI T1,"?" ;FATAL CHARACTER
TXNN S2,TX.FAT ;WAS IT FATAL
MOVEI T1,"%" ;NO, LOAD WARNING CHARACTER
OUTCHR T1 ;OUTPUT THE "?" OR "%"
OUTSTR [ASCIZ/QSR/] ;OUTPUT "QUASAR" PREFIX
LOAD T1,TEX.ST(M),TX.SUF ;GET THE MESSAGE SUFFIX
HRLZS T1 ;INTO THE OTHER SIDE FOR TTYSIX
PUSHJ P,TTYSIX ;OUTPUT THE FULL ERROR CODE
MOVEI T1," " ;GET ALIGNMENT CHARACTER
RCVA.2: OUTCHR T1 ;MAKE THE OUTPUT PRETTY
OUTSTR TEX.MS(M) ;AND FINALLY, OUTPUT THE MESSAGE
TXNN S2,TX.FAT!TX.WRN ;ANOTHER CHECK
OUTCHR ["]"] ;GEE..IT TAKES A LOT TO DO NICE WORK
PUSHJ P,TTCRLF ;END THE MESSAGE
TXNE S2,TX.FAT ;AGAIN, WAS IT FATAL
JRST FAIEXI ;YES, QUIT NOW
RCVA.3: TXNE S2,TX.MOR ;MORE COMING
JRST RCVACC ;YES, DO THIS ALL OVER AGAIN
JRST CHKCOR ;CONTINUE PROCESSING
IFN FTUUOS,<
MSGSND: SETO T4, ;FLAG INDICATING FIRST TRY
MSGS.1: MOVX T3,%SIQSR ;GETTAB FOR PID OF [SYSTEM]QUASAR
GETTAB T3, ;SEE IF IT IS RUNNING
FAIL(<SGF SYSID. GETTAB failed>)
MOVEM T3,QSRPID ;REMEMBER QUASAR'S PID
SETOM RTYCNT ;INIT RETRY COUNTER
JUMPN T3,MSGGO ;THERE HE IS, SEND THE MESSAGE
MOVEI T3,3 ;NOT UP YET, TRY A SLEEP
SLEEP T3, ;GIVE IT A CHANCE
AOJN T4,MSGS.1 ;JUMP IF ALREADY GAVE A MESSAGE
OUTSTR [ASCIZ/
%QMRWFQ Waiting For [SYSTEM]QUASAR to Start
/]
JRST MSGS.1 ;TRY NOW
MSGGO: SETZB T1,T2 ;CLEAR FLAGS,MY PID
MOVEI T4,(M) ;MESSAGE ADDRESS, T3 = QSRPID
LOAD S2,.MSTYP(M),MS.CNT ;GET THE LENGTH OF THE MESSAGE
TXNN M,1B0 ;IS THIS A PAGE MODE REQUEST
JRST MSGGO1 ;NO, SEND IT
MOVX T1,IP.CFV ;INDICATE A PAGE SEND
LSH T4,-^D9 ;CONVERT 'M' TO A PAGE NUMBER
MOVEI S2,1000 ;LENGTH MUST BE 1000
MSGGO1: HRL T4,S2 ;INCLUDE CORRECT SIZE IN HEADER
MSGGO2: MOVE S2,[4,,T1] ;ARGUMENT FOR SEND
IPCFS. S2, ;SEND THE MESSAGE
SKIPA ;FAILED, SEE WHY
POPJ P, ;RETURN TO CALLER
CAIE S2,IPCDD% ;QUASAR DISABLED
CAIN S2,IPCRS% ;OR MY QUOTA EXHAUSTED
JRST RETRY ;YES, TRY IT AGAIN
CAIE S2,IPCRR% ;QUASAR FULL
CAIN S2,IPCRY% ;OR SYSTEM FULL
JRST RETRY ;YES, TRY IT AGAIN
FAIL1(<SQF Send to [SYSTEM]QUASAR failed>)
RETRY: MOVEI S2,2 ;WAIT BEFORE TRYING AGAIN
SLEEP S2, ;TAKE A QUICK NAP
AOSE RTYCNT ;COUNT THE RETRIES
JRST MSGGO2 ;TRY NOW
OUTSTR [ASCIZ/
%QMRMBR Send has failed, Message Being Re-sent
/]
JRST MSGGO2 ;NOW RETRY IT
> ;END OF IFN FTUUOS
IFN FTJSYS,<
MSGSND: SETO T4, ;FLAG INDICATING FIRST TRY
PUSH P,S1 ;SAVE USER BASE
MSGS.1: MOVEI S1,3 ;NUMBER OF WORDS
MOVEI S2,T1 ;USE T1-T3
MOVEI T1,.MURSP ;READ SYSTEM PID TABLE
MOVX T2,.SPQSR ;WANT PID OF SYSTEM QUASAR
MUTIL ;READ THE TABLE
SETZ T3, ;ASSUME IT CONTAINS AN INVALID PID
MOVEM T3,QSRPID ;REMEMBER QUASAR'S PID
SETOM RTYCNT ;INIT RETRY COUNTER
JUMPN T3,MSGGO ;JUMP IF QUASAR IS RUNNING
MOVEI S1,^D3000 ;WAIT FOR IT
DISMS ;TAKE A NAP
AOJN T4,MSGS.1 ;JUMP IF ALREADY GAVE A MESSAGE
OUTSTR [ASCIZ/
%QMRWFQ Waiting For [SYSTEM]QUASAR to Start
/]
JRST MSGS.1 ;TRY NOW
MSGGO: SETZ T1, ;ASSUME NO FLAGS
SKIPN T2,MYPID ;DO I HAVE A PID
TXO T1,IP%CPD ;NO, CREATE ONE ON THIS SEND
MOVEI T4,(M) ;POINT TO THE MESSAGE
LOAD S2,.MSTYP(M),MS.CNT ;GET THE LENGTH OF THE MESSAGE
TXNN M,1B0 ;IS THIS PAGED
JRST MSGGO1 ;NO, SEND IT
TXO T1,IP.CFV ;SET PAGE MODE FLAG
LSH T4,-^D9 ;CONVERT ADDR TO A PAGE NUMBER
MOVEI S2,1000 ;LENGTH OF A PAGE
MSGGO1: HRL T4,S2 ;INCLUDE THE LENGTH
MOVEI S1,4 ;FOUR WORDS
MOVEI S2,T1 ;IN T1-T4
MSEND ;SEND THE PACKET
JRST MSGGO2 ;FAILED, SEE WHY
SKIPN MYPID ;DO I ALREADY HAVE THE PID
MOVEM T2,MYPID ;NO, SAVE IT
POP P,S1 ;RESTORE S1
POPJ P, ;AND RETURN TO CALLER
;MORE OF THE TOPS20 VERSION ON THE NEXT PAGE
MSGGO2: CAIE S1,IPCFX6 ;CHECK FOR EXHAUSTED QUOTAS
CAIN S1,IPCFX7 ;AND RETRY IF POSSIBLE
JRST RETRY ;IS POSSIBLE
CAIE S1,IPCFX8 ;ANOTHER RECOVERABLE ERROR
CAIN S1,IPCFX5 ;QUASAR DISABLED
JRST RETRY ;YES, TRY AGAIN
FAIL1(<SQF Send to [SYSTEM]QUASAR failed>)
RETRY: SKIPN MYPID ;DO I HAVE A PID
MOVEM T2,MYPID ;NO, MAYBE THIS IS IT
MOVEI S1,^D2000 ;WAIT BEFORE TRYING AGAIN
DISMS ;WAIT
AOSE RTYCNT ;COUNT THE RETRIES
JRST MSGGO ;TRY NOW
OUTSTR [ASCIZ/
%QMRMBR Send has failed, Message Being Re-sent
/]
JRST MSGGO ;AND TRY THE SEND AGAIN
> ;END OF IFN FTJSYS
> ;END IFN FTGALAXY
END