Trailing-Edge
-
PDP-10 Archives
-
BB-M080Z-SM
-
exec/execqu.mac
There are 47 other files named execqu.mac in the archive. Click here to see a list.
; Edit= 4449 to EXECQU.MAC on 22-May-90 by GSCOTT
;Update copyright notice as needed.
; Edit= 4418 to EXECQU.MAC on 19-Jan-89 by WONG, for SPR #22043
;Add code to support @MODIFY PRINT /REMOTE-PRINTER:
; Edit= 4417 to EXECQU.MAC on 12-Jan-89 by WONG, for SPR #22042
;Add code to support @SET DEFAULT PRINTER /REMOTE-PRINT: command and fix some
;bugs in routine SRPPTR: which deals with validating the arguments to the @SET
;REMOTE PRINTER command.
; Edit= 4402 to EXECQU.MAC on 5-Apr-88 by EVANS (TCO 7.1265)
;Make the EXEC accept non-alphanumeric characters $,_,-,and . in LAT-type
;names for remote printing.
; UPD ID= 4127, RIP:<7.EXEC>EXECQU.MAC.13, 7-Mar-88 18:25:31 by GSCOTT
;TCO 7.1255 - Update copyright notice.
; UPD ID= 4105, RIP:<7.EXEC>EXECQU.MAC.12, 25-Feb-88 17:43:05 by RASPUZZI
;TCO 7.1242 - After I DEC, IPCPG seems to have left over stuff in .MSFLG
; word. Zero this out before asking QUASAR for an acknowledgement.
; UPD ID= 4102, RIP:<7.EXEC>EXECQU.MAC.11, 18-Feb-88 15:56:33 by RASPUZZI
;TCO 7.1232 - Make the EXEC understand that some messages could be from
; QUASAR and NEBULA.
; UPD ID= 4090, RIP:<7.EXEC>EXECQU.MAC.10, 19-Jan-88 15:18:43 by EVANS
;TCO 7.1188 - Answer Grump 139 by changing error message.
; UPD ID= 4083, RIP:<7.EXEC>EXECQU.MAC.9, 15-Dec-87 14:36:21 by RASPUZZI
;TCO 7.1163 - Get rid of horrendous hack to make file switches in job
; switch table invisible and vice versa and paginate somewhat.
; UPD ID= 63, RIP:<7.EXEC>EXECQU.MAC.8, 10-Nov-87 15:08:15 by EVANS
;TCO 7.1113 Display "Defaults are not implemented for remote printing"
; As sson as the user tries to set such a default.
;TCO 7.1110 Use the default DESTINATION-NODE: if the user gave a queue
; name not in the table.
; UPD ID= 61, RIP:<7.EXEC>EXECQU.MAC.7, 3-Nov-87 15:28:19 by EVANS
; TCO 7.1109 - (More of TCO 7.1084) Make the KILL message block the right size,
; and be sure to store the nodename in KIL.ND.
; UPD ID= 55, RIP:<7.EXEC>EXECQU.MAC.6, 29-Oct-87 15:29:06 by EVANS
;TCO 7.1099 - Make the help message for the /REMOTE-PRINTER switch
; say that LAT Port/Service names can only be 16 characters.
; UPD ID= 45, RIP:<7.EXEC>EXECQU.MAC.5, 27-Oct-87 15:16:25 by EVANS
;TCO 7.1084 - Add the /DESTINATION-NODE: switch to the INFORMATION
; OUTPUT and CANCEL PRINT commands.
; More of TCO 7.1073 - fix a bug.
; UPD ID= 37, RIP:<7.EXEC>EXECQU.MAC.4, 21-Oct-87 13:22:02 by EVANS
;More of TCO 7.1073 - Add final code for remote PRINT - store the
; queue name in the EQ block.
; UPD ID= 33, RIP:<7.EXEC>EXECQU.MAC.3, 20-Oct-87 15:18:09 by EVANS
;TCO 7.1073 - Add parsing for /CHARACTERISTIC: and /REMOTE-PRINTER:
; Add routines to resolve alias to bit-mask or node name
; and queuename.
; Add routines to store bit-mask and node name in EQ block.
; Add flag to /DESTINATION-NODE: processing
; Add "not implemented" message for INFO DEFAULT PRINT
; /CHARACTERISTICS: and /REMOTE-PRINTER:
; *** Edit 3057 to EXECQU.MAC by RASPUZZI on 31-Mar-87, for SPR #21545
; Make the EXEC print out "/FILE:" instead of "/MODE:" during an "INFORMATION
; DEFAULT PRINT" command
; *** Edit 3036 to EXECQU.MAC by EVANS on 20-May-86, for SPR #21260
; Make the INFO DEFAULTS command give the default unit number for PRINT in
; decimal
; Edit 3017 to EXECQU.MAC by EVANS on 15-Oct-85 (TCO none)
; Prevent a SET DEFAULT (GALAXY-related) command from echoing twice if issued
; from a TAKE file with subcommand ECHO. QAR 838277
; Edit 3015 to EXECQU.MAC by PRATT on 29-Aug-85 (TCO 6.1.1532)
; Fix inifite looping caused by OLDIDX not being cleared in IPCFLS
; UPD ID= 239, SNARK:<6.1.EXEC>EXECQU.MAC.6, 10-Jun-85 08:45:09 by DMCDANIEL
; UPD ID= 180, SNARK:<6.1.EXEC>EXECQU.MAC.5, 3-May-85 08:32:16 by DMCDANIEL
;Update copyrights for 6.1.
; UPD ID= 157, SNARK:<6.1.EXEC>EXECQU.MAC.4, 2-May-85 11:17:22 by PRATT
;TCO 6.1.1353 - Handle errors better after GNJFN's
; UPD ID= 152, SNARK:<6.1.EXEC>EXECQU.MAC.3, 26-Apr-85 16:14:41 by EVANS
;TCO 6.1.1340 - At FILNJF+3, clear the /FILE switch on GNJFN failure.
; UPD ID= 150, SNARK:<6.1.EXEC>EXECQU.MAC.2, 4-Apr-85 17:37:17 by DUSSEAULT
;TCO 6.1.1306 - At .MODIF+9 add $ and _ to the break mask.
; UPD ID= 430, SNARK:<6.EXEC>EXECQU.MAC.28, 23-Jul-84 16:30:42 by PRATT
;TCO 6.2143 - Fix the typo at FILBK1+21 (ERJMP FILBK1 to ERJMP FILBKE)
; UPD ID= 417, SNARK:<6.EXEC>EXECQU.MAC.27, 13-Jul-84 14:17:55 by PRATT
;Fix 6.2113 - The garbaged edit
; UPD ID= 416, SNARK:<6.EXEC>EXECQU.MAC.25, 29-Jun-84 13:57:33 by PRATT
;TCO 6.2113 - Reverse the .mnohe and .mhead labels
; UPD ID= 410, SNARK:<6.EXEC>EXECQU.MAC.24, 8-Jun-84 11:37:08 by SHTIL
; TCO 6.2043 Fix a mistake in UPD 407:check SDF in STOR1
; UPD ID= 407, SNARK:<6.EXEC>EXECQU.MAC.23, 3-May-84 08:43:25 by SHTIL
;TCO 6.2043 ;Make set default waits confirmation
; UPD ID= 404, SNARK:<6.EXEC>EXECQU.MAC.22, 3-May-84 08:14:54 by SHTIL
;Make GUNIT requests a decimal unit number
; UPD ID= 400, SNARK:<6.EXEC>EXECQU.MAC.21, 26-Apr-84 14:43:32 by PRATT
;TCO 6.2049 - remove tco 6.1412, used only for inhouse diablo support
; UPD ID= 299, SNARK:<6.EXEC>EXECQU.MAC.20, 18-Jul-83 16:15:15 by JCAMPBELL
;TCO 6.1730 - Set /FILE:FORTRAN if FB%FOR in .FBCTL in FDB set.
; UPD ID= 262, SNARK:<6.EXEC>EXECQU.MAC.19, 21-Feb-83 16:06:06 by MURPHY
;TCO 6.1514 - Error codes not in AC if ERJMP after MSEND, MRECV.
; UPD ID= 225, SNARK:<6.EXEC>EXECQU.MAC.18, 12-Jan-83 15:16:53 by CHALL.WIZARD
;TCO 6.1457 Change %1s to %1S at FILBKE
; UPD ID= 222, SNARK:<6.EXEC>EXECQU.MAC.17, 12-Jan-83 10:15:01 by WEETON
;TCO 6.1112 & 6.1113 - force assist to be yes/no and force postive request
; when canceling jobs.
; UPD ID= 206, SNARK:<6.EXEC>EXECQU.MAC.16, 10-Dec-82 16:08:04 by ACARLSON
;TCO 6.1412 - Add /Letter-Quality and /Left-margin: switches to PRINT cmnd
; UPD ID= 201, SNARK:<6.EXEC>EXECQU.MAC.15, 30-Nov-82 11:20:08 by ACARLSON
;If non-priv'd user sends my EXEC an IPCF packet, the EXEC tries to ignore
;it and exits back to COMND leaving the EXEC at interrupt level.
; UPD ID= 162, SNARK:<6.EXEC>EXECQU.MAC.14, 27-Sep-82 16:56:46 by ACARLSON
;Add USERID option to ^ESET PRIVATE-QUASAR (for GALAXY)
; UPD ID= 131, SNARK:<6.EXEC>EXECQU.MAC.13, 29-Jul-82 09:45:15 by CHALL
;TCO 6.1197 .MSNOD- The wrong word was being written (off by one)
; UPD ID= 136, SNARK:<5.EXEC>EXECQU.MAC.19, 3-Feb-82 13:25:19 by GROUT
;TCO 5.1708 - Fix /JOBNAME help message, make comma illegal after comma
; UPD ID= 130, SNARK:<5.EXEC>EXECQU.MAC.18, 13-Jan-82 16:03:52 by KROSENBLUH
;TCO 5.1670 - make /LIMIT work for card-reader, punch and plotter
; UPD ID= 125, SNARK:<5.EXEC>EXECQU.MAC.17, 28-Dec-81 11:17:13 by CHALL
;TCO 6.1052 - UPDATE COPYRIGHT NOTICE AND DELETE PRE-V4.1 EDIT HISTORY
; UPD ID= 62, SNARK:<5.EXEC>EXECQU.MAC.13, 3-Sep-81 18:28:27 by TILLSON
;TCO 5.1489 Let CANCEL request-type ? tell us about "*"
; UPD ID= 28, SNARK:<5.EXEC>EXECQU.MAC.11, 14-Aug-81 18:34:52 by CHALL
;TCO 5.1456 .MODIF- TELL ABOUT "*" AS A LEGAL OPTION TO "MOD MUMBLE"
;TCO 5.1454 CHANGE NAME FROM XDEF TO EXECDE
; UPD ID= 23, SNARK:<5.EXEC>EXECQU.MAC.10, 14-Aug-81 10:47:54 by GROUT
; UPD ID= 2299, SNARK:<5.EXEC>EXECQU.MAC.8, 6-Jul-81 14:47:27 by GROUT
; UPD ID= 2231, SNARK:<5.EXEC>EXECQU.MAC.6, 21-Jun-81 09:37:00 by ACARLSON
; UPD ID= 2212, SNARK:<5.EXEC>EXECQU.MAC.5, 18-Jun-81 11:04:21 by GROUT
;TCO 5.1374 - Make code check extensions in all cases for PRINT default actions
; UPD ID= 2068, SNARK:<5.EXEC>EXECQU.MAC.4, 22-May-81 13:19:24 by GROUT
;TCO 5.1343 - Make IPCF code flush buffers only if necessary
; UPD ID= 2009, SNARK:<5.EXEC>EXECQU.MAC.3, 15-May-81 13:59:25 by ACARLSON
;<ACARLSON>EXECQU.MAC.5, 15-May-81 13:58:14, EDIT BY ACARLSON
; Add another % to UETYPE instr so _ does not print
; UPD ID= 1956, SNARK:<5.EXEC>EXECQU.MAC.2, 6-May-81 15:06:45 by MURPHY
;DELETE DEADLINE AND CODE FOR IT
;PUT IPCF STUFF FROM SUBRS TO HERE
;SEARCH GALAXY UNV'S
; UPD ID= 955, SNARK:<5.EXEC>EXECQU.MAC.4, 24-Aug-80 21:11:26 by ZIMA
;TCO 5.1137 - fix "SET DEFAULT PLOT<return>" from blowing up.
; UPD ID= 538, SNARK:<5.EXEC>EXECQU.MAC.3, 20-May-80 15:46:37 by MURPHY
;<4.1.EXEC>EXECQU.MAC.4, 15-Apr-80 10:06:47, EDIT BY OSMAN
;Neaten up .CSO references
;<4.1.EXEC>EXECQU.MAC.3, 14-Feb-80 09:36:14, EDIT BY OSMAN
;tco 4.1.1080 - Fix MOD PR CMD/NOHEADER to not cause pushdown overflow
; UPD ID= 95, SNARK:<4.1.EXEC>EXECQU.MAC.2, 5-Dec-79 10:44:27 by OSMAN
;tco 4.1.1045 - Allow all filespec characters in jobnames for CANCEL and friends
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 1990.
; ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
; ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
; INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
; COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
; OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
; TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
; AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
; SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
;TOPS20 'EXECUTIVE' COMMAND LANGUAGE
SEARCH EXECDE
TTITLE EXECQU
GLXSCH ;SEARCH GALAXY UNV'S
;THIS FILE CONTAINS CODE TO IMPLEMENT COMMANDS WHICH COMMUNICATE
;WITH QUASAR, THE QUEUE SYSTEM..
;PUNCH CARDS
;PRINT
;SUBMIT
;PUNCH PAPER-TAPE
;INFORMATION
;CAUTION: DON'T CHANGE THE ORDER OF THE FOLLOWING DEFINITIONS OF X%...
;THEY ARE LOADED INTO P4 AND A TABLE IS INDEXED BY P4. GET IT?
;MACRO TO DEFINE X%... AND B%...
DEFINE DEFSM (NAME,VALUE)
< X%'NAME==VALUE
B%'NAME==1B<VALUE>
>
DEFSM CP,0 ;COMMANDS PUNCH CARDS
DEFSM PR,1 ;PRINT
DEFSM SU,2 ;SUBMIT
DEFSM TP,3 ;PUNCH PAPER-TAPE
DEFSM PL,4 ;PLOT
DEFSM MO,5 ;MOUNT (USED FOR INFO MOUNT)
DEFSM RE,6 ;RETRIEVE
DEFSM AR,7 ;ARCHIVE (NOT REALLY USED)
PR%LC==1 ;SYMBOL FOR /LOWERCASE
PR%UC==2 ;SYMBOL FOR /UPPERCASE
PR%ANY==3 ;/GENERIC
;MACRO FOR PRINTING SWITCH VALUES.
DEFINE PSWITCH (TEXT)
< ETYPE < /TEXT>
RET
>
;MACRO TO ALLOCATE LOCAL STORAGE. NEEDED SO VARIOUS COMMANDS CAN CALL
;COMMON ROUTINES WHICH REFERENCE THE STORAGE
FDBSIZ==.CMDEF ;SIZE OF COMND FDB
ISIZ==3 ;SIZE OF ITEM ON ARG STACK (NUMBER OF WORDS)
DEFINE PRISTG
<
TRVAR <JNGF,ANYS,SDF,ASYF,<FDBBLK,FDBSIZ>,<SCRLIM,EQLMSZ>,IQPT,QPT,QIDX,FSIZE,NEWJFN,PRIJFN,SAVEA,PRESF,FILSF,CSF,ODDPTR,KEYLVL> ;[7.1073]
>
;MACRO TO STORE VALUE IN A FIELD, AND THEN READ IT BACK TO MAKE SURE
;IT FITS, AND SKIPS IFF SO.
;THIS MACRO CLOBBERS "D"
DEFINE VERIFY(A,B,C)<
STOR A,C,B ;;STORE THE VALUE
LOAD D,C,B ;;GET WHAT REALLY GOT STORED
CAME A,D ;;MAKE SURE IT GOT SUCCESSFULLY STORED
>
;SIMILAR MACRO TO VERIFY LIMITS
DEFINE VERLIM(A,B,C)<
STOLIM A,B,C
GETLIM D,B,C
CAME A,D
>
;FLAGS USED IN Z
INFOF==1B0 ;ON IF DOING INFO
TPRES==1B2 ;ON IF /PRESERVE OR /DELETE GIVEN ON CURRENT SPEC
NPRES==1B3 ;ON IF /PRESERVE OR /DELETE GIVEN ON NEXT SPEC
TFILES==1B4 ;ON IF /FILE GIVEN ON CURRENT SPEC
NFILES==1B5 ;ON IF /FILE GIVEN ON NEXT SPEC
;SPECIAL BUFFER DEFINITIONS
EQ0==BUF1 ;HOLDS QUASAR REQUEST BLOCK
EQGLOB==BUF2 ;GLOBAL VALUES FOR REQUEST BLOCK DURING SUBMIT
GLBBLK==EQGLOB+EQHSIZ ;PRINT COMMAND GLOBAL BLOCK
FILMAX==FDXSIZ-1 ;MAXIMUM NUMBER OF WORDS FILESPEC MAY TAKE UP
;ALLOWS FOR MANY ^V'S, AND OBNOXIOUSLY LONG
;NAMES
LSTBLK==BUF3 ;HOLDS VALUES DURING EXPANSION OF WILDCARDS
LOGNAM==EQHSIZ+FPXSIZ+1+FILMAX+FPXSIZ+1 ;OFFSET INTO PAGE TO WHERE LOG FILE NAME GOES
LOGFIL==EQHSIZ+FPXSIZ+1+FILMAX ;OFFSET FOR LOG FILE BLOCK
;INSTRUCTION FOR OBTAINING OBJECT TYPE
GOTYP: MOVE A,[EXP .OTCDP,.OTLPT,.OTBAT,.OTPTP,.OTPLT](P4) ;GET REQUEST TYPE
;FDB's for COMND JSYS for reading command lines.
;Notice that in general one may not specify a file specific switch after a
;comma (hence the additional tables and work), since there is no easy way
;to get such switches to apply to the file specs which FOLLOW the switch.
;It is very hard to implement the semi-global switch concept, so to avoid
;confusion, we simply forbid the placement of a file-specific switch directly
;after a comma.
;COMMA OR FILE SPEC FDB...
CORFIL: FLDDB. .CMCMA,,,,,FLONLY ;COMMA IS OPTIONAL FROM HERE
FLONLY: FLDDB. .CMFIL,CM%SDH,,<File specification> ;FILESPEC
;FDB'S FOR COMND JSYS FOR READING COMMAND LINES
;PRINT...
PRFDB: FLDDB. .CMCFM,,,,,[ ;END OF LINE ONE POSSIBILITY
FLDDB. .CMSWI,,$JOBSW,<Job switch,>,,[ ;JOB SWITCH
FLDDB. .CMSWI,,$FILSW,<File switch,>,,CORFIL ;FILE SWITCH
]] ;COMMA OR FILE TOO
;PRINT AFTER A COMMA SEEN
PRFDBC: FLDDB. .CMSWI,,$JOBSC,<Jobswitch,>,,FLONLY ;ONLY JOB SWITCH
;OR FILE SPEC AFTER COMMA
;SUBMIT...
SUFDB: FLDDB. .CMCFM,,,,,[ ;END OF LINE ONE POSSIBILITY
FLDDB. .CMSWI,,$SUBSW,<Switch,>,,CORFIL ;SWITCH
] ;COMMA OR FILE TOO
;SUBMIT AFTER COMMA SEEN...
SUFDBC: FLDDB. .CMSWI,,$SUBSC,<Switch,>,,FLONLY ;ONLY SWITCH
;OR FILE SPEC AFTER COMMA
;PUNCH CARDS...
CPFDB: FLDDB. .CMCFM,,,,,[ ;END OF LINE ONE POSSIBILITY
FLDDB. .CMSWI,,$CPJOB,<Job switch,>,,[ ;JOB SWITCH
FLDDB. .CMSWI,,$CPFIL,<File switch,>,,CORFIL ;FILE SWITCH
]] ;COMMA OR FILE TOO
;PUNCH CARDS AFTER COMMA SEEN...
CPFDBC: FLDDB. .CMSWI,,$CPJOC,<Job switch,>,,FLONLY ;ONLY JOB SWITCH
;OR FILE SPEC AFTER COMMA
;PLOT
PLFDB: FLDDB. .CMCFM,,,,,[ ;END OF LINE ONE POSSIBILITY
FLDDB. .CMSWI,,$PLJOB,<Job switch,>,,[ ;JOB SWITCH
FLDDB. .CMSWI,,$PLFIL,<File switch,>,,CORFIL ;FILE SWITCH
]] ;COMMA OR FILE TOO
;PLOT AFTER COMMA SEEN...
PLFDBC: FLDDB. .CMSWI,,$PLJOC,<Job switch,>,,FLONLY ;ONLY JOB SWITCH
;OR FILE SPEC AFTER COMMA
;PUNCH PAPER-TAPE...
TPFDB: FLDDB. .CMCFM,,,,,[ ;END OF LINE ONE POSSIBILITY
FLDDB. .CMSWI,,$TPJOB,<Job switch,>,,[ ;JOB SWITCH
FLDDB. .CMSWI,,$TPFIL,<File switch,>,,CORFIL ;FILE SWITCH
]] ;COMMA OR FILE TOO
;PUNCH PAPER-TAPE AFTER COMMA SEEN...
TPFDBC: FLDDB. .CMSWI,,$TPJOC,<Job switch,>,,FLONLY ;ONLY JOB SWITCH
;OR FILE SPEC AFTER COMMA
;COMND JSYS FDB'S FOR SET DEFAULT COMMANDS FOR QUEUE-CLASS COMMANDS,
;PUNCH CARD DEFAULTS
SDCFDB: FLDDB. .CMCFM,,,,,[ ;END OF LINE ONE POSSIBILITY
FLDDB. .CMSWI,,$CPJOB,<Job switch,>,,[ ;JOB SWITCH
FLDDB. .CMSWI,,$CPFIL,<File switch,>,,]] ;FILE SWITCH
;PRINT DEFAULTS
SDPFDB: FLDDB. .CMCFM,,,,,[ ;END OF LINE ONE POSSIBILITY
FLDDB. .CMSWI,,$JOBSW,<Job switch,>,,[ ;JOB SWITCH
FLDDB. .CMSWI,,$FILSW,<File switch,>,,]] ;FILE SWITCH
;SUBMIT DEFAULTS
SDSFDB: FLDDB. .CMCFM,,,,,[ ;END OF LINE ONE POSSIBILITY
FLDDB. .CMSWI,,$SUBSW,<Switch,>,,] ;SWITCH
;PUNCH PAPER-TAPE DEFAULTS
SDTFDB: FLDDB. .CMCFM,,,,,[ ;END OF LINE ONE POSSIBILITY
FLDDB. .CMSWI,,$TPJOB,<Job switch,>,,[ ;JOB SWITCH
FLDDB. .CMSWI,,$TPFIL,<File switch,>,,]] ;FILE SWITCH
;PLOT DEFAULTS
SDPLFB: FLDDB. .CMCFM,,,,,[ ;END OF LINE ONE POSSIBILITY
FLDDB. .CMSWI,,$PLJOB,<Job switch,>,,[ ;JOB SWITCH
FLDDB. .CMSWI,,$PLFIL,<File switch,>,,]] ;FILE SWITCH
;AC USAGE
; Q1 FILE PARAMETER BLOCK ADDRESS (LOCAL FILE OR GLOBAL BLOCK)
; P1 REQUEST HEADER ADDRESS (GLOBAL OR LOCAL IF SUBMIT COMMAND)
; P2 FILE PARAMETER ADDRESS
;PRINT (FILE) /SW/SW FILE /SW/SW/SW FILE FILE,FILE ....
;SUBMIT " " "
;SWITCHES MAY APPEAR ANYWHERE ON THE LINE. THERE ARE TWO TYPES OF
;SWITCHES, FILE SWITCHES AND JOB SWITCHES. FILE SWITCHES APPEARING
;BEFORE ANY FILE HAS BEEN ENTERED APPLY TO ALL FILES IN THE COMMAND.
;THAT IS, THEY ARE GLOBAL FILE SWITCHES. ANY FILE SWITCH ENTERED
;SUBSEQUENT TO SOME FILESPEC ONLY APPLIES TO THE MOST RECENT FILE SPEC
;BEFORE IT ON THE LINE. JOB SWITCHES MEAN THE SAME ANYWHERE ON THE
;LINE.
;FOR SUBMIT COMMAND, ALL SWITCHES ARE "FILE" SWITCHES.
.SUBMI::NOISE <BATCH JOB>
MOVEI P4,X%SU ;1 FOR SUBMIT, 0 FOR PRINT
JRST X2
;QUEUE UP FILES FOR PLOTTER
.PLOT:: MOVEI P4,X%PL ;SAY THIS IS "PLOT"
JRST X1 ;FINISH LIKE THE REST OF 'EM
;PUNCH CARDS/PAPER-TAPE
.PUNCH::NOISE (ONTO)
KEYWD $PDEV
0
CMERRX <Invalid selection for PUNCH>
MOVE P4,P3 ;GET TYPE OF THING BEING PUNCHED
JRST X1
;TABLE OF SELECTIONS FOR PUNCH
$PDEV: TABLE
T CARDS,,X%CP
T PAPER-TAPE,,X%TP
TEND
.PRINT::MOVEI P4,X%PR
X1: NOISE (FILES)
X2: PRISTG ;ALLOCATE LOCAL STORAGE
SETZM ODDPTR ;[7.1073] Init "odd printer" (arb. queue) flag
SETZM KEYLVL ;[7.1073] Init counter for levels of tracing aliases
SETZM CSF ;NO COMMA SEEN YET
SETZM PRESF ;NO /PRESERVE OR /DELETE SEEN YET
SETZM FILSF ;NO /FILE:<ANY> SEEN YET
SETZM SDF ;NOT SETTING DEFAULTS
SETZM ASYF ;SAY NOTHING SEEN YET
SETZRO PR%LFT,PRIFLG ;[4417]Clear the left half
SETONE PR%PRI,PRIFLG ;[4417]But we are doing a PRINT
SETZM RPQUE ;[4417]No remote queue name yet
SETZM RPNODE ; [7.1073] Init "alias node seen" flag
SETZM DSTNOD ;[7.1073] Init "destination-node seen" flag
TLZ Z,F1 ;FILE FLAG, COMES ON IF WE'VE SEEN A FILESPEC
CALL PRINI ;INITIALIZE BLOCKS
PR1: DEXTX <CTL> ;DEFAULT EXTENSION FOR BATCH FILES
CAIE P4,X%SU ;DON'T SET THIS DEFAULT UNLESS "SUBMIT"
DEXTX <> ;NO DEFAULT EXTENSION FOR PRINT REQUESTS
MOVX A,GJ%OLD+GJ%IFG+GJ%FLG ;ALLOW *'S AND RETURN FLAGS,FILE MUST EXIST
MOVEM A,CJFNBK+.GJGEN ;STORE FLAGS
MOVE B,[CPFDB
PRFDB
SUFDB
TPFDB
PLFDB](P4) ;CORRECT FDB FOR PARTICUAR COMMAND
SKIPE CSF ;JUST SEEN A COMMA?
MOVE B,[CPFDBC ;YES, TREAT SPECIAL
PRFDBC
SUFDBC
TPFDBC
PLFDBC](P4) ;CORRECT FDB TO FOLLOW COMMA
TLNN Z,F1 ;HAVE WE SEEN A FILESPEC YET?
SKIPE CSF ;AND NOT JUST SEEN A COMMA?
CAIA
HRRZ B,(B) ;YES, SO CONFIRMATION INVALID HERE
CAIE P4,X%SU ;NO SPOOLED-OUTPUT FOR SUBMIT
SKIPE ASYF ;ANYTHING SEEN YET?
JRST YESSS ;YES, SOMETHING SEEN
HRLI A,[FLDDB. .CMSWI,CM%SDH,[ 1,,1
T SPOOLED-OUTPUT,,.RSO],</SPOOLED-OUTPUT>]
HRRI A,FDBBLK ;PREPARE TO SET UP EXTENDED FDB
BLT A,.CMHLP+FDBBLK ;SET IT UP
STOR B,CM%LST,FDBBLK ;STORE REST OF FDB'S AS REST OF CHAIN
MOVEI B,FDBBLK ;SET UP B AS POINTER TO EXTENDED FDB
YESSS: CALL FLDSKP ;SEE WHAT THE USER TYPED
JRST BADQ ;BAD COMMAND
SETOM ASYF ;SAY SOMETHING SEEN
LDB D,[331100,,.CMFNP(C)] ;FIND OUT WHAT GOT TYPED
CAIN D,.CMCMA ;COMMA?
JRST [SETOM CSF ;SAY COMMA SEEN
JRST PR1] ;AND PROCEED
CAIN D,.CMCFM ;END OF LINE?
JRST PRIEOL ;YES
CAIN D,.CMFIL ;A FILE?
JRST PRIFIL ;YES
JRST PRIFS ;NONE OF THE ABOVE, MUST BE A SWITCH
BADQ: XCT [ CMERRX <Invalid PUNCH CARDS command>
CMERRX <Invalid PRINT command>
CMERRX <Invalid SUBMIT command>
CMERRX <Invalid PUNCH PAPER-TAPE command>
CMERRX <Invalid PLOT command>](P4)
;A FILE SWITCH HAS BEEN TYPED. IF NO FILENAMES HAVE BEEN TYPED, THIS
;SWITCH SHOULD BE CONSIDERED GLOBAL. OTHERWISE, THIS SWITCH ONLY
;APPLIES TO THE LAST FILE SEEN.
PRIFS: CALL GETKEY ;GET SWITCH INFO
CAIN P3,.RSO ;RELEASING SPOOLED-OUTPUT?
JRST .RSO ;YES, GO DO IT
CALL (P3) ;NO, EXECUTE THE SWITCH
JRST PR1 ;GO BACK FOR MORE FIELDS
;FILESPEC SEEN.
PRIFIL: SETZM CSF ;CLEAR THE COMMA SEEN FLAG AFTER FILE SEEN
MOVE A,B
TLON Z,F1 ;IS THIS THE FIRST FILE?
SKIPN D,DPPT ;AND ARE THERE ANY DEFAULTS TO SCAN?
JRST NOTFST ;NO, NOT THE FIRST OR NO DEFAULTS
MOVE D,[IOWD QSLEN,DPSTK-ISIZ+1] ;YES, PROCESS GLOBAL SWITCHES
PRIDEF: ADJSP D,ISIZ ;STEP TO NEXT POTENTIAL DEFAULT
CAML D,DPPT ;LAST BLOCK PROCESSED?
JRST NOTFST ;YES, GO LOOK AT THE FILE
HRRZ B,(D) ;GET DISPATCH ADDRESS
CAIN B,FIL2 ;IS THIS A /FILE:<ANY> SWITCH?
SETOM FILSF ;YES, RAISE THE FLAG
CAIN B,DEL2 ;IS IT A /PRESERVE OR /DELETE SWITCH?
SETOM PRESF ;YES, RAISE THAT FLAG
JRST PRIDEF ;PROCESS NEXT SWITCH...
NOTFST: MOVE B,A
MOVEI A,FIL22 ;DON'T REALLY PROCESS IT UNTIL PASS 2
MOVEM B,NEWJFN ;SAVE JFN
CALL STOR1
JRST PR1
FIL22: MOVEI P1,EQ0 ;WAS POINTING AT GLOBAL BLOCK IF SUBMIT COMMAND
MOVEM B,NEWJFN ;SAVE THE NEW JFN
SKIPE PRIJFN ;ANY PREVIOUS FILESPEC?
CALL FILDO ;FINISH LAST FILE
MOVE Q1,P2 ;FROM NOW ON ALL SWITCHES ARE LOCAL
MOVE A,NEWJFN
MOVEM A,PRIJFN ;ESTABLISH NEW JFN AS CURRENT ONE
CAIN P4,X%SU ;DOING SUBMIT?
JRST SUBGLB ;YES, GO MOVE ENTIRE PAGE
HRLI A,GLBBLK ;GET ADDRESS OF GLOBAL INFO BLOCK
HRR A,P2 ;AND ADDRESS OF NEW FILE PARAMETER BLOCK
BLT A,FPXSIZ-1(P2) ;MOVE GLOBAL PARAMETERS INTO NEW BLOCK
CAIE P4,X%PR ;DOING A PRINT?
JRST FIL0 ;NOPE, SKIP EXTENSION TESTING
MOVE A,P2 ;MOVE IN ADDRESS OF AREA TO CHANGE
CALL CHKEXT ;CHECK EXTENSION OF FILE
FIL0: CALL FILBLK ;FILL IN INFO FOR THIS FILE
RET ;WAIT FOR SWITCHES BEFORE MORE PROCESSING
SUBGLB: MOVE A,[EQGLOB,,EQ0] ;MOVE FROM GLOBAL AREA INTO LOCAL AREA
BLT A,EQ0+777
JRST FIL0 ;REJOIN COMMON CODE
;ROUTINE TO FINISH LAST CURRENT FILESPEC. MUST BE CALLED BEFORE NEW
;FILSPEC CAN BE PROCESSED, BUT NOT EARLIER, SINCE SWITCHES SYNTACTICALLY
;FOLLOW FILESPECS.
FILDO: CAIN P4,X%SU ;SUBMIT?
JRST [MOVE A,[EQ0,,LSTBLK] ;YES
BLT A,LSTBLK+777 ;REMEMBER ENTIRE PAGE
JRST FILDLB] ;GO FILL IN LOG FILE BLOCK
HRLI A,(P2)
HRRI A,LSTBLK
BLT A,LSTBLK+FPXSIZ-1 ;REMEMBER FILE PARAMETER'S IN CASE *'S
SKIPE PRESF ;IS THERE A GLOBAL /PRESERVE OR /DELETE?
JRST FILDF0 ;YES, SET TPRES
TXZN Z,NPRES ;CLEAR AND CHECK NPRES
TXZA Z,TPRES ;NPRES WAS CLEAR, CLEAR TPRES
FILDF0: TXO Z,TPRES ;NPRES OR GLOBAL SW WAS SET, SET TPRES
SKIPE FILSF ;IS THERE A GLOBAL /FILE?
JRST FILDF1 ;YES, SET TFILES
TXZN Z,NFILES ;CLEAR AND CHECK NFILES
TXZA Z,TFILES ;NFILES WAS CLEAR, CLEAR TFILES
FILDF1: TXO Z,TFILES ;NFILES OR GLOBAL SW WAS SET, SET TFILES
PRF1: CAIN P4,X%SU ;DOING SUBMIT?
JRST FILDLB ;YES, GO FILL IN LOG FILE BLOCK
LOAD A,FP.FCY,.FPINF(P2) ;GET NUMBER OF COPIES WANTED FOR THIS FILE
IMUL A,FSIZE ;MULTIPLY BY FILE SIZE TO GET REQUEST SIZE FOR THIS FILE
GETLIM B,.EQLIM(P1),NBLK
ADD B,A ;ADD IN THIS FILE'S SIZE TO GRAND TOTAL
VERLIM B,.EQLIM(P1),NBLK ;PUT BACK TOTAL MAKING SURE IT FITS
ERROR <Too many file pages being requested at once>
FILNJF: CALL NEWBLK ;GET NEW PARAMETER BLOCK FOR THE NEXT FILE
MOVE A,PRIJFN
CALL GNJFS ;SEE IF ANY MORE FILES ASSOCIATED WITH THIS JFN
JRST [TXZ Z, TFILES ;IF NO MORE, CLEAR TFILES
RET] ;ON GNJFN FAILURE, ASSUME NO MORE FILES FOR THIS JFN
TXNN A,GN%EXT ;DID EXTENSION CHANGE?
JRST FILFPR ;NO, SKIP DEFAULT EXTENSION CHECKING
CAIE P4,X%PR ;ARE WE DOING A PRINT?
JRST FILFPR ;NOPE, SKIP EXTENSION CHECKING
JXO Z,TPRES!TFILES,FILFPR ;IF BOTH FLAGS ON, SKIP CHECKING
FILCEX: MOVE A,P2 ;MOVE IN ADDRESS OF AREA TO CHANGE
CALL CHKEXT ;CHECK EXTENSION OF FILE
HRLI A,(P2) ;STORE FILE PARAMETERS IN LSTBLK
HRRI A,LSTBLK
BLT A,LSTBLK+FPXSIZ-1
FILFPR: CALL FILBLK ;FILL IN PARAMETERS FOR THIS FILE
JRST PRF1 ;SEE IF MORE FILES ON THIS JFN
;FILL IN LOG FILE DATA
FILDLB: CALL SUBLOG ;FILL IN LOG FILE DATA
JRST FILNJF ;GO LOOK AT NEXT FILE (IF ANY)
SUBLOG: STKVAR <CONDN> ;HOLDS CONNECTED DIRECTORY NUMBER
CALL NEWBLK ;ALLOCATE FILE BLOCK FOR LOG FILE NAME
SKIPE LOGNAM(P1) ;LOG FILE NAME ALREADY SPECIFIED?
JRST FILBK1 ;YES
GJINF ;GET CONNECTED DIRECTORY NUMBER
MOVEM B,CONDN ;SAVE IT
CALL GETFP ;GET POINTER TO WHERE FILENAME GOES
MOVE B,CONDN ;GET CONNECTED DIRECTORY
DIRST ;LOG FILE GOES IN THAT DIRECTORY BY DEFAULT
ERCAL JERR ;SHOULDN'T FAIL
HRRZ B,PRIJFN ;USE CONTROL FILE AS SOURCE
MOVX C,1B8+JS%PAF ;GET NAME
JFNS ;GET STRING FOR BEGINNING OF NAME
HRROI B,[ASCIZ /.LOG/] ;STANDARD EXTENSION IS .LOG
MOVEI C,0 ;PUT NULL AFTER IT
SOUT ;FINISH MAKING FILESPEC
JRST FILBK1 ;JOIN COMMON CODE TO FINISH FILEBLOCK
;ROUTINE WHICH FILES IN PARAMETERS FOR FILE ASSOCIATED WITH JFN IN PRIJFN
FILBLK: CALL GETFP ;GET POINTER TO WHERE STRING GOES
MOVX C,1B2+1B5+1B8+1B11+1B14+JS%PAF ;WE WANT COMPLETE FILESPEC, PUNCTUATED
HRRZ B,PRIJFN ;GET JFN
JFNS ;STORE THE NAME
FILBK1: SUBI A,FPXSIZ+.FDFIL-2(P2);CALCULATE NUMBER OF WORDS USED FOR FILESPEC
AOJ A, ;LEAVE ROOM FOR ONE LENGTH WORD
CAIN P4,X%SU
MOVEI A,FILMAX+1 ;FOR SUBMIT, FILESPEC AREA IS FIXED LENGTH
STOR A,FD.LEN,FPXSIZ+.FDLEN(P2) ;REMEMBER LENGTH OF FILENAME
ADDI A,FPXSIZ ;GET TOTAL SIZE FOR THIS FILE
LOAD B,MS.CNT,.MSTYP(P1) ;GET OLD MESSAGE LENGTH
ADD B,A ;GET INCREASED LENGTH DUE TO NEW FILE
STOR B,MS.CNT,.MSTYP(P1) ;STORE NEW LENGTH
LOAD A,EQ.NUM,.EQSPC(P1) ;GET NUMBER OF FILES IN REQUEST
AOJ A, ;COUNT THE NEW FILE
STOR A,EQ.NUM,.EQSPC(P1) ;STORE NEW FILE COUNT
CAIN P4,X%SU ;SUBMIT COMMAND?
JRST NOFDB ;YES, DON'T GET SIZE OF FILE
HRRZ A,PRIJFN ;GET THE JFN AGAIN
MOVE B,[1,,.FBBYV] ;FILE SIZE IN PAGES
MOVEI C,C ;FILE SIZE IN PAGES
GTFDB ;READ THE FILE INFO
ERJMP FILBKE ;ERROR
HRRZM C,FSIZE ;STORE PAGE COUNT
NOFDB: RET
FILBKE: HRRZ A,PRIJFN
ETYPE <%%Can't get file size for %1S - %?%%_>
SETZB C,FSIZE ;USE 0 SIZE
RET
;ROUTINE TO PUT POINTER IN A TO WHERE FILENAME STRINGS SHOULD
;GO IN QUASAR REQUEST BLOCK
GETFP: HRROI A,FPXSIZ+.FDFIL(P2) ;GET ADDRESS OF WHERE NAME IS TO BE STORED
RET
;ROUTINE TO SET UP P2 TO POINT AT A NEW FILE PARAMETER BLOCK. IF
;THIS NEW BLOCK IS TOO CLOSE TO THE END OF A PAGE, THE CURRENT PAGE
;IS SENT OFF TO QUASAR, AND A NEW ONE STARTED.
NEWBLK: LOAD A,FD.LEN,FPXSIZ+.FDLEN(P2) ;GET SPACE USED FOR LAST FILESPEC
ADDI P2,FPXSIZ(A) ;NOT FIRST FILE, LEAVE ROOM FOR PARAMETER AREA
CAIE P4,X%SU ;SUBMIT?
JRST NOTSUB ;YES, ONLY SINGLE FILE CAN BE SENT AT A TIME
LOAD A,EQ.NUM,.EQSPC(P1) ;GET NUMBER OF FILES SO FAR
CAIN A,2 ;SUBMIT COMMAND. DO WE HAVE EXACTLY 2 FILES?
JRST NEW1 ;YES, SO SHIP THE PAIR OFF TO QUASAR
NOTSUB: MOVEI A,100+FPXSIZ(P2) ;GET WORST CASE LAST ADDRESS OF NEW PARAMETER BLOCK
CAIL A,1000(P1) ;BEYOND END OF REQUEST BLOCK?
NEW1: CALL SHPOFF ;YES, SO SEND THIS ONE TO MAKE MORE ROOM
HRLI A,LSTBLK ;GET ADDRESS OF LAST FILEBLOCK
CAIN P4,X%SU ;SUBMIT?
JRST NEW2 ;YES, COPY ENTIRE PAGE
HRR A,P2
BLT A,FPXSIZ-1(P2) ;WHEN EXPANDING *'S, USE SAME PARAMETERS FOR EACH FILE
RET
NEW2: LOAD B,EQ.NUM,.EQSPC(P1) ;GET NUMBER OF FILES SO FAR IN REQUEST
CAIE B,0 ;DID SUBMIT REQUEST JUST GET SENT?
RET ;NOT YET, SO DON'T RESET BLOCK YET
HRRI A,EQ0
BLT A,EQ0+777
MOVEI A,0
STOR A,EQ.NUM,.EQSPC(P1) ;CLEAR NUMBER OF FILES
MOVEI A,EQHSIZ ;LENGTH OF MESSAGE IS EQHSIZ
STOR A,MS.CNT,(P1) ;GETS INCREMENTED AS WE ADD FILESPECS TO REQUEST
RET
SHPOFF: LOAD A,EQ.NUM,.EQSPC(P1) ;GET NUMBER OF FILES IN REQUEST
JUMPE A,R ;DON'T SEND BLOCK IF NO FILES IN REQUEST
MOVE A,[EQ0,,IPCFP] ;MOVE REQUEST BLOCK
BLT A,IPCFP+777 ;INTO PAGE FOR IPCF SEND
CALL QUASND ;SEND TO QUASAR AND PRINT RESPONSE
MOVEI P2,EQHSIZ(P1) ;RESET FILE PARAMETER POINTER
MOVEI A,0
STOLIM A,.EQLIM(P1),NBLK ;RESET PAGE COUNTER
STOR A,EQ.NUM,.EQSPC(P1) ;CLEAR NUMBER OF FILES
MOVEI A,EQHSIZ ;LENGTH OF MESSAGE IS EQHSIZ
STOR A,MS.CNT,(P1) ;GETS INCREMENTED AS WE ADD FILESPECS TO REQUEST
RET
;ROUTINE TO SET DEFAULT SWITCHES FOR FILES WITH CERTAIN EXTENSIONS
;(.LST, .DAT)
CHKEXT: STKVAR <CNGEAR>
MOVEM A,CNGEAR ;STORE AREA TO CHANGE
HRRZ B,PRIJFN ;GET JFN
MOVX C,1B11 ;WE WANT THE EXTENSION
MOVE A,CSBUFP ;WRITE IT INTO FREE SPACE
JFNS ;GET EXTENSION
TXNN Z,TPRES ;IS /PRESERVE IN EFFECT?
SKIPE PRESF
JRST TRYDAT ;YES, SKIP CHECK (A IS NON-0)
MOVE A,CSBUFP ;
HRROI B,[ASCIZ /LST/] ;SEE IF EXTENSION IS "LST"
STCMP
MOVE B,CNGEAR ;IF IT IS, STORE "DELETE", ELSE STORE
JUMPE A,.+2 ;"PRESERVE"
TDZA C,C
MOVEI C,1
STOR C,FP.DEL,.FPINF(B) ;STORE NEW DEFAULT
TRYDAT: TXNN Z,TFILES ;IS /FILE SWITCH IN EFFECT?
SKIPE FILSF
RET ;YES, LEAVE
JUMPE A,LSTSEN ;IF WE SAW "LST", IT'S NOT "DAT"
MOVE A,CSBUFP ;GET EXTENSION AGAIN
HRROI B,[ASCIZ /DAT/] ;SEE IF EXTENSION IS "DAT"
STCMP
MOVE B,CNGEAR
JUMPE A,FORSEN ;FILE IS FORTRAN IF "DAT" SEEN
LSTSEN: HRRZ A,PRIJFN ;GET THE JFN AGAIN
MOVE B,[1,,.FBCTL] ;GET FLAG WORD
MOVEI C,C ;IN C
GTFDB ;READ THE FILE INFO
ERCAL FILCT1 ;ERROR
MOVE B,CNGEAR ;POINT TO MSG BLOCK AGAIN
TXNN C,FB%FOR ;FORTRAN DATA FILE?
TDZA C,C ;NO. IT'S ASCII
FORSEN: MOVEI C,.FPFFO ;SPECIFY FORTRAN FILE
STOR C,FP.FFF,.FPINF(B) ;STORE INFORMATION AWAY
RET ;GO BACK
FILCT1: HRRZ A,PRIJFN
ETYPE <%%Can't get FDB flag word for %1S - %?%%_>
MOVEI C,0 ;USE 0 FLAGS
RET
;END OF LINE SEEN. SHIP THE BLOCK OFF TO QUASAR, GET MESSAGE BACK,
;TYPE IT, CLEAN UP, AND RETURN.
PRIEOL: TXZ Z,INFOF ;SAY NOT DOING INFO
CALL GROVEL ;PROCESS ALL THE ARGUMENTS
CALL FILDO ;FINISH LAST FILESPEC
CALL SHPOFF ;SHIP OFF THE LAST BLOCK
SETZRO PR%LFT,PRIFLG ;[4417]Clear the left half
CALLRET UNMAP ;CLEAN UP AND RETURN
;THIS ROUTINE GETS EXECUTED AFTER END OF LINE SEEN TO DO THE ACTUAL
;EXECUTING OF THE QUEUE-CLASS COMMAND. THE REASON WE CAN'T EXECUTE AS WE
;GO ALONG IS THAT IF THINGS LIKE *.* ARE TYPED, THEY MAY TAKE MORE
;THAN ONE IPCF MESSAGE TO HANDLE ALL OF THEM, BUT SENDING THE IPCF
;MESSAGES OFF IMMEDIATELY WOULD CAUSE THE USER'S COMMAND TO START
;EXECUTING BEFORE HE TYPES CONFIRMATION, SO THAT HE MAY TYPE ^C OR
;^U, EXPECTING TO CANCEL THE COMMAND, AND SOME FILES MAY HAVE ALREADY
;BEEN SUBMITTED!
GROVEL: STKVAR <CURPTR> ;HOLDS END OF ARG LIST
MOVE A,PRIFLG ;[4417]Get PRINT command flag
TXNN A,PR%PRI ;[4417]Are we doing a PRINT command
IFSKP. ;[4417]Yes,
SETONE PR%DEF,PRIFLG ;[4417]then say we are filling in defaults
ENDIF. ;[4417]
MOVE A,QPT ;GET POINTER TO END OF ARG LIST
MOVEM A,CURPTR ;REMEMBER WHERE IT ENDS
TLZ Z,F1 ;NO FILESPEC SEEN YET
MOVEI Q1,GLBBLK ;SWITCHES GLOBAL UNTIL FILESPEC SEEN
CAIN P4,X%SU
MOVEI P1,EQGLOB ;FOR SUBMIT, P1 FIRST POINTS TO GLOBAL PAGE
CALL GRVDEF ;GROVEL THROUGH THE DEFAULTS
MOVE A,CURPTR
MOVEM A,QPT ;SET END OF CURRENT ARGS
MOVE Q2,IQPT ;GET POINTER TO TOP OF LIST
CALL GROVEX ;[4417]GROVEL THROUGH REAL ARGS
MOVE A,PRIFLG ;[4417]Get the PRINT flag
TXNE A,PR%DER ;[4417]Any errors?
ERROR <Error detected while processing DEFAULT printer> ;[4417]Yes
RET ;[4417]
;ROUTINE TO GROVEL THROUGH THE DEFAULTS
GRVDEF: MOVE Q2,[IOWD QSLEN,DCSTK
IOWD QSLEN,DPSTK
IOWD QSLEN,DSSTK
IOWD QSLEN,DTSTK
IOWD QSLEN,DPLSTK](P4) ;GET CORRECT DEFAULT POINTER
MOVE A,@[DCPT
DPPT
DSPT
DTPT
DPLPT](P4) ;GET POINTER TO END OF LIST
MOVEM A,QPT ;REMEMBER WHERE END OF DEFAULT LIST IS
IFE. A ;[4417]Any defaults?
SETZRO PR%DEF,PRIFLG ;[4417]No, all done clear doing default flag
RET ;[4417]and return
ENDIF. ;[4417]
GROVEX: ADJSP Q2,1-ISIZ ;SO FIRST INCREMENT GETS TO BEGINNING
GRV1: ADJSP Q2,ISIZ ;POINT TO NEXT ENTRY
CAMG Q2,QPT ;[4417]STILL IN THE STACK ?
IFSKP. ;[4417]No
SETZRO PR%DEF,PRIFLG ;[4417]All done clear doing default flag
RET ;[4417]Nope-Go away
ENDIF. ;[4417]
DMOVE A,(Q2) ;ADDRESSES IN A, DATA IN B
MOVE C,2(Q2) ;SECOND WORD OF DATA IN C
TXNE Z,INFOF ;DOING INFO?
MOVSS A ;YES, GET INFO ADDRESS
HRRZ A,A ;KEEP ONLY ADDRESS PART
CALL (A) ;PROCESS THE DATA
JRST GRV1 ;TRY AGAIN
;ROUTINE TO STORE PARSED DATA ON ARG STACK
STOR1: STKVAR <DA,<DDATA,2>,DPTR>
SKIPN SDF ;ARE WE SETTING DEFAULT?
JRST STOR0 ;NO GO USUAL WAY
TXNN Z,SETDEF ;FIRST PASS ?
RET ;YES DO NOTHING
STOR0: MOVEM A,DA ;SAVE DISPATCH ADDRESSES
DMOVEM B,DDATA ;SAVE DATA
MOVE A,IQPT ;GET POINTER TO TOP OF LIST
SKIPN SDF ;SETTING DEFAULTS?
JRST STOR3 ;NO, SO DUPLICATES ALLOWED (LIKE 2 FILESPECS!)
STOR2: CAMN A,QPT ;SCANNED ENTIRE LIST?
JRST STOR3 ;YES
MOVE B,1(A) ;NO, GET DISPATCH ADDRESSES FOR AN ITEM ALREADY ON THE LIST
CAMN B,DA ;IS NEW SWITCH NEW VALUE FOR OLD SWITCH?
JRST STOR4 ;YES, GO RELEASE OLD SPACE USED AND PUT NEW ITEM IN
ADJSP A,ISIZ ;NO, SCAN REST OF LIST
JRST STOR2
STOR3: MOVE D,QPT ;GET POINTER
PUSH D,DA ;STORE DISPATCH ADDRESSES
ERCAL TMA ;TOO MANY ARGUMENTS
PUSH D,DDATA ;STORE FIRST WORD OF DATA
ERCAL TMA
PUSH D,1+DDATA ;STORE SECOND WORD OF DATA
ERCAL TMA
MOVEM D,QPT ;REMEMBER NEW VALUE OF POINTER
RET
TMA: ERROR <Too many filespecs or switches, break into several commands>
STOR4: MOVEM A,DPTR ;REMEMBER POINTER TO ITEM
CALL PIOFF ;^C WOULD BE EMBARRASSING BETWEEN RELEASING OLD SPACE AND STORING NEW ITEM!
MOVE A,DPTR ;DON'T ASSUME PIOFF SAVES TEMPS
MOVE B,2(A) ;GET POSSIBLE POINTER TO FREE SPACE
HRRZ A,DA ;GET DISPATCH ADDRESS OF OLD ITEM
CALL QRELFR ;RELEASE ANY FREE SPACE ITEM WAS TYING
MOVE A,DPTR ;RESTORE POINTER TO ITEM
DMOVE B,DDATA ;GET NEW DATA
DMOVEM B,2(A) ;REPLACE OLD DATA WITH IT
CALLRET PION ;^C IS OK NOW
;ROUTINE CALLED TO REMOVE ALL DEFAULTS FOR A COMMAND
;IT RELEASES ANY FREE SPACE THAT MAY HAVE BEEN TIED UP REMEMBER THE
;DEFAULTS.
;
;ACCEPTS: A/ ADDRESS OF STACK BEING CLEARED
; B/ ADDRESS OF STACK POINTER MARKING END OF STACK
REMDEF: STKVAR <STKPW,STKP>
SKIPN @B ;ANY STACK ESTABLISHED YET?
RET ;NO, NOTHING TO REMOVE!
SOJ A, ;MAKE BONA FIDE STACK POINTER TO START OF LIST
HRLI A,-QSLEN
ADJSP A,-ISIZ ;CAUSE FIRST INCREMENT TO GET TO FIRST SLOT
MOVEM A,STKPW ;REMEMBER OUR WORKING POINTER
MOVEM B,STKP ;REMEMBER ARGS
CALL PIOFF ;DON'T ALLOW ^C AFTER SPACE RELEASED BUT BEFORE STACK RESET!
REMD1: MOVE C,STKPW ;GET OUR WORKING POINTER
ADJSP C,ISIZ ;STEP TO NEXT SLOT TO DO (GUARANTEED NOT TO PDLOV)
MOVEM C,STKPW ;SAVE FOR NEXT TIME THROUGH
CAMN C,@STKP ;HAVE WE SCANNED ENTIRE LIST YET?
JRST REMD2 ;YES
HRRZ A,1(C) ;NO, GET DISPATCH ADDRESS OF ITEM ON STACK
MOVE B,2(C) ;GET CANDIDATE FOR BYTE POINTER TO SPACE TO BE REMOVED
CALL QRELFR ;CHECK FOR FREE SPACE FOR RETURNING
JRST REMD1 ;LOOP FOR REST OF ITEMS
REMD2: HRRZ A,STKP ;GET ADDRESS OF STACK POINTER
SETZM (A) ;CLEAR THE STACK POINTER
CALLRET PION ;ALLOW ^C AGAIN
;ROUTINE USED TO FREE UP FREE SPACE THAT WAS TIED UP BY SOME DEFAULT
;THAT IS BEING REMOVED
;
;ACCEPTS: A/ DISPATCH ADDRESS IDENTIFYING ITEM
; B/ POSSIBLE POINTER TO FREE SPACE
;
QRELFR: MOVE C,QFLST ;GET TOTAL LENGTH OF LIST
QRF1: SOJLE C,R ;ITEM NOT IN LIST IF COUNT RUNS OUT
CAME A,QFLST(C) ;FOUND ITEM IN TABLE?
JRST QRF1 ;NOT YET
MOVE A,B ;YES, GET POINTER TO STRING
CALLRET STREM ;FREE UP SPACE USED BY STRING AND RETURN
;TABLE LISTING DISPATCH ADDRESSES FOR ITEMS THAT TAKE UP PERMANENT FREE SPACE
QFLST: QFLEN ;FIRST ENTRY IS ENTIRE LENGTH OF TABLE
LFN2 ;ENTRY FOR DEFAULT LOG FILENAME STRING
ACC2 ;ACCOUNT STRING
QFLEN==.-QFLST
;LIST OF SWITCHES FOR PRINT, PUNCH CARDS, PUNCH PAPER-TAPE, SUBMIT
DEFINE SLIST
<
JOBS <TV ACCOUNT> ;CHARGE PARTICULAR ACCOUNT FOR THIS REQEST
JOBS <TV AFTER> ;PRINT AFTER THIS TIME
JOBS <TV ASSISTANCE>,B%SU ;DECLARE WHETHER JOB NEEDS ASSISTANCE OR NOT
JOBS <TV BATCH-LOG,,.WLOG>,B%SU ;SAY HOW TO WRITE LOG
FILS <TV BEGIN,,.PB>,B%PR ;BEGIN ON SPECIFIC PAGE
JOBS <TV BEGIN,,.SBEG>,B%SU ;BEGIN PROCESSING ON SPECIFIC LINE
JOBS <TV CARDS>,B%SU ;NUMBER OF CARDS JOB IS ALLOWED TO PRINT
JOBS <TV CHARACTERISTIC,,.CHAR>,B%PR ;[7.1073] FOR REMOTE PRINT FORMAT
JOBS <TV CONNECTED-DIRECTORY,,.BCON>,B%SU ;DIRECTORY TO CONNECT BATCH JOB TO
FILS <TV COPIES> ;HOW MANY COPIES
FILS <T DELETE>,,B%SU ;DELETE FILE AFTER PRINTING
JOBS <T DELETE>,B%SU
JOBS <TV DEPENDENCY-COUNT,,.DEPEN>,B%SU ;SPECIFY DEPENDENCY COUNT
JOBS <TV DESTINATION-NODE,,.NODE> ;WHICH NODE REQUEST IS DESTINED FOR, LOG FILE FOR SUBMIT
JOBS <TV FEET>,B%SU ;NUMBER OF FEET OF TAPE JOB IS ALLOWED TO PUNCH
FILS <TV FILE>,B%PR ;WHICH TYPE OF FILE IT IS
JOBS <TV FORMS>,,B%SU ;KIND OF PAPER TO USE
JOBS <T GENERIC>,,B%SU ;ANY UNIT
FILS <T HEADER>,,B%SU ;HEADER LINE FLAVOR
JOBS <TV JOBNAME,,.GOBNA> ;SPECIFY NON-DEFAULT JOBNAME
JOBS <TV LIMIT>,,B%SU ;NUMBER OF PAGES TO ALLOW TO BE PRINTED
JOBS <TV LOGDISPOSITION>,B%SU ;SPECIFY HOW TO DISPOSE OF LOG FILE
JOBS <TV LOGNAME,,.LFN>,B%SU ;SPECIFY NON-STANDARD LOG FILE NAME
JOBS <T LOWERCASE,,.LOWER>,B%PR ;PRINT FILE ONLY ON PRINTER WITH UPPER-LOWER CAPABILITY
JOBS <TV METERS>,B%TP ;PUNCH SO MANY METERS OF PAPER TAPE
FILS <TV MODE>,,B%SU ;SPECIFY FORMAT
FILS <T NOHEADER>,,B%SU
JOBS <TV NOTE>,,B%SU ;PUT NOTE ON OUTPUT
JOBS <TV NOTIFY> ;GET NOTIFICATION WHEN REQUEST IS PROCESSED
JOBS <TV OUTPUT>,B%SU ;CONTROL WHETHER LOG FILE GETS PRINTED
JOBS <TV PAGES>,B%SU ;SPECIFY PAGE LIMIT
FILS <T PRESERVE> ;DON'T DELETE FILE, DEFAULT UNLESS .LST
JOBS <TV PRIORITY> ;PRIORITY LEVEL OF REQUEST
JOBS <TV PROCESSING-NODE,,.PN>,B%SU ;NODE WHERE JOB SHOULD BE RUN
JOBS <T READER>,B%SU ;SPECIFY THAT CONTROL FILE IS A PSEUDO-CARD-DECK
JOBS <TV REMOTE-PRINTER,,.REMPR>,B%PR ;[7.1073] REMOTE PRINTER ON WHICH TO PRINT
FILS <TV REPORT>,B%PR ;PRINT REPORT WITH COBOL REPORT FILE
JOBS <TV RESTARTABLE>,B%SU ;ALLOW OR DISALLOW JOB TO BE RESTARTTED AFTER SYSTEM CRASH
JOBS <TV SEQUENCE> ;SEQUENCE NUMBER OF REQUEST
FILS <TV SPACING>,B%PR ;SINGLE OR DOUBLE SPACING
JOBS <TV TAG>,B%SU ;START PROCESSING AT THIS TAG
JOBS <TV TIME,,.QUTML>,B%SU ;SPECIFY EXECUTION TIME LIMIT FOR JOB
JOBS <TV TPLOT>,B%SU ;SPECIFY PLOTTER TIME JOB IS ALLOWED
JOBS <TV UNIQUE>,B%SU ;SPECIFY UNIQUENESS OF JOB (WHETHER CONCURRENCY ALLOWED OR NOT)
JOBS <TV UNIT>,,B%SU ;SPECIFIC UNIT NUMBER
JOBS <T UPPERCASE>,B%PR ;SEND TO UPPERCASE PRINTER
JOBS <TV USER,,.BUSER> ;SPECIAL OWNER FOR THIS REQUEST
>;;END OF DEFINE SLIST
DEFINE BUILDF
<
%%C==0 ;;1 FOR JOB SWITCHES
BUILD ;;DO THE WORK
>
DEFINE BUILDJ
<
%%C==1 ;;0 FOR FILE SWITCHES
BUILD ;;DO THE WORK
>
DEFINE BUILDO
<
%%C=-1 ;;-1 FOR ONLY JOB SWITCHES
BUILD
>
DEFINE BUILD
<
SLIST ;;BUILD SWITCH TABLE
>
;IN JOBS AND FILS, THE ARGS ARE:
;
; SWITCH ENTRY FOR TABLE
; COM OPTIONAL SET OF BITS, IF GIVEN DECLARE WHICH TABLES
; THAT SWITCH GOES IN
; NCOM LIKE COM, BUT TABLES SWITCH SHOULDN'T GO IN
DEFINE JOBS(SWITCH,COM,NCOM)
< DOSWX JOBS,COM,NCOM,<SWITCH> ;[7.1163]
>
DEFINE FILS(SWITCH,COM,NCOM)
< DOSWX FILS,COM,NCOM,<SWITCH> ;[7.1163]
>
DEFINE DOSWX (TYPE,COM,NCOM,SWITCH)
<
IFNB <COM>,<IFNB <NCOM>,<PRINTX ?Can't use COM with NCOM in TYPE>> ;[7.1163]
IFNB <COM>,<IFN COM&WUTCMD,<TYPE <SWITCH>>>
IFB <COM>,<IFNB <NCOM>,<IFE NCOM&WUTCMD,< ;[7.1163]
IFE %%C,<IFIDN <TYPE><FILS>,<SWITCH>> ;[7.1163]
IFN %%C,<IFIDN <TYPE><JOBS>,<SWITCH>> ;[7.1163]
>>> ;[7.1163]
IFB <COM>,<IFB <NCOM>,< ;[7.1163]
IFE %%C,<IFIDN <TYPE><FILS>,<SWITCH>> ;[7.1163]
IFN %%C,<IFIDN <TYPE><JOBS>,<SWITCH>> ;[7.1163]
>> ;[7.1163]
>
;TABLE OF FILE SWITCHES FOR PRINT COMMAND
WUTCMD==B%PR ;SPECIFY PRINT COMMAND
$FILSW: TABLE
BUILDF ;BUILD TABLE OF FILE SWITCHES
TEND
;TABLE OF JOB SWITCHES FOR PRINT COMMAND
$JOBSW: TABLE
BUILDJ ;BUILD JOB SWITCH TABLE
TEND
;TABLE OF JOB SWITCHES AFTER COMMA FOR PRINT COMMAND
$JOBSC: TABLE
BUILDO ;BUILD JOB SWITCH TABLE AFTER COMMA
TEND
;TABLE OF FILE SWITCHES FOR PUNCH CARDS COMMAND
WUTCMD==B%CP ;SPECIFY PUNCH CARDS COMMAND
$CPFIL: TABLE
BUILDF ;BUILD TABLE OF FILE SWITCHES
TEND
;TABLE OF JOB SWITCHES FOR PUNCH CARDS COMMAND
$CPJOB: TABLE
BUILDJ ;BUILD JOB SWITCH TABLE
TEND
;TABLE OF JOB SWITCHES AFTER COMMA FOR PUNCH CARD COMMAND
$CPJOC: TABLE
BUILDO ;BUILD JOB SWITCH TABLE AFTER COMMA
TEND
;FILE SWITCHES FOR PLOT COMMAND
WUTCMD==B%PL ;SAY PLOT
$PLFIL: TABLE
BUILDF
TEND
;JOB SWITCHES FOR PLOT
$PLJOB: TABLE
BUILDJ
TEND
;TABLE OF JOB SWITCHES AFTER COMMA FOR PLOT COMMAND
$PLJOC: TABLE
BUILDO ;BUILD JOB SWITCH TABLE AFTER COMMA
TEND
;TABLE OF FILE SWITCHES FOR PUNCH PAPER-TAPE COMMAND
WUTCMD==B%TP ;SPECIFY PUNCH PAPER-TAPE COMMAND
$TPFIL: TABLE
BUILDF ;BUILD TABLE OF FILE SWITCHES
TEND
;TABLE OF JOB SWITCHES FOR PUNCH PAPER-TAPE COMMAND
$TPJOB: TABLE
BUILDJ ;BUILD JOB SWITCH TABLE
TEND
;TABLE OF JOB SWITCHES AFTER COMMA FOR PUNCH PAPER-TAPE COMMAND
$TPJOC: TABLE
BUILDO ;BUILD JOB SWITCH TABLE AFTER COMMA
TEND
;TABLE OF SUBMIT SWITCHES, ONE TYPE ONLY
WUTCMD==B%SU ;SPECIFY SUBMIT
$SUBSW: TABLE
BUILDJ
TEND
;TABLE OF JOB SWITCHES AFTER COMMA FOR SUBMIT COMMAND
$SUBSC: TABLE
BUILDO ;BUILD JOB SWITCH TABLE AFTER COMMA
TEND
;BEGIN ON SPECIFIC PAGE OF FILE
.PB: CALL GPBEG
MOVE A,[IBEGIN,,PB2] ;DISPATCH ADDRESSES
CALLRET STOR1
GPBEG: DECX <Decimal page number of file on which to start listing>
CMERRX
RET
PB2: MOVEM B,.FPFST(P2)
RET
;NUMBER OF CARDS JOB IS ALLOWED TO PUNCH
.CARDS: CALL GCARDS
VERLIM B,SCRLIM,SCDP ;VERIFY RANGE
ERROR <Card limit out of range>
MOVE A,[ICARDS,,CAR2] ;DISPATCH ADDRESSES
CALLRET STOR1
GCARDS: DECX <Decimal number of spooled cards job is allowed to punch>
CMERRX
RET
CAR2: STOLIM B,.EQLIM(P1),SCDP ;SAVE THE VALUE
RET
GDEAD: DTX <Date and time before which request must start being processed>
CMERRX <Invalid DEADLINE value>
RET
;SPECIFY DEPENDENCY COUNT
.DEPEN: DECX <Decimal DEPENDENCY-COUNT>
CMERRX <Invalid DEPENDENCY-COUNT>
VERLIM B,SCRLIM,DEPN ;VERIFY RANGE
ERROR <DEPENDENCY-COUNT out of range>
MOVE A,[IDEPEN,,DEP2]
CALLRET STOR1
DEP2: STOLIM B,.EQLIM(P1),DEPN
RET
;NUMBER OF FEET OF PAPER TAPE (SPOOLED) JOB IS ALLOWED TO PUNCH
.FEET: CALL GFEET
MOVE A,[IFEET,,FE2]
CALLRET STOR1
GFEET: DECX <Decimal number of feet of spooled paper tape job is allowed to punch>
CMERRX <Invalid FEET value>
VERLIM B,SCRLIM,SPTP
ERROR <FEET value out of range>
RET
FE2: STOLIM B,.EQLIM(P1),SPTP
RET
;SPECIFY WHERE TO WRITE THE LOG FILE
.WLOG: KEYWD $WLOG
0 ;NO DEFAULT
CMERRX <Invalid value for /BATCH-LOG switch>
MOVE B,P3 ;GET VALUE SPECIFIED
MOVE A,[IWRITE,,WLOG2]
CALLRET STOR1
$WLOG: TABLE
T APPEND,,%BAPND
T SPOOL,,%BSPOL
T SUPERSEDE,,%BSCDE
TEND
WLOG2: STOLIM B,.EQLIM(P1),BLOG
RET
;SPECIFY WHETHER LOG FILE SHOULD BE PRINTED
.OUTPU: CALL GOUTPU
MOVE A,[IOUTPU,,OUT2]
CALLRET STOR1
GOUTPU: KEYWD $OUTPU
0 ;NO DEFAULT
CMERRX <Invalid value for /OUTPUT switch>
MOVE B,P3 ;GET VALUE FOR SWITCH
RET
OUT2: STOLIM B,.EQLIM(P1),OUTP
RET
$OUTPU: TABLE
T ALWAYS,,%EQOLG
T ERRORS,,%EQOLE
T NOLOG,,%EQONL
TEND
;SPECIFY HOW MUCH SPOOLED LINEPRINTER OUTPUT JOB MAY WRITE
.PAGES: CALL GPAGES
MOVE A,[IPAGES,,PAG2]
CALLRET STOR1
PAG2: STOLIM B,.EQLIM(P1),SLPT
RET
GPAGES: DECX <Decimal number of spooled lineprinter pages job may write>
CMERRX <Invalid PAGE value>
VERLIM B,SCRLIM,SLPT
ERROR <PAGE count out of range>
RET
;SPECIFY PROTECTION OF REQUEST
.PROTE: OCTX <Octal protection number for request>
CMERRX <Invalid PROTECTION>
VERIFY B,C,EQ.PRO ;CHECK RANGE
ERROR <PROTECTION out of range>
MOVE A,[IPROTE,,PRO2]
CALLRET STOR1
PRO2: STOR B,EQ.PRO,.EQSPC(P1)
RET
;SPECIFY WHETHER ASSISTANCE IS NEEDED OR NOT
.ASSIS: KEYWD $YESNO
T YES,,1 ;DEFAULT IS YES (/ASSIST MEANS ASSISTANCE)
CMERRX <YES or NO required> ;ELSE /ASSIST:MUMBLE DEFAULTS TO YES
CALL GETKEY ;GET TABLE INFORMATION
HRRZ B,P3 ;GET ANSWER
MOVE A,[IASSIS,,ASS2]
CALLRET STOR1
ASS2: MOVEI C,.OPINN
CAIN B,1 ;YES?
MOVEI C,.OPINY
STOLIM C,.EQLIM(P1),OINT
RET
;SPECIFY WHETHER JOB IS RESTARTABLE OR NOT
.RESTA: CALL GRES ;GET RESTARTABLE VALUE
MOVE A,[IRESTA,,RES2]
CALLRET STOR1
RES2: CALL RESCVT ;CONVERT 0/1 TO INTERNAL FORMAT
STOLIM B,.EQLIM(P1),REST
RET
GRES: KEYWD $YESNO
T YES,,1 ;DEFAULT IS YES
CMERRX <YES or NO required>
HRRZ B,P3 ;RETURN REPONSE IN B
RET
;ROUTINE TO CHANGE 0=NO AND 1=YES INTO QUASAR INTERNAL
RESCVT: MOVE B,[EXP %EQRNO,%EQRYE](B) ;0=%EQRNO, 1=%EQRYE
RET
$YESNO: TABLE
T NO,,0
T YES,,1
TEND
;TIME LIMIT FOR JOB
.QUTML: DEFX <60> ;SET UP A DEFAULT FOR RUN TIME
CALL GTIME ;GET TIME IN SECONDS
MOVE A,[ITIME,,TIM2]
CALLRET STOR1
TIM2: STOLIM B,.EQLIM(P1),TIME
RET
;ROUTINE TO INPUT TIME IN SECONDS INTO B.
GTIME: CALL GETAMT ;READ AMOUNT OF TIME
CMERRX <Invalid TIME>
VERLIM B,SCRLIM,TIME ;MAKE SURE IT FITS IN FIELD
ERROR <TIME out of range>
RET
;SPECIFY PLOTTER TIME ALLOWED
.TPLOT: CALL GTPLOT
MOVE A,[ITPLOT,,PLO2]
CALLRET STOR1
PLO2: STOLIM B,.EQLIM(P1),SPLT
RET
GTPLOT: DECX <Decimal number of plotter minutes job is to be allowed>
CMERRX <Invalid TPLOT value>
VERLIM B,SCRLIM,SPLT ;CHECK RANGE
ERROR <TPLOT value out of range>
RET
;SPECIFY UNIQUENESS OF JOB
.UNIQU: CALL GUNI ;GET UNIQUENESS VALUE
MOVE A,[IUNIQU,,UNI2]
CALLRET STOR1
UNI2: CALL CVTUNI ;GET QUASAR VALUES FOR YES AND NO
STOLIM B,.EQLIM(P1),UNIQ
RET
CVTUNI: MOVEI C,%EQUYE ;ASSUME YES
CAIN B,0 ;BUT MAYBE NO
MOVEI C,%EQUNO
MOVE B,C ;RETURN QUASAR FORM IN B
RET
GUNI: MOVEI B,[FLDDB. .CMKEY,,$UNI]
CALL FLDSKP
CMERRX <Invalid UNIQUEness value>
CALL GETKEY ;GET KEYWORD DATA
MOVE B,P3 ;GET TYPED VALUE
RET
$UNI: TABLE
T 0,,0
T 1,,1
T NO,,0
T YES,,1
TEND
;SPECIFY LINE OF CONTROL FILE ON WHICH TO BEGIN EXECUTION
.SBEG: CALL GSBEG
MOVE A,[IBEGIN,,SB2]
CALLRET STOR1
SB2: MOVEM B,.FPFST(Q1)
RET
GSBEG: DECX <Decimal line number of control file on which to start processing>
CMERRX <Invalid line number>
RET
;DISPOSITION OF LOG FILE
.LOGDI: KEYWD $LDISP ;SEE WHAT DISPOSITION IS
0 ;NO DEFAULT
CMERRX ;BAD INPUT, SAY REASON
MOVE B,P3 ;GET VALUE FOR BIT
MOVE A,[ILOGDI,,LDIS2]
CALLRET STOR1
LDIS2: STOR B,FP.DEL,LOGFIL+.FPINF(P1) ;STORE VALUE
RET
ILOGDI: HRROI C,[ASCIZ /KEEP/]
CAIE B,0
HRROI C,[ASCIZ /DELETE/]
PSWITCH <LOGDISPOSITION:%3M>
$LDISP: TABLE
T DELETE,,1 ;DELETE LOG FILE
T KEEP,,0 ;KEEP LOG FILE
TEND
;SPECIAL LOG FILE NAME
.LFN: MOVEI A,[ASCIZ /LOG/] ;DEFAULT EXTENSION FOR LOG FILE
MOVEI B,(GJ%MSG) ;PRINT A MESSAGE FOR RECOGNITION
CALL SPECFN ;PARSE A FILE NAME
CMERRX <Invalid log file name>
MOVE B,A ;PUT JFN IN AC2
MOVE A,CSBUFP ;GET POINTER TO SCRATCH SPACE
MOVX C,1B2+1B5+1B8+1B11+JS%PAF
JFNS ;GET STRING FOR FILE NAME
MOVE A,CSBUFP
SKIPN SDF ;USE PERMANENT STORAGE FOR SETTING DEFAULT, TEMP FOR REAL SUBMIT COMMAND
CALL BUFFS ;BUFFER UP THE STRING
SKIPE SDF
CALL XBUFFS
MOVE B,A ;REMEMBER POINTER TO FILENAME IN B
MOVE A,[ILOGNA,,LFN2]
CALLRET STOR1 ;JUST STORE JFN ON FIRST PASS
LFN2: HRROI A,LOGNAM(P1) ;ON SECOND PASS, POINT TO NAME AREA
MOVEI C,0 ;END ON NULL
SOUT ;WRITE FILESPEC INTO LOG FILE AREA
RET
;TAG AT WHICH TO BEGIN PROCESSING BATCH REQUEST
.TAG: WORDX <TAG in batch file at which to begin processing, six characters or fewer>
CMERRX <Invalid TAG>
CALL GETSXB ;GET SIXBIT OF TAG
MOVE B,A
MOVE A,[ITAG,,TAG2]
CALLRET STOR1
TAG2: MOVEM B,.FPFST(Q1)
RET
.COPIE: CALL GCOPIE
MOVE A,[ICOPIE,,COP2]
CALLRET STOR1 ;SAVE ARG
GCOPIE: DECX <Decimal number of copies to print>
CMERRX
VERIFY B,C,FP.FCY ;VERIFY RANGE
ERROR <Invalid number of copies requested>
RET
COP2: STOR B,FP.FCY,.FPINF(Q1)
RET
;ROUTINE TO SEARCH A TABLE WHOSE ADDRESS IS IN A FOR VALUE GIVEN IN
;B. SKIPS WITH TABLE ADDRESS IN A. NON-SKIP MEANS VALUE NOT FOUND
TSX: MOVE D,A ;PUT TABLE BASE ADDRESS IN D
HLRZ A,(D) ;NUMBER ENTRIES TO SEARCH
TSX0: SOJL A,R ;ENTRY NOT FOUND IF COUNT RUNS OUT
HRRZ C,A ;GET RELATIVE ADDRESS OF VALUE
ADDI C,1(D) ;MAKE ABSOLUTE TABLE ADDRESS
HRRZ C,(C) ;GET ADDRESS OF VALUE
CAME B,(C) ;FIND CORRECT ONE YET?
JRST TSX0 ;NO
ADDI D,1(A) ;YES, CALCULATE ABSOLUTE ADDRESS
MOVE A,D ;RETURN ADDRESS IN A
RETSKP
$PUNCH: TABLE
T ASCII,,%FPCAS
T BCD,,%FPCBC
T BINARY,,%FPCBI
T IMAGE,,%FPCIM
TEND
$PLFRM: TABLE ;MODES FOR PLOTTER
T ASCII,,%FPPAS
T BINARY,,%FPPBI
T IMAGE,,%FPPIM
TEND
$TFORM: TABLE
T ASCII,,%FPTAS
T BINARY,,%FPTBI
T IMAGE,,%FPTIM
T IMAGE-BINARY,,%FPTIB
TEND
$PF: TABLE
T ARROW,,%FPLAR ;PRINT CONTROLS AS UPARROW LETTER
T ASCII,,%FPLAS ;SEND FILE "AS IS"
T OCTAL,,%FPLOC ;PRINT IN OCTAL
T SUPPRESS,,%FPLSU ;SUPPRESS CONTROL CHARACTERS
TEND
;MODE OF OUTPUT
.MODE: CALL GMODE ;READ DATA
MOVE A,[IMODE,,MOD2]
CALLRET STOR1
GMODE: KEYWD @[EXP $PUNCH,$PF,0,$TFORM,$PLFRM](P4) ;USE APPROPRIATE TABLE
0
CMERRX
MOVE B,P3 ;GET ITEM SELECTED
RET
MOD2: STOR B,FP.FPF,.FPINF(Q1)
RET
IMODE: MOVE A,[EXP $PUNCH,$PF,0,$TFORM,$PLFRM](P4) ;TABLE TO SEARCH
CALL TSX ;SEARCH FOR VALUE
JRST IPBAD ;VALUE NOT FOUND
HLRO D,(A) ;YES, GET POINTER TO STRING
IP1: PSWITCH <MODE:%4M>
IPBAD: HRROI D,[ASCIZ /?/]
JRST IP1
.FILE: CALL GFILE
MOVE B,P3
FFI1: TLNN Z,F1 ;IS THIS A GLOBAL SWITCH?
SETOM FILSF ;YES, RAISE A FLAG TO REMEMBER
MOVE A,[IFILE,,FIL2]
CALLRET STOR1
GFILE: KEYWD @[EXP $PUNFL,$PRIFL,0,$TAPFL,$PLOFL](P4)
0 ;NO DEFAULT
CMERRX ;ERROR IF NONE TYPED
MOVE B,P3 ;GET KEYWORD DATA
RET
IFILE: MOVE A,[EXP $PUNFL,$PRIFL,0,$TAPFL,$PLOFL](P4)
CALL TSX ;FIND CORRECT TABLE ADDRESS
JRST FILBAD ;NOT FOUND
IFI0: HLRO D,(A) ;MAKE POINTER TO NAME
PSWITCH <FILE:%4M> ;[3057]
FILBAD: HRROI D,[ASCIZ /?/]
JRST IFI0
FIL2: STOR B,FP.FFF,.FPINF(Q1)
TXO Z,NFILES ;INDICATE EXPLICIT /FILE FOR NEXT SPEC
RET ;(IRRELEVANT IF GLOBAL SW)
DEFINE SLIST
< JOBS <T ASCII,,.FPFAS>
JOBS <T COBOL,,.FPFCO>,B%PR
JOBS <T ELEVEN,,.FPF11>
JOBS <T FORTRAN,,.FPFFO>,B%PR
>
$PRIFL: WUTCMD==B%PR ;DO /FILE: VALUES FOR PRINT COMMAND
TABLE
BUILDJ
TEND
$PLOFL: WUTCMD==B%PL ;DO PLOT VALUES FOR /FILE:
TABLE
BUILDJ
TEND
;PUNCH CARDS...
$PUNFL: WUTCMD==B%CP
TABLE
BUILDJ
TEND
;PUCH TAPE
$TAPFL: WUTCMD==B%TP
TABLE
BUILDJ
TEND
;HEADER TO PRINT HEADER ON FILE OUTPUT
.HEADE: MOVE A,[IHEADE,,NHEA2]
MOVEI B,0
CALL STOR1 ;TURN OFF "NO HEADER" BIT
RET
;NOTIFICATION WANTED AFTER REQUEST IS DONE
.NOTIF: KEYWD $YESNO
T YES,,1 ;MAKE "/NOTIFY" = "/NOTIFY:YES"
CMERRX <YES or NO required>
MOVE B,P3 ;GET 0 FOR NO, 1 FOR YES
MOVE A,[INOTIF,,NOTIF2]
CALLRET STOR1
NOTIF2: STOR B,EQ.NOT,.EQSEQ(P1)
RET
;NO HEADER WANTED
.NOHEA: MOVE A,[IHEADE,,NHEA2]
MOVEI B,1
CALL STOR1 ;TURN OFF "NO HEADER" BIT
RET
NHEA2: STOR B,FP.NFH,.FPINF(Q1)
RET
;REPORT CODE TO SEARCH FOR
.REPOR: CALL GREPOR
CALLRET STOR1
REP2: DMOVEM B,.FPFR1(Q1) ;STORE REPORT CODE
RET
GREPOR: MOVEI B,[FLDDB. .CMQST,,,<Report code, up to twelve characters,>,,[
FLDDB. .CMFLD,CM%SDH]] ;REPORT CODE MAY OR MAY NOT BE IN QUOTES
CALL FLDSKP ;READ IN THE REPORT FIELD
CMERRX <Invalid report string>
MOVE A,[440700,,ATMBUF] ;PREPARE TO CHANGE REPORT TO SIXBIT
MOVE B,[440600,,Q2]
SETZB Q2,Q3
REP1: CALL CACKLE ;GET CHARACTER FROM REPORT
JRST REP3 ;NO MORE CHARACTERS
CAMN B,[000600,,Q3]
ERROR <Report string too long>
IDPB C,B ;STORE CHARACTER OF REPORT STRING
JRST REP1 ;GO BACK FOR MORE
REP3: MOVE A,[IREPOR,,REP2]
DMOVE B,Q2 ;GET THE SIXBIT NAME
RET
;PRESERVE FILE (DON'T DELETE IT AFTER PRINTING)
.PRESE: TDZA B,B ;SET B=0 AND SKIP
;DELETE FILE AFTER PRINTING
.DELET: MOVEI B,1 ;SET FLAG
TLNN Z,F1 ;IS THIS A GLOBAL SWITCH?
SETOM PRESF ;YES, RAISE A FLAG IN CASE EXTENSION IS .LST
MOVE A,[IDELET,,DEL2]
CALLRET STOR1
DEL2: STOR B,FP.DEL,.FPINF(Q1)
TXO Z,NPRES ;INDICATE EXPLICIT /PRESERVE OR /DELETE FOR NEXT
RET ;SPEC (IRRELEVANT IF GLOBAL SW)
;SPACING BETWEEN LINES
.SPACI: CALL GSPACE
MOVE A,[ISPACI,,SPA2]
CALLRET STOR1
GSPACE: KEYWD $SPACE ;GET SPACING PARAMETER
0 ;NO DEFAULT
CMERRX ;BAD TYPEIN
MOVE B,P3
RET
SPA2: STOR B,FP.FSP,.FPINF(Q1)
RET
$SPACE: TABLE
T DOUBLE,,2
T SINGLE,,1
T TRIPLE,,3
TEND
;CHARGE PARTICULAR ACCOUNT
.ACCOU: CALL GACT ;GET ACCOUNT STRING
MOVE B,A ;POINTER TO STRING IN B
MOVE A,[IACCOU,,ACC2]
CALLRET STOR1
ACC2: HRROI A,.EQACT(P1) ;POINT AT BLOCK IN IPCF MESSAGE FOR ACCOUNT STRING
MOVEI C,0 ;END ON A 0
SOUT ;COPY STRING INTO MESSAGE
RET
IACCOU: PSWITCH <ACCOUNT:%2M>
;ROUTINE TO READ ACCOUNT. IT RETURNS POINTER IN A.
GACT: ACCTX <Account to be charged for request>
CMERRX ;FAILED
HRROI A,ATMBUF ;POINT TO THE ACCOUNT STRING
SKIPN SDF ;USE TEMPORARY STORAGE IF NOT SETTING DEFAULTS
CALLRET BUFFS ;BUFFER THE ACCOUNT AND RETURN POINTER IN A
SKIPE SDF
CALLRET XBUFFS ;AND PERMANENT IF SETTING DEFAULT
;PROCESS REQUEST /AFTER: A CERTAIN TIME
.AFTER: CALL GAFT ;GET AFTER VALUE
MOVE A,[IAFTER,,AFT2]
CALLRET STOR1
AFT2: MOVEM B,.EQAFT(P1) ;STORE SPECIFIED TIME AND DATE
RET
GAFT: DTX <Date and/or time after which to process request>
CMERRX <Invalid /AFTER value>
RET
;PAPER TYPE SPECIFICATION
.FORMS: CALL GFORMS ;GET FORMS WORD INTO B
VERLIM B,SCRLIM,FORM ;MAKE SURE IT FITS
ERROR <Invalid FORMS specification>
MOVE A,[IFORMS,,FOR2]
CALLRET STOR1
FOR2: STOLIM B,.EQLIM(P1),FORM
RET
GFORMS: WORDX <Type of paper to use for printing, six characters or fewer>
CMERRX <Invalid paper type>
MOVE A,[440700,,ATMBUF] ;POINTER TO READ ASCII WORD
MOVE B,[440600,,D] ;WE'LL FORM SIXBIT WORD IN D
MOVEI D,0 ;START WITH CLEAR WORD
FORM1: CALL CACKLE ;GET CHARACTER
JRST FORM2 ;DONE
TLNN B,770000 ;MAKE SURE ROOM FOR ANOTHER CHARACTER
ERROR <FORMS specification too long>
IDPB C,B ;STORE THE SIXBIT CHARACTER
JRST FORM1 ;GO DO REST OF CHARACTERS
FORM2: MOVE B,D ;RETURN VALUE IN "B"
RET
;SPECIFY THAT CONTROL FILE IS TO BE INTERPRETED AS A CARD DECK
.READE: MOVE A,[IREADE,,READ2]
CALLRET STOR1
READ2: MOVEI B,.OTBIN ;SPECIFY SPECIAL QUEUE
MOVEM B,.EQROB+.ROBTY(P1)
RET
IREADE: PSWITCH <READER>
;SPECIFY NON-DEFAULT JOBNAME
.GOBNA: CALL GJOB ;GET JOBNAME
MOVE A,[IJOBNA,,JOB2]
CALLRET STOR1
JOB2: MOVEM B,.EQJOB(P1) ;STORE IT
RET
;READ SIXBIT JOBNAME INTO B AND MASK INTO C...
GJOB: MOVEI B,[FLDBK. .CMFLD,CM%SDH,,<Name of request, six characters or fewer>,,[BRMSK. FILB0.,FILB1.,FILB2.,FILB3.]]
CALL FLDSKP
CMERRX <Invalid JOBNAME>
;ROUTINE TO PROCESS JOBNAME ASSUMING IT'S ALREADY IN ATOM BUFFER...
GJOB1: CALL GETSXB ;GET SIXBIT VALUE FOR JOBNAME
MOVE B,A
CAIN B,0 ;NULL NAME?
MOVE B,[SIXBIT /*/] ;YES, SO ASSUME ALL JOBS
HRROI C,-1 ;FIRST ASSUME SPECIFIC NAME GIVEN
CAMN B,[SIXBIT /*/] ;BUT IF "*" GIVEN,
MOVEI C,0 ;THEN ALLOW ANY JOBNAME TO MATCH
RET
;SPECIFY METERS OF PAPER TAPE TO ALLOW IN REQUEST
.METER: CALL GMET
MOVE A,[IMETER,,MET2]
CALLRET STOR1
;LIMIT OF NUMBER OF PAGES TO PRINT
.LIMIT: CALL GLIM ;GET LIMIT VALUE
MOVE A,[ILIMIT,,LIM2]
CALLRET STOR1
MET2: CALL M2F ;CHANGE METERS TO FEET
LIM2: STOLIM B,.EQLIM(P1),OLIM
RET
M2F: FLTR B,B ;GET FLOATING REPRESENTATIN
FMP B,[39.37] ;GET NUMBER OF INCHES DESIRED
FDVRI B,(12.0) ;CHANGE TO FEET
FIXR B,B ;GET INTEGER
RET
GMET: STKVAR <SAVMET>
DECX <Decimal maximum paper tape length>
CMERRX <Invalid /METERS value>
MOVEM B,SAVMET ;SAVE METERS VALUE
CALL M2F ;CHANGE METERS TO FEET
VERLIM B,SCRLIM,OLIM ;MAKE SURE VALUE FITS IN FIELD
ERROR <Limit out of range>
MOVE B,SAVMET ;GET NUMBER OF METERS
RET
GLIM: DECX <Decimal number of pages, cards, or feet to limit request to>
CMERRX <Invalid /LIMIT value>
VERLIM B,SCRLIM,OLIM ;CHECK VALUE
ERROR <LIMIT out of range>
RET
;SPECIFY WHAT TYPE OF PRINTER TO USE FOR REQUEST
.UPPER: SKIPA B,[PR%UC]
.LOWER: MOVX B,PR%LC
SKIPA
.GENER: MOVX B,PR%ANY ;GENERIC MEANS ANY
MOVE A,[ICASE,,LOW2]
CALLRET STOR1
LOW2: MOVX C,OBDLLC ;FIRST ASSUME LOWERCASE
CAIN B,PR%UC ;UPPERCASE?
MOVX C,OBDLUC ;YES
CAIN B,PR%ANY
MOVX C,0 ;GENERIC
MOVEM C,.EQROB+.ROBAT(P1) ;TURN ON APPROPRIATE BITS, TURN OFF RO.PHY
RET
;[7.1073]
;PRINTER FOR REMOTE PRINT JOB
.REMPR: CALL GPRNTR
MOVE A,[IRPRNT,,RPRNT]
CALLRET STOR1
GPRNTR:
SETZM ODDPTR ; Clear "odd printer" flag (TRVAR'd at .PRINT)
MOVE A,PTRTAB ; Get the address
MOVEI B,PBKFDB ; ...and the pre-fab FDB
MOVEM A,.CMDAT(B) ; Plug it in
HRROI A,FDPHLP ; Now the help string *sigh*
MOVEM A,.CMHLP(B) ; Stuff it in
MOVEI A,[FLDBK. .CMFLD,CM%BRK!CM%SDH,,<VMS queue - 31 characters or less (requires a DESTINATION-NODE)
or LAT Port/Service - 16 characters or less (requires a DESTINATION-NODE)>,,[
BRMSK. FLDB0.,FLDB1.,FLDB2.,FLDB3.,<$_>]] ;[7.1099]
HRRM A,PBKFDB+.CMFNP ; Link in the Keyword FDB
MOVEI B,PBKFDB ; Get it into the correct AC
SKIPN PTRTAB ; Is there a table yet? (May be empty)
MOVEI B,[FLDBK. .CMFLD,CM%BRK!CM%SDH,,<VMS queue - 31 characters or less (requires a DESTINATION-NODE)
or LAT Port/Service - 16 characters or less (requires a DESTINATION-NODE)>,,[
BRMSK. FLDB0.,FLDB1.,FLDB2.,FLDB3.,<$_>]] ; [7.1099] No table
CALL FLDSKP ; Parse printer name
CMERRX
LOAD C,CM%FNC,.CMFNP(C) ; Get what was typed
CAIN C,.CMKEY ; Keyword?
JRST RESOLV ; Yes. Go find out queue/nodename
GPRNT1: MOVE A,CMABP ;[4417] Point to user's input
ILDB B,A ; Get first character
CAILE B,"Z" ; Lowercase char?
SUBI B,40 ; Yes, uppercase-ize
CAIL B,"A" ; If not between "A"
CAILE B,"Z" ; and "Z", it's not a letter.
ERROR <VMS queue, or LAT Port/Service name must begin with alphabetic character>
MOVE A,CMABP ; point to ATMBUF
CALL BCOUNT ; (A/A,B)How many characters?
CAILE B,PTRCHR ; More than allowed?
ERROR <Too many characters in VMS queue, or LAT Port/Service name>
MOVSI A,(POINT 7,0) ; Point
HRRI A,RPQUE ; Save string here
MOVE B,CMABP ; Take it from here
SETZ C, ; End on null
CALL ASOUT ; (A,B,C/A,B)Copy string
;This is for @SET DEF PRINT /REM:queue /DEST:node, were queue is just a Q name.
;We have a queue name so check to see if whether we are SET DEFAULT PRINT.
;If we are save the queue name because there might be a/DEST with it.
;Remember to check for /DEST at SDEOL:
SKIPN SDF ;[4417]SET DEFAULT?
IFSKP. ;[4417]Yes,
MOVSI A,RPQUE ;[4417]Source is addr of queue name
HRRI A,DEFQUE ;[4417]Destination is addr of store queue name
BLT A,DEFQUE+6 ;[4417]Save it
SETONE PR%QUL,PRIFLG ;[4417]Set queue name bit
SETZRO PR%RDF,PRIFLG ;[4417]Clear the default /REMOTE bit
SETZM DEFADR ;[4417]Clear addr of alias to defaulted printer
ENDIF. ;[4417]
SETOM ODDPTR ; Signal we have an "odd printer" i.e.,not in table
SETZM RPNODE ; Clean up node location
RET
;[7.1073]
;HERE TO RESOLVE AN ALIAS FROM THE TABLE TO QUEUENAME AND NODENAME
RESOLV: MOVNI A,^D10 ; Initialize counter
MOVEM A,KEYLVL
SKIPE SDF ;[4417]Doing SET DEFAULT
MOVEM B,DEFADR ;[4417]Yes, save the address of the alias
;Caller of this routine, on return should clear the left half of PRIFLG and
;make sure that PR%DDF and PR%RDF are set correctly because in resolving the
;alias, RESLV1: will change the bit setting of PR%DDF and PR%RDF if it is
;called on behalf of a SET DEFAULT PRINTER command.
RESLV1::HLRZ A,(B) ; Get LH of entry
IFE. A ;[4417]End of table?
MOVE A,PRIFLG ;[4417]Get Print flag
TXNN A,PR%DEF ;[4417]Filling in defaults?
IFSKP. ;[4417]Yes
SETONE PR%DER,PRIFLG ;[4417]Say we have an error
RET ;[4417] and return
ELSE. ;[4417]
ERROR <Unexpected error - Requested Printer not found in table>
ENDIF. ;[4417]
ENDIF. ;[4417]
HRRZ A,(B) ; Get RH of entry
IFE. A ;[4417]Deleted entry
MOVE A,PRIFLG ;[4417]Get Print flag
TXNN A,PR%DEF ;[4417]Filling in defaults?
IFSKP. ;[4417]Yes
SETONE PR%DER,PRIFLG ;[4417]Say we have an error
RET ;[4417] and return
ELSE. ;[4417]
SKIPE SDF ;[4417]SET DEFAULT
JRST GPRNT1 ;[4417]Yes, then its o.k because there might be a
;/DESTINATION with the SET command.
ERROR <Unexpected error - Requested Printer is a deleted entry>
ENDIF. ;[4417]
ENDIF. ;[4417]
MOVE D,A ; Move pointer into a safe AC
HLRZ C,(D) ; Get LH of data we point to
SKIPN C ; If zero, this is an alias
JRST STPTAB ; Go step thru the table
MOVSI B,(POINT 7,0)
HRR B,C ; Point to the queue name
MOVSI A,(POINT 7,0) ; Point
HRRI A,RPQUE ; Save string here
SETZ C, ; End on null
CALL ASOUT ; (A,B,C/A,B)Copy string
HRRO A,(D) ; Now point to RH of word
CALL GETSIX ;(A/A) Make nodename SIXBIT
ERROR <Unexpected error - Node name too long>
MOVEM A,RPNODE ; Save it
SKIPN SDF ;[4417] setting defaults?
IFSKP. ;[4417]yes
SKIPE SDECHO ;[4417]1st pass?
IFSKP. ;[4417]Yes
MOVE B,DEFADR ;[4417]Get entry
HLRZ A,(B) ;[4417]Get address of alias string
MOVSI B,(POINT 7,0) ;[4417]Pointer
HRR B,A ;[4417]Take it from here
MOVSI A,(POINT 7,0) ;[4417]Pointer
HRRI A,DEFREM ;[4417]Save input arg from SET DEF /REMOTE
SETZ C, ;[4417]End on null
CALL ASOUT ;[4417](A,B,C/A,B)Copy string
SETONE PR%RDF,PRIFLG ;[4417]Default /REMOTE takes precedent
SETONE PR%RML,PRIFLG ;[4417]Seen /REMOTE in SET DEFAULT
SETZRO PR%DDF,PRIFLG ;[4417]Default /DESTINATION take a back seat
SETZM DEFQUE ;[4417]Clear just queue name
ENDIF. ;[4417]
ENDIF. ;[4417]
RET ;[4417]All done
;WE FOUND AN ALIAS, SO WE HAVE TO KEEP LOOKING
STPTAB: AOS KEYLVL ; Increment the counter
SKIPG KEYLVL ;[4417]Counted out?
IFSKP. ;[4417]Yes,
MOVE A,PRIFLG ;[4417]Get Print flag
TXNN A,PR%DEF ;[4417]Filling in defaults?
IFSKP. ;[4417]Yes
SETONE PR%DER,PRIFLG ;[4417]Say we have an error
ELSE. ;[4417]
ERROR <Physical printer not found - aliases nested too deeply> ;Yep
ENDIF. ;[4417]
ENDIF. ;[4417]
HRRO B,(A) ; Make pointer from RH of data word
MOVE A,PTRTAB ; Addr of table
TBLUK ; Where's the string we are pointing to?
ERJMP NOFIND
MOVE B,A ; Here
JRST RESLV1 ; Loop
NOFIND:
MOVE A,PRIFLG ;[4417]Get Print flag
TXNN A,PR%DEF ;[4417]Filling in defaults?
IFSKP. ;[4417]Yes
SETONE PR%DER,PRIFLG ;[4417]Say we have an error
ELSE. ;[4417]
ERROR <Unexpected error - cannot resolve alias name>
ENDIF. ;[4417]
RET ;[4417]
;SO DO SOMETHING WITH THE QUEUE AND NODENAME
RPRNT: SKIPE ODDPTR ; Was printer arbitrary field?
SKIPE DSTNOD ; Yes. Did we get a destination-node?
IFSKP. ; [7.1110] No -see if we have a default set
MOVE A,.EQROB+.ROBND(P1) ; [7.1110] Nodename already there?
JUMPN A,RPRNT1 ; [7.1110] Yes, use it
ERROR <Printer name ambiguous, or not in table and requires a DESTINATION-NODE> ;[7.1188] No.
ENDIF.
MOVE A,PRIFLG ;[4417]Get PRINT command flag
TXNN A,PR%DEF ;[4417]Filling in defaults
IFSKP. ;[4417]Yes,
SKIPE RPQUE ;[4417]Do we have a queue name?
RET ;[4417]yes, no need for default
SKIPN B,DEFADR ;[4417]Do we have default remote printer?
JRST RPRNT1 ;[4417]No, check for just default queue name
MOVNI A,^D10 ;[4417]Initialize counter
MOVEM A,KEYLVL ;[4417]Save it for RESLV1
CALL RESLV1 ;[4417]Resolve it
MOVE A,PRIFLG ;[4417]GET PRINT FLAG
TXNE A,PR%DER ;[4417]Any errors?
RET ;[4417]Yes, done
SETONE PR%RND,PRIFLG ;[4417]Default node on behalf of /REMOTE
TXNE A,PR%RDF ;[4417]/REMOTE first?
SKIPN B,RPNODE ;[4417]Yes, use this node
JRST RPRNT1 ;[4417]No, skip node name fill in
ELSE.
SETZRO PR%DER,PRIFLG ;[4417]Clear error bit
SKIPN B,DSTNOD ;[4417]Do we have a DESTINATION
MOVE B,RPNODE ;[4417]No, use node name from /REMOTE:
ENDIF.
MOVEM B,.EQROB+.ROBND(P1) ; Store it in .EQ block for GALAXY
RPRNT1: SETONE EQ.DLR,.EQSEQ(P1); [7.1110]Set the "this is DQS or LAT print" bit
MOVSI B,(POINT 7,0) ;[4417]Byte pointer
MOVE A,PRIFLG ;[4417]Do we have a PRINT command flag
TXNN A,PR%DEF ;[4417]Filling in defaults
IFSKP. ;[4417]Yes
SETONE PR%QUE,PRIFLG ;[4417]set defaulted queue bit
SKIPE RPQUE ;[4417]do we have a queue name?
JRST RPRNT2 ;[4417]Yes, use it
SKIPE DEFQUE ;[4417]Do we have a just queue name
IFSKP. ;[4417]No
SETZRO PR%JQN,PRIFLG ;[4417]Clear defaulted queue name
RET ;[4417]No, then no defaults
ELSE. ;[4417]
HRRI B,DEFQUE ;[4417]Get just default queue name
SETONE PR%JQN,PRIFLG ;[4417]Just queue name
JRST RPRNT3 ;[4417]and continue
ENDIF. ;[4417]
ELSE. ;[4417]No
SETZRO PR%QUE,PRIFLG ;[4417]Clear defaulted queue bit
ENDIF. ;[4417]
RPRNT2: HRRI B,RPQUE ;[4417]Point to the queue name
RPRNT3: MOVSI A,(POINT 7,0) ;[4417]Point
HRRI A,.EQRPN(P1) ; And copy to EQ block
SETZ C, ; End on null
CALL ASOUT ; (A,B,C/A,B)Copy string
RET ;[4417]
;[7.1073]
;CHARACTERISTICS FOR REMOTE PRINT JOB
.CHAR: CALL GCHAR
MOVE A,[ICHRNM,,CHARN]
CALLRET STOR1
GCHAR: SKIPE SDF ;[7.1113] setting defaults?
ERROR <Defaults are not implemented for remote-printing
> ;[7.1113] Yes - sorry
SETZM BTMSK1 ; Clear the bitmask....
SETZM BTMSK2 ; ...
SETZM BTMSK3 ; ...
SETZM BTMSK4 ; [7.1073]...
MOVE A,CHRTAB ; Get the address of the characteristics table
JUMPE A,NOTAB
MOVEI B,CBKFDB ; And the pre-fab FDB
MOVEM A,.CMDAT(B) ; Plug in the table address
HRROI A,FDCHLP ; Now the help string
MOVEM A,.CMHLP(B) ; Stuff it in
MOVEI A,[FLDDB. .CMNUM,CM%SDH,12,<Bit number of CHARACTERISTIC (in decimal) 0 to 127>,,[
FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /(/]>,<Left parenthesis to enter a group of CHARACTERISTICs>]]
HRRM A,CBKFDB+.CMFNP ; Link in the Keyword FDB
MOVEI B,CBKFDB ; Get it into the correct AC
CALL FLDSKP ; Parse
CMERRX
LOAD C,CM%FNC,.CMFNP(C) ; Get what was typed
CAIN C,.CMTOK ; Token? i.e., left paren
IFSKP. ; Not token, must be number or keyword
CAIE C,.CMNUM ; Number?
IFSKP. ; Yes.
CAILE B,CHRNUM
ERROR <Number must be in range 0-127> ; Nope, silly.
MOVE A,B ; Get number into AC1
CALL NBTMSK ; (A/ )Set the bit
RET ; Done
ELSE.
MOVE A,B ; Address to AC1
CALL KBTMSK ; (A/ )Must've been a keyword - make the mask
RET ; Done
ENDIF.
ENDIF.
;HERE IF USER TYPED A LEFT PARENTHESIS. THIS MEANS WE WILL PROBABLY BE
;GETTING A LIST OF CHARACTERISTICS - NUMBERS AND/OR KEYWORDS - SEPARATED
;BY COMMAS. WE'LL THEN NEED TO SEE A RIGHT PAREN TO END THE LIST.
GCHAR1: MOVE A,CHRTAB
MOVEI B,CBKFDB ; Get the pre-fab FDB
MOVEM A,.CMDAT(B) ; Plug in the table address
MOVEI A,[FLDDB. .CMNUM,CM%SDH,12,<Bit number of CHARACTERISTIC (in decimal) 0 to 127>]
HRRM A,CBKFDB+.CMFNP ; Link in the Keyword FDB
MOVEI B,CBKFDB ; Get it into the correct AC
CALL FLDSKP ; Parse
CMERRX
LOAD C,CM%FNC,.CMFNP(C) ; Get what was typed
CAIE C,.CMNUM ; Number?
IFSKP. ; Yes
CAILE B,CHRNUM
ERROR <Number must be in range 0-127> ; Nope, silly.
MOVE A,B ; Get number into AC1
CALL NBTMSK ; (A/ )Set the bit
ELSE.
MOVE A,B ; Get keyword addr in AC1
CALL KBTMSK ; (A/ ) Set the bit
ENDIF.
MOVEI B,[FLDDB. .CMCMA ,,,,,[
FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /)/]>,<Right parenthesis to end a group of CHARACTERISTICs>]]
CALL FLDSKP ; Parse
CMERRX
LOAD C,CM%FNC,.CMFNP(C) ; Get what was typed
CAIN C,.CMCMA ; Comma?
JRST GCHAR1 ; Yes, go get another number or keyword
RET ; No - must've been r.paren - done.
;HERE IF NO TABLE - USER'S ONLY OPTION IS TO INPUT A NUMBER, OR NUMBERS
NOTAB: MOVEI B,[FLDDB. .CMNUM,CM%SDH,12,<Bit number of CHARACTERISTIC (in decimal) 0 to 127>,,[
FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /(/]>,<Left parenthesis to enter a group of numbers>]]
CALL FLDSKP ; Parse
CMERRX
LOAD C,CM%FNC,.CMFNP(C) ; Get what was typed
CAIN C,.CMTOK ; Token? i.e.,left paren
IFSKP.
CAILE B,CHRNUM
ERROR <Number must be in range 0-127> ; Nope, silly.
MOVE A,B ; Get number into AC1
CALL NBTMSK ; (A/ )Set the bit
RET
ENDIF. ; Was a token, now look for a list of numbers
GNMBRZ: DECX <Bit number of CHARACTERISTIC (in decimal) 0 to 127>
CMERRX
CAILE B,CHRNUM
ERROR <Number must be in range 0-127> ; Nope, silly.
MOVE A,B ; Get number into AC1
CALL NBTMSK ; (A/ )Set the bit
MOVEI B,[FLDDB. .CMCMA ,,,,,[
FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /)/]>,<Right parenthesis to end a group of numbers>]]
CALL FLDSKP ; Parse
CMERRX
LOAD C,CM%FNC,.CMFNP(C) ; Get what was typed
CAIN C,.CMCMA ; Comma?
JRST GNMBRZ ; Yes, go get another number
RET ; Must've been right paren - so we're done
CHARN: MOVE B,BTMSK1 ; Get first word of bit-mask
MOVE C,BTMSK2 ; ....and second
DMOVEM B,.EQCHR(P1)
MOVE B,BTMSK3 ; Now third
MOVE C,BTMSK4 ; ...and fourth
DMOVEM B,.EQCHR+2(P1)
RET
;NOTE FOR HEADER PAGE
.NOTE: CALL GNOTE
MOVE A,[INOTE,,NOT2]
CALLRET STOR1
NOT2: STOLIM B,.EQLIM(P1),NOT1
STOLIM C,.EQLIM(P1),NOT2
RET
GNOTE: MOVEI B,[FLDDB. .CMQST,,,<Note for header page, up to twelve characters,>,,[
FLDDB. .CMFLD,CM%SDH]] ;NOTE MAY OR MAY NOT BE IN QUOTES
CALL FLDSKP ;READ IN THE NOTE
CMERRX <Invalid NOTE>
MOVE A,[440700,,ATMBUF] ;PREPARE TO CHANGE NOTE TO SIXBIT
MOVE B,[440600,,Q2]
SETZB Q2,Q3 ;START WITH CLEAR NOTE
NOTE1: CALL CACKLE ;GET CHARACTER FROM NOTE
JRST NOTE3 ;NO MORE CHARACTERS
CAMN B,[000600,,Q3]
ERROR <NOTE too long>
IDPB C,B ;STORE CHARACTER OF NOTE
JRST NOTE1 ;GO BACK FOR MORE
NOTE3: DMOVE B,Q2 ;RETURN NOTE IN B AND C
RET
;SUBROUTINE USED FOR READING CHARACTER. MAKES SURE CHARACTER, IF
;LETTER, IS UPPERCASE. THEN IT CHANGES IT TO SIXBIT.
CACKLE: ILDB C,A ;READ CHARACTER
JUMPE C,R ;SINGLE RETURN ON NULL CHARACTER
CAIN C,"" ;IS IT THE QUOTING CHARACTER?
JRST CAK1 ;YES
CAIGE C,40 ;MAKE SURE IT CAN BE CHANGED TO SIXBIT
MOVEI C,"?" ;USE ? IF NOT
CAK1: CAIL C,141
CAILE C,172
CAIA ;NOT LOWERCASE LETTER
TRZ C,40 ;WAS LOWERCASE, MAKE UPPERCASE
SUBI C,40 ;CHANGE TO SIXBIT
RETSKP ;SKIP RETURN BECAUSE WE READ A CHARACTER
;SPECIAL CONNECTED DIRECTORY FOR BATCH JOB
.BCON: DIRX <Directory to which batch job is to be connected>
CMERRX <Invalid CONNECTED-DIRECTORY for batch job>
MOVE A,[ICONNE,,BC2]
CALLRET STOR1
BC2: HRROI A,.EQCON(P1)
DIRST ;STORE DIRECTORY NAME
ERCAL CJERRE
RET
;SPECIAL OWNER FOR REQUEST
.BUSER: USERX <User who is to own this request>
CMERRX <Invalid owner of request>
MOVE A,[IUSER,,BU2]
CALLRET STOR1
BU2: HRROI A,.EQOWN(P1)
DIRST ;STORE OWNER NAME
ERCAL CJERRE
RET
;PRIORITY SPECIFICATION
.PRIOR: CALL GPRIO
VERIFY B,C,EQ.PRI
ERROR <PRIORITY value out of range>
MOVE A,[IPRIOR,,PRIO2]
CALLRET STOR1
PRIO2: STOR B,EQ.PRI,.EQSEQ(P1)
RET
GPRIO: DECX <Decimal priority level>
CMERRX <Invalid PRIORITY level>
VERIFY B,C,EQ.PRI ;CHECK RANGE
ERROR <PRIORITY out of range>
RET
;SEQUENCE NUMBER
.SEQUE: CALL GSEQ
VERIFY B,C,EQ.SEQ
ERROR <SEQUENCE number out of range>
MOVE A,[ISEQUE,,SEQ2]
CALLRET STOR1
SEQ2: STOR B,EQ.SEQ,.EQSEQ(P1)
RET
GSEQ: DECX <Decimal sequence number>
CMERRX <Invalid SEQUENCE number>
VERIFY B,C,EQ.SEQ
ERROR <SEQUENCE number out of range>
RET
;INITIALIZATION ROUTINE. SETS UP INITIAL ADDRESSES FOR REQUEST AND
;FILE DESCRIPTOR BLOCKS
PRINI: SETZM PRIJFN ;MARK THAT THERE'S NO CURRENT JFN YET
CALL EQINI ;INITIALIZE REQUEST BLOCK
MOVEI A,QSLEN ;ALLOCATE ARG STACK
CALL GETBUF
SOJ A, ;SO FIRST PUSH USES FIRST WORD
HRLI A,-QSLEN ;CATCH OVERFLOW
MOVEM A,QPT ;INITIALIZE ARGUMENT STACK
MOVEM A,IQPT ;REMEMBER INITIAL POINTER
RET
;ROUTINE TO INITIALIZE REQUEST BLOCK
EQINI: MOVEI P1,EQGLOB ;GLOBAL REQUEST BLOCK
MOVEI P2,EQ0+EQHSIZ ;FIRST FILESPEC STARTS RIGHT AFTER FIRST BLOCK
SETZM (P1) ;CLEAR FIRST WORD OF REQUEST BLOCK
HRL A,P1
HRRI A,1(P1) ;MAKE BLT POINTER
MOVEI B,777(P1)
BLT A,(B) ;CLEAR OUT FIRST BLOCK
MOVEI A,EQHSIZ ;LENGTH OF MESSAGE IS EQHSIZ
STOR A,MS.CNT,(P1)
MOVEI A,.QOCRE ;MESSAGE TYPE (REQUEST CREATION)
STOR A,MS.TYP,(P1)
MOVEI A,EQHSIZ ;SIZE OF REQUEST HEADER
STOR A,EQ.LOH,.EQLEN(P1)
MOVEI A,%%.QSR ;VERSION NUMBER
STOR A,EQ.VRS,.EQLEN(P1)
XCT GOTYP ;GET OBJECT TYPE
MOVEM A,.EQROB+.ROBTY(P1)
MOVEI A,FPXSIZ ;ALLOCATE LARGEST SIZE FOR FILE-PARAMETER AREA
STOR A,FP.LEN,GLBBLK+.FPLEN
STOR A,FP.LEN,GLBBLK+.FPLEN+FPXSIZ+FILMAX+1 ;STORE FOR LOG FILE TOO
CAIN P4,X%SU ;SUBMIT?
JRST EQSINI ;YES, DIFFERENT INITIALIZATION
MOVE A,[EQGLOB,,EQ0] ;NO GLOBAL PAGE FOR PRINT COMMAND
BLT A,EQ0+777
MOVEI A,1 ;DEFAULT NUMBER OF COPIES IS 1
STOR A,FP.FCY,GLBBLK+.FPINF
MOVEI P1,EQ0 ;NO GLOBAL JOB SWITCH BLOCK FOR PRINT COMMAND
RET
EQSINI: MOVX A,.FPFSA ;ASSUME ITS STREAM ASCII FORMAT
STOR A,FP.FFF,GLBBLK+.FPINF ;SAVE IT
RET
;INFORMATION (ABOUT) RETRIEVAL-REQUESTS
;INFORMATION (ABOUT) OUTPUT-REQUESTS
;INFORMATION (ABOUT) BATCH-REQUESTS
;INFORMATION (ABOUT) MOUNT-REQUESTS
;AC USAGE:
;P1 POINTER TO LIST REQUEST TO BE SENT TO QUASAR
;P2 POINTER TO QUEUE ENTRY RECEIVED FROM QUASAR, AND POINTER TO BLOCK BEING CREATED
.IRR:: MOVEI P4,X%RE ;RETRIEVAL
JRST IPR11
.IMR:: MOVEI P4,X%MO ;SPECIFY WE WANT TO SEE MOUNTS
JRST IPR11
.IBR:: MOVEI P4,X%SU
JRST IPR11
.IPR:: MOVEI P4,X%PR ;0 FOR OUTPUT REQUESTS, 1 FOR BATCH REQUESTS
IPR11: PRISTG ;ALLOCATE STORAGE (SUCH AS QIDX)
CALL IPRINI ;INITIALIZE FOR LISTING REQUESTS
CALL PRLSTQ ;SET UP REQUEST BLOCK
IPR12: MOVEI B,[FLDDB. .CMCFM,,,,,[ ;END OF LINE ONE POSSIBILITY
FLDDB. .CMSWI,,$IPRSW]] ;SWITCH ANOTHER POSSIBILITY
CAIN P4,X%SU ;USE CORRECT SWITCH TABLE
MOVEI B,[FLDDB. .CMCFM,,,,,[
FLDDB. .CMSWI,,$ISBSW]]
CALL FLDSKP ;GET SOME INPUT
CMERRX
LDB D,[331100,,(C)] ;GET DATA TYPE
CAIN D,.CMSWI ;SWITCH?
JRST ISWI ;YES
CALL QUASND ;SEND REQUEST OFF TO QUASAR
MOVEM A,QIDX ;REMEMBER ID
CALL REQX ;ANYTHING IN THE QUEUE?
CALLRET DONREQ ;ALL DONE,CLEAN UP
;SWITCHES FOR INFORMATION (ABOUT) BATCH OR OUTPUT REQUESTS
DEFINE SLIST
<
JOBS <T ALL> ;LIST ALL SWITCHES
JOBS <TV DESTINATION-NODE,,.DSNOD>,B%PR ;[7.1084]
JOBS <T FAST> ;OMIT ALL SWITCHES
JOBS <TV PROCESSING-NODE,,.LNODE>,B%SU
JOBS <TV USER>
>
;SWITCHES FOR OUTPUT-REQUESTS
WUTCMD==B%PR ;SPECIFY NOT SUBMIT
$IPRSW: TABLE
BUILDJ
TEND
;SWITCHES FOR INFO BATCH
WUTCMD==B%SU ;SPECIFY SUBMIT
$ISBSW: TABLE
BUILDJ
TEND
;SWITCH TYPED
ISWI: CALL EXSWI ;EXECUTE SWITCH
JRST IPR12 ;GO BACK FOR MORE INPUT
;/FAST CAUSES SWITCHES NOT TO BE LISTED
.FAST: MOVEI A,1 ;SAY /FAST
STOR A,LS.FST,.OFLAG(P1) ;TELL QUASAR
RET
;/ALL CAUSES ALL SWITCHES TO BE LISTED
.ALL: MOVEI A,1 ;SAY /ALL
STOR A,LS.ALL,.OFLAG(P1)
RET
;/USER:NAME CAUSES ONLY REQUESTS BY SPECIFIED USER TO BE LISTED
.USER: HELPX <Name of user whose requests are to be listed>
TLZ Z,F1 ;ALLOW DEFAULTING TO LOGGED-IN USER NAME
CALL USRNAM ;GET THE USER NAME
ERROR <Invalid USER name>
MOVE A,C ;USER NUMBER IN A
MOVE B,[2,,.LSUSR] ;SPECIFY USER NAME
CALLRET STASH ;STASH SPECIFIED USER NAME
;/NODE:NAME CAUSES ONLY ENTRIES FOR SPECIFIED NODE TO BE LISTED
;[7.1084]
;/DESTINATION-NODE:NAME CAUSES ONLY ENTRIES FOR SPECIFIED NODE TO BE LISTED
.LNODE: TDZA D,D ;[7.1084] Signal here for Processing-node
.DSNOD: SETOM D ;[7.1084] Signal here for Destination-node
FNODEX <Name of node whose entries should be listed>
CMERRX
CALL GETSXB ;GET SIXBIT VERSION OF NAME
MOVE B,[2,,.ORNOD] ;GET LENGTH OF BLOCK AND TYPE
CALL STASH ;[7.1084] (A,B/ )And stash it
IFN. D ;[7.1084] If processing-node, done
CALL GETPID ;[7.1232] (/A) Get our PID
MOVE B,[2,,.LSPID] ;[7.1084] Put into request block
CALLRET STASH ;[7.1084] (A,B/ )
ENDIF.
RET
;ROUTINE TO STASH A BLOCK FOR GETTING INFORMATION FROM QUASAR
;
;ACCEPTS: A/ DATA WORD
; B/ BLK LEN,,FLAVOR
STASH: STKVAR <FLV,LEN,DW>
MOVEM A,DW ;REMEMBER DATA WORD
HLRZM B,LEN ;REMEMBER LENGTH
HRRZM B,FLV ;REMEMBER FLAVOR
MOVE A,LEN ;GET LENGTH OF NEW BLOCK
LOAD A,AR.LEN,ARG.HD(P2);GET LENGTH OF PREVIOUS BLOCK
ADDB P2,A ;ADVANCE POINTER BEYOND THAT BLOCK
ADD A,LEN ;GET ADDRESS BEYOND NEW BLOCK
CAILE A,1000(P1) ;DOES EVERYTHING FIT?
ERROR <Too many switches>
SUB A,P1 ;COMPUTE NEW ENTIRE MESSAGE LENGTH
STOR A,MS.CNT,.MSTYP(P1);STORE NEW LENGTH
MOVE A,LEN ;GET LENGTH OF NEW BLOCK
STOR A,AR.LEN,ARG.HD(P2);STORE LENGTH OF NEW BLOCK
MOVE A,FLV
STOR A,AR.TYP,ARG.HD(P2);STORE FLAVOR OF NEW BLOCK
MOVE A,DW
MOVEM A,ARG.DA(P2) ;STORE DATA WORD
AOS .OARGC(P1) ;KEEP TRACK OF HOW MANY BLOCKS
RET
DONREQ: CALL UNMAP ;UNMAP SPECIAL PAGES
RET ;RETURN TO CALLER
;ASK FOR OUTPUT-REQUEST LIST
PRLSTQ: MOVEI A,MSHSIZ+.OHDRS+2 ;INITIAL SIZE OF REQUEST
STOR A,MS.CNT,.MSTYP(P1)
MOVEI A,.QOLIS ;WE WANT A LIST
STOR A,MS.TYP,.MSTYP(P1)
SETZM .OFLAG(P1) ;NO FLAGS YET
MOVEI A,1 ;WE'RE SENDING ONE BLOCK
MOVEM A,.OARGC(P1)
MOVEI A,2 ;ARG BLOCK LENGTH IS 2
STOR A,AR.LEN,.OHDRS+ARG.HD(P1)
MOVEI A,.LSQUE ;WE WANT TO LIST THE QUEUES
STOR A,AR.TYP,.OHDRS+ARG.HD(P1)
MOVEI P2,.OHDRS(P1) ;INITIAL "LAST BLOCK" ADDRESS
MOVX A,LIQBAT ;FIRST ASSUME BATCH
CAIN P4,X%PR ;BUT IF DOING OUTPUT REQUESTS,
MOVX A,LIQOUT ;THEN SPECIFY THAT
CAIN P4,X%MO ;MOUNTS?
MOVX A,LIQMNT ;YES
CAIN P4,X%RE ;RETRIEVES?
MOVX A,LIQRET ;YES
MOVEM A,.OHDRS+ARG.DA(P1)
RET
;ROUTINE TO PRINT QUEUES
REQX: STKVAR <ARGCNT>
MOVEI P2,0 ;DENOTES THAT NO POINTER TO LIST ENTRIES IS SET UP YET
REQ: JUMPE P2,REQ9 ;IF NO POINTER YET, THEN GO READ NEXT PAGE FROM QUASAR
SOSG ARGCNT ;ANY MORE BLOCKS LEFT?
JRST [ MOVX A,WT.MOR ;GET BIT FOR CHECKING FOR MORE
TDNN A,IPCFP+.OFLAG
RET ;NO MORE, SO RETURN
JRST REQ9] ;AT LEAST ONE MORE PAGE, GO GET IT
LOAD A,AR.LEN,ARG.HD(P2) ;GET SIZE OF BLOCK JUST PROCESSED
ADD P2,A ;STEP TO NEXT BLOCK
REQ1: LOAD A,AR.TYP,ARG.HD(P2) ;GET FLAVOR OF ARG
CAIE A,.CMTXT ;ONLY PRINT TEXT
JRST REQ ;SKIP OTHER TYPES FOR NOW
UTYPE ARG.DA(P2) ;PRINT QUEUES LISTING
JRST REQ ;GO GET THE REST
REQ9: CALL GQPID ;GET QUASAR'S PID
MOVE B,QIDX ;SAY WHICH MESSAGE WE WANT
CALL IPCRCV ;RECEIVE NEXT PAGE OF DATA
MOVE A,IPCFP+.OARGC
MOVEM A,ARGCNT ;INITIALIZE NUMBER OF ARG BLOCKS AVAILABLE
MOVEI P2,IPCFP+.OHDRS ;GET TO FIRST BLOCK
JRST REQ1 ;GO PROCESS THE BLOCKS
;INITIALIZATION ROUTINE FOR PRINTING QUEUES.
IPRINI: MOVEI P1,BUF0 ;ADDRESS OF IPCF PAGE FOR SENDING LISTING REQUEST TO QUASAR
RET
IDEADL: PSWITCH <DEADLINE:%2D %E>
IAFTER: PSWITCH <AFTER:%2D %E>
;ROUTINE TO PRINT NOTE. CALL WITH SIXBIT IN B'C.
INOTE: HRROI A,[ASCIZ /NOTE/] ;SAY DOING /NOTE
CALLRET ICOMON ;USE COMMON ROUTINE
;ROUTINE TO PRINT DOUBLE SIXBIT SWITCH VALUE. GIVE THIS ROUTINE POINTER
;TO NAME OF SWITCH IN A, AND DOUBLE SIXBIT DATA IN B'C. THE ROUTINE
;OUTPUTS THE SWITCH IN A FORMAT THAT COULD BE INPUT WITH, I.E. WITH
;QUOTES AROUND THE VALUE IF NECESSARY.
ICOMON: STKVAR <<SAVDAT,2>,NAMPT>
MOVEM A,NAMPT ;REMEMBER POINTER TO NAME OF SWITCH
DMOVE A,B ;MOVE NOTE INTO A'B
DMOVEM A,SAVDAT ;SAVE THE DATA
PRN1: LDB C,[360600,,A] ;LOOK AT NEXT CHARACTER OF NOTE
CAIL C,'A'
CAILE C,'Z'
CAIA
JRST PRN2 ;LETTERS ARE ALWAYS ALL RIGHT
CAIN C,'-'
JRST PRN2 ;HYPHEN LEGAL TOO
CAIL C,'0'
CAILE C,'9'
CAIA
JRST PRN2 ;DIGITS ALL RIGHT WITHOUT QUOTES TOO
JUMPN C,PRN3 ;PUT NOTE IN QUOTES IF FUNNY CHARACTER IN IT
JUMPN A,PRN3
JUMPN B,PRN3 ;IF WE SEE AN IMBEDDED SPACE, JUMP
PRN4: DMOVE B,SAVDAT ;NO IMBEDDED SPACES IN THE NOTE
MOVE D,NAMPT ;GET POINTER TO NAME
PSWITCH <%4M:%2'%%3'>
PRN2: LSHC A,6 ;WE'VE SEEN ALL NON-SPACES SO FAR, LOOK AT NEXT CHAR
JUMPN A,PRN1 ;MAKE SURE THERE ARE SOME MORE!
JUMPN B,PRN1
JRST PRN4 ;NO SPACES SEEN IN NOTE
PRN3: MOVE D,NAMPT ;GET POINTER TO NAME
ETYPE </%4M:">
MOVEI D,0 ;NULL FOR FINDING LAST NON-NULL CHARACTER OF NOTE
MOVE A,[440600,,SAVDAT]
PRN5: CAMN A,[000600,,1+SAVDAT]
JRST PRN6 ;DONE IF WE'VE DONE ALL TWELVE CHARACTERS
ILDB B,A ;GET CHARACTER
ADDI B,40 ;CHANGE TO ASCII
CALL COUTC ;TYPE CHARACTER
CAIN B,"""" ;QUOTE MARK IN NOTE?
CALL COUTC ;YES, SO TYPE IT TWICE
DPB D,A ;CLEAR OUT CHARACTER WE JUST PRINTED
SKIPN SAVDAT
SKIPE 1+SAVDAT
JRST PRN5 ;JUMP BACK FOR REST OF CHARACTERS
PRN6: TYPE <" > ;TERMINATING QUOTE FOR SPECIAL NOTE
RET ;DONE FINALLY!
IPRIOR: PSWITCH <PRIORITY:%2Q>
IDESTI: SKIPE B,DEFDST ;[4417]Do we have a default node name
PSWITCH <DESTINATION-NODE:%2'::>
RET ;[4417]
IPROCE: PSWITCH <PROCESSING-NODE:%2'::>
;NODE WHERE BATCH JOB SHOULD BE RUN
.PN: CALL GPNODE ;READ NODE NAME
MOVE A,[IPROCE,,PNODE2]
CALLRET STOR1
PNODE2: MOVEM B,.EQROB+.ROBND(P1) ;STORE PROCESSING NODEE FOR QUASAR
RET
GPNODE: FNODEX <Network node where batch job should be run>
JRST GNODEA ;USE COMMON CODE FOR REST
JRST GNODEB
;NODE SPECIFICATION
.NODE: CALL GDNODE ;GET THE NODE
MOVE A,[IDESTI,,NODE2]
CALLRET STOR1 ;REMEMBER IT
NODE2: MOVE A,PRIFLG ;[4417]GET PRINT FLAG
TXNE A,PR%PRI ;[4417]DOING A PRINT COMMAND
JRST NODE3 ;[4417]YES, HANDLE THIS DIFFERRENTLY
CAIE P4,X%SU ;DIFFERENT PLACE TO STASH DESTINATION NODE OF LOG FILE
MOVEM B,.EQROB+.ROBND(P1)
CAIN P4,X%SU
STOLIM B,.EQLIM(P1),ONOD
RET
NODE3: CALL FILDEF ;[4417](/)Are we filling in DEFAULTS?
JRST NODE4 ;[4417]No, check to see if we should override
SETONE PR%DES,PRIFLG ;[4417]Set DESTINATION is defaulted
MOVE A,PRIFLG ;[4417]GET PRINT FLAG
TXNE A,PR%DDF ;[4417]DID /DEST COME FIRST?
MOVEM B,.EQROB+.ROBND(P1) ;[4417]Yes, save node name
RET
NODE4: CAIE P4,X%SU ;[4417]STASH DESTINATION NODE OF LOG FILE
IFSKP. ;[4417]Yes
STOLIM B,.EQLIM(P1),ONOD ;[4417]Do it.
ELSE.
MOVEM B,.EQROB+.ROBND(P1) ;[4417]Save node name in EQ
SETZRO PR%DES,PRIFLG ;[4417]Clear defaulted /DEST
MOVE A,PRIFLG ;[4417]Get PRINT command flag
TXNN A,PR%QUE!PR%JQN ;[4417]Queue name defaulted?
IFSKP. ;[4417]Yes
HRLI A,.EQRPN(P1) ;[4417]Source=queue/service/port block
HRRI A,.EQRPN+1(P1) ;[4417]source,,destination
SETZM .EQRPN(P1) ;[4417]Clear the first word
BLT A,.EQRPN+6(P1) ;[4417]Clear the block
SETZRO EQ.DLR,.EQSEQ(P1) ;[4418]Clear the DQS or LAT bit
ENDIF.
SETZRO PR%DER,PRIFLG ;[4417]Clear any errors while resolving RP
ENDIF.
RET ;[4417]All done
GDNODE: MOVE Q3,[ASCIZ /LAT/] ;[4402] Set flag in Q3
WORDX <Network node or LAT server to receive output> ;[4402]
GNODEA: CMERRX <Invalid node>
GNODEB: CALL GETSXF ;[4402]Get SIXBIT of node - allow funny chars
MOVE B,A
MOVEM B,DSTNOD ; [7.1073] ...Signal REMOTE-PRINTING we have a dest-node
SKIPN SDF ;[4417]SET DEFAULT?
IFSKP. ;[4417]Yes,
SKIPE SDECHO ;[4417]1st pass?
IFSKP.
MOVEM B,DEFDST ;[4417]Save default /DEST
SETONE PR%DDF,PRIFLG ;[4417]Default /DESTINATION takes precedent
SETZRO PR%RDF,PRIFLG ;[4417]over /REMOTE
SETONE PR%DSL,PRIFLG ;[4417]Seen /DEST in SET DEFAULT PRINT command
ENDIF.
ENDIF.
RET
;SPECIFIC UNIT NUMBER
.UNIT: CALL GUNIT ;GET UNIT
MOVE A,[IUNIT,,UNIT2]
CALLRET STOR1
UNIT2: STOR B,RO.UNI,.EQROB+.ROBAT(P1)
MOVEI A,1 ;SAY "PHYSICAL UNIT SUPPLIED"
STOR A,RO.PHY,.EQROB+.ROBAT(P1)
MOVE B,PRIFLG ;[4417]Get PRINT flag
TXNE B,PR%DEF ;[4417]Filling in defaults
IFSKP. ;[4417]No,
SETZRO PR%DER,PRIFLG ;[4417]Clear any errors while resolving RP
TXNN B,PR%QUE!PR%JQN ;[4417]Do we have defaulted queue name
IFSKP. ;[4417]Yes,
SETZRO EQ.DLR,.EQSEQ(P1) ;[4418]clear the DQS or LAT bit
HRLI A,.EQRPN(P1) ;[4417]Source=queue/service/port block
HRRI A,.EQRPN+1(P1) ;[4417]source,,destination
SETZM .EQRPN(P1) ;[4417]Clear the first word
BLT A,.EQRPN+6(P1) ;[4417]Clear the block
TXNE B,PR%DES ;[4417]Destination Node defaulted?
IFSKP. ;[4417]No, check default remote-printer
SKIPN DSTNOD ;[4417]Destination node in commmand?
SETZM .EQROB+.ROBND(P1) ;[4417]No, clear node name from remote
ELSE.
SKIPE DSTNOD ;[4417]
IFSKP. ;[4417]
MOVE A,DEFDST ;[4417]Ge default node name
MOVEM A,.EQROB+.ROBND(P1) ;[4417]No, clear node name from remote
ENDIF.
ENDIF.
ENDIF.
ENDIF.
RET
IUNIT: MOVE B,DEFUNT ;[4417]GET DEFAULT UNIT
PSWITCH <UNIT:%2Q> ;[3036] DECIMAL UNIT NUMBER
GUNIT: DECX <Decimal unit number>
CMERRX <Invalid unit number>
VERIFY B,C,RO.UNI ;MAKE SURE UNIT FITS IN FIELD
ERROR <Unit number out of range>
SKIPE SDF ;[4417]SET DEFAULT
MOVEM B,DEFUNT ;[4417]YES SAVE IT
RET
IFORMS: PSWITCH <FORMS:%2'>
ITIME: MOVE A,B ;GET NUMBER OF SECONDS IN A
IDIVI A,^D3600 ;LEAVE HOURS IN A, REST IN B
IDIVI B,^D60 ;LEAVE MINUTES IN B, SECONDS IN C
PSWITCH <TIME:%1Q:%2Q:%3Q>
IASSIS: HRROI C,[ASCIZ /NO/]
CAIE B,0
HRROI C,[ASCIZ /YES/]
PSWITCH <ASSISTANCE:%3M>
IRESTA: HRROI C,[ASCIZ /NO/] ;FIRST ASSUME NO
CAIE B,0 ;IS IT?
HRROI C,[ASCIZ /YES/] ;NO, YES
PSWITCH <RESTARTABLE:%3M>
IUNIQU: HRROI C,[ASCII /NO/
ASCII /YES/](B)
PSWITCH <UNIQUE:%3M>
;MODIFY (REQUEST TYPE) REQUEST-TYPE (JOBNAME) JOBNAME /SW/SW/SW/SW
.MODIF::PRISTG ;ALLOCATE STORAGE
SETZM SDF ;[4418]NOT SETTING DEFAULTS
SETZM KEYLVL ;[4418]Counter for levels of tracing aliase
SETZM RPQUE ;[4418]Queue name from /REMOTE
SETZM RPNODE ;[4418]Node name from /REMOTE
SETZM DSTNOD ;[4418]Destination-node
CALL MODINI ;INITIALIZE MODIFY BLOCK
CALL GQUEM ;GET CORRECT QUEUE NAME
MOVEM B,IPCFP+MOD.OT
NOISE (ID)
SETZM ATMBUF ;FIRST ASSUME NO JOBNAME SPECIFIED
CALL GJOB1 ;GET MASK FOR NULL NAME
MOVEM B,IPCFP+MOD.RQ+.RDBJB ;STORE JOB NAME, NULL
MOVEM C,IPCFP+MOD.RQ+.RDBJM ;STORE MASK
MOVEI B,[FLDDB. .CMNUM,CM%SDH,5+5,<Request ID number>,,[
FLDBK. .CMFLD,CM%SDH,,<Jobname, six characters or fewer
or * for all jobs>,,[BRMSK. FLDB0.,FLDB1.,FLDB2.,FLDB3.,<*%_$>]]]
CALL FLDSKP ;READ NUMBER OR WORD
CMERRX
LOAD C,CM%FNC,(C) ;SEE WHAT WAS TYPED
CAIN C,.CMNUM ;NUMBER?
JRST [ MOVEM B,IPCFP+MOD.RQ+.RDBRQ ;YES, REMEMBER IT
JRST MOD1] ;GO GET REST OF SWITCHES
CALL GJOB1 ;JOBNAME, PROCESS IT
MOVEM B,IPCFP+MOD.RQ+.RDBJB ;STORE JOB NAME
MOVEM C,IPCFP+MOD.RQ+.RDBJM ;STORE MASK
MOD1: MOVEI B,[FLDDB. .CMCFM,,,,,[
FLDDB. .CMSWI,,$MODO,<Switch, or parameter to modify,>]]
CAIN P4,X%SU ;DIFFERENT switch TABLE IF MODIFYING BATCH REQUEST
MOVEI B,[FLDDB. .CMCFM,,,,,[
FLDDB. .CMSWI,,$MODSU,<Switch, or parameter to modify,>]]
CAIN P4,X%PR ;USE CORRECT SWITCH LIST
MOVEI B,[FLDDB. .CMCFM,,,,,[
FLDDB. .CMSWI,,$MODPR,<Switch, or parameter to modify,>]]
CALL FLDSKP ;READ END OF LINE OR SWITCH
CMERRX <Invalid MODIFY command>
LDB D,[331100,,(C)] ;SEE WHAT TYPE OF ITEM GOT READ
CAIN D,.CMCFM ;END OF LINE?
JRST MODEOL ;YES
JRST MODSWI ;NO, ASSUME A SWITCH
;GET QUEUE NAME
GQUE: NOISE <REQUEST TYPE>
KEYWD $QUEUE
0 ;NO DEFAULT
CMERRX <Invalid request type>
GQUE1: HLRZ B,(P3) ;GET QUEUE NAME
HRRZ P4,(P3) ;P4 REMEMBERS THE QUEUE NAME
RET
GQUEM: NOISE <REQUEST TYPE>
KEYWD $MQUEU
0 ;NO DEFAULT
CMERRX <Invalid request type>
JRST GQUE1
;TEMP DEFN OF .OTARC SINCE NOT REALLY USED
.OTARC==73
$QUEUE: TABLE
T ARCHIVE,,[.OTARC,,X%AR]
T BATCH,,[.OTBAT,,X%SU]
T CARDS,,[.OTCDP,,X%CP]
T MOUNT,,[.OTMNT,,X%MO]
T PAPER-TAPE,,[.OTPTP,,X%TP]
T PLOT,,[.OTPLT,,X%PL]
T PRINT,,[.OTLPT,,X%PR]
T RETRIEVE,,[.OTRET,,X%RE]
TEND
$MQUEU: TABLE
T BATCH,,[.OTBAT,,X%SU]
T CARDS,,[.OTCDP,,X%CP]
T PAPER-TAPE,,[.OTPTP,,X%TP]
T PLOT,,[.OTPLT,,X%PL]
T PRINT,,[.OTLPT,,X%PR]
TEND
;INITIALIZE IPCFP BLOCK FOR MODIFY MESSAGE
G0SIZ==20
G1SIZ==20 ;SIZE OF GROUPS
MODINI: MOVEI A,MSHSIZ+1+RDBSIZ+G0SIZ+G1SIZ
STOR A,MS.CNT,IPCFP ;STORE MESSAGE SIZE (THE "1" IS FOR THE QUEUE NAME)
MOVEI A,.QOMOD ;SPECIFY THAT THIS IS A MODIFY REQUEST
STOR A,MS.TYP,IPCFP
SETZM IPCFP+MOD.RQ ;CLEAR OUT DESCRIPTOR BLOCK
MOVE A,[IPCFP+MOD.RQ,,IPCFP+MOD.RQ+1]
BLT A,IPCFP+MOD.RQ+RDBSIZ-1
SETOM IPCFP+MOD.FG ;FILL IN -1'S INITIALLY TO MEAN "DON'T MODIFY THIS PARAMETER"
MOVE A,[IPCFP+MOD.FG,,IPCFP+MOD.FG+1]
BLT A,IPCFP+MOD.FG+G0SIZ+G1SIZ-1
MOVEI P1,IPCFP+MOD.FG+1 ;GROUP 0 POINTER
MOVEI P2,G0SIZ(P1) ;LEAVE ROOM FOR GROUP 0 AND POINT TO GROUP 1
MOVEI A,G0SIZ
STOR A,MODGLN,IPCFP+MOD.FG ;FILL IN SIZE OF BLOCK
MOVEI A,.GPMAJ ;FIRST BLOCK IS MAJOR PARAMETERS
STOR A,MODGPN,IPCFP+MOD.FG ;FILL IN GROUP TYPE
MOVEI A,G1SIZ
STOR A,MODGLN,IPCFP+MOD.FG+G0SIZ ;NUMBER OF MINOR GROUP (GROUP 1) ELEMENTS
MOVEI A,.GPQUE ;PARAMETER TYPE
STOR A,MODGPN,IPCFP+MOD.FG+G0SIZ
RET
;END OF LINE SEEN, SEND OFF MODIFY REQUEST
MODEOL: CALL QUASND ;COMMUNICATE WITH QUASAR
CALLRET UNMAP ;CLEAN UP AND RETURN
;SWITCH TYPED DURING MODIFY COMMAND
MODSWI: CALL EXSWI ;EXECUTE THE SWITCH
JRST MOD1 ;LOOP BACK FOR MORE INPUT
;SWITCH EXECUTION ROUTINE
EXSWI: CALL GETKEY ;GET KEYWORD DATA
CALLRET (P3) ;EXECUTE SWITCH
;MODIFY AFTER PARAMETER
.MAFTE: CALL GAFT ;GET NEW AFTER PARAMETER
MOVEM B,0(P1) ;AFTER IS WORD 0 OF GROUP 0
RET
;MODIFY DEADLINE
.MDEAD: CALL GDEAD ;GET NEW PARAMETER
MOVEM B,2(P1) ;WORD 2, GROUP 0
RET
;MODIFY DEPENDENCY-COUNT
.MDEPE: DECX <Decimal DEPENDENCY-COUNT, +n or -n for change, or n for absolute setting>
CMERRX <Invalid DEPENDENCY-COUNT>
MOVEI A,.MODAB ;FIRST ASSUME AN ABSOLUTE VALUE SUPPLIED
CAIGE B,0 ;BUT IF NEGATIVE NUMBER TYPED,
MOVEI A,.MODMI ;THEN VALUE IS SUBTRACTIVE
MOVM B,B ;KEEP ONLY POSITIVE VALUE
LDB C,[350700,,ATMBUF] ;GET FIRST CHARACTER OF NUMBER AS TYPED BY USER
CAIN C,"+" ;PLUS SIGN GIVEN?
MOVEI A,.MODPL ;YES, SO QUANTITY IS ADDITIVE
VERLIM B,SCRLIM,DEPN ;MAKE SURE NUMBER FITS IN ALLOTTED FIELD
ERROR <DEPENDENCY-COUNT out of range>
HRL B,A ;PUT TYPE CODE IN WITH VALUE
MOVEM B,6(P2) ;WORD 6 GROUP 1
RET
;DESTINATION NODE OF LOG FILE
.MNODE: CALL GDNODE ;GET NODE NAME
MOVEM B,5(P1) ;SAVE IN GROUP 0 (MAJOR MOD)
RET
;/LOWERCASE /UPPERCASE /GENERIC
.MLOWE: MOVX A,OBDLLC
JRST MCASE
.MGENE: TDZA A,A
.MUPPE: MOVX A,OBDLUC
MCASE: SETZM 4(P1) ;DEFAULT TO /GENERIC
IORM A,4(P1) ;TURN ON NEW BITS
RET
;OUTPUT DEVICE UNIT
.MUNIT: CALL GUNIT
STOR B,RO.UNI,4(P1)
MOVEI A,1 ;SAY SPECIFIC UNIT SUPPLIED
STOR A,RO.PHY,4(P1)
RET
;PROCESSING-NODE FOR BATCH JOB (WHERE IT GETS RUN!)
.MPNOD: CALL GPNODE
MOVEM B,5(P1)
RET
;FORMS
.MFORM: CALL GFORMS
MOVEM B,0(P2)
RET
;LIMIT
.MLIMI: CALL GLIM
XCT [ MOVEM B,1(P2) ;CARDS
MOVEM B,1(P2) ;PRINT
MOVEM B,2(P2) ;SUBMIT
MOVEM B,1(P2) ;PAPER-TAPE
MOVEM B,1(P2)](P4) ;PLOT
RET
;NOTE
.MNOTE: CALL GNOTE
DMOVEM B,2(P2)
RET
;HEADER, NOHEADER
.MHEAD: TDZA A,A ;HEADERS
.MNOHE: MOVEI A,1 ;NO HEADERS
MOVEM A,4(P2)
RET
;SPACING
.MSPAC: CALL GSPACE
MOVEM B,5(P2)
RET
;MODE
.MMODE: CALL GMODE
MOVEM B,6(P2)
RET
;FILE STYLE
.MFILE: CALL GFILE
MOVEM B,7(P2)
RET
;.MPRES: PRESERVE FILE AFTER PROCESSING
;.MDELE: DELETE FILE AFTER PROCESSING
.MPRES: TDZA A,A
.MDELE: MOVEI A,1
MOVEM A,10(P2)
RET
;NUMBER OF COPIES
.MCOPI: CALL GCOPIE
MOVEM B,11(P2)
RET
;REPORT CODE TO START PRINTING AT
.MREPO: CALL GREPOR
DMOVEM B,12(P2)
RET
;PAGE TO BEGIN PRINTING ON
.MPBEG: CALL GPBEG
MOVEM B,14(P2)
RET
;PRIORITY
.MPRIO: CALL GPRIO
MOVEM B,1(P1)
RET
;RESTART PARAMETER
.MREST: CALL GRES
CALL RESCVT ;CONVERT IT INTO QUASAR FORM
MOVEM B,8(P2)
RET
;LINE NUMBER TO BEGIN ON IN CONTROL FILE
.MSBEG: CALL GSBEG ;READ NUMBER
MOVEM B,5+5(P2) ;REMEMBER
RET
;NUMBER OF SPOOLED PAGES TO ALLOW BATCH JOB TO PRINT
.MPAGE: CALL GPAGES
MOVEM B,2(P2)
RET
;NUMBER OF SPOOLED CARDS JOB MAY PUNCH
.MCARD: CALL GCARDS
MOVEM B,3(P2)
RET
;NUMBER OF FEET OF SPOOLED PAPERTAPE JOB MAY PUNCH
.MFEET: CALL GFEET
MOVEM B,4(P2)
RET
;NUMBER OF MINUTES OF SPOOLED PLOTTER TIME JOB MAY REQUEST
.MTPLO: CALL GTPLOT
MOVEM B,5(P2)
RET
;OUTPUT STATUS OF LOG FILE
.MOUTP: CALL GOUTPU
MOVEM B,9(P2)
RET
;DESTINATION-NODE FOR LOG FILE
.MSNOD: CALL GDNODE
MOVEM B,4+6(P2)
RET
;TIME
.MTIME: CALL GTIME
MOVEM B,1(P2)
RET
;UNIQUENESS
.MUNIQ: CALL GUNI
CALL CVTUNI ;CONVERT TO QUASAR VALUE
MOVEM B,7(P2)
RET
;SWITCH TO HANDLE CASES LIKE "MODIFY PRINT /JOBNAME:5", WHICH IS THE
;ONLY WAY TO MODIFY A BUNCH OF JOBS CALLED "5", SINCE "MODIFY PRINT 5"
;WOULD REFER TO THE SPECIFIC JOB WHOSE REQUEST ID IS 5!
.MJOB: CALL GJOB ;READ THE JOB NAME
MOVEM B,IPCFP+MOD.RQ+.RDBJB ;STORE JOB NAME
MOVEM C,IPCFP+MOD.RQ+.RDBJM ;STORE MASK
RET
;PRIVILEGED USERS MAY SPECIFY /USER TO SPECIFY WHOSE REQUEST IS BEING MODIFIED
.MUSER: USERX <User who owns request(s) being modified>
CMERRX <Invalid request owner>
HRROI A,IPCFP+MOD.RQ+.RDBOW ;STORE OWNER IDENTIFIER
DIRST ;STORE USER NAME
ERCAL CJERRE ;IF FAILS, TELL USER WHY
RET
;SPECIFY SEQUENCE NUMBER OF JOB BEING MODIFIED
.MSEQ: CALL GSEQ ;GET SEQUENCE NUMBER
MOVEM B,IPCFP+MOD.RQ+.RDBES ;STORE SEQUENCE NUMBER
RET
;[4418]
;Modifying /REMOTE-PRINT:
.MREPR:
CALL GPRNTR ;[4418]Get /REMOTE arguments
SKIPN RPQUE ;[4418]Do we have a queue/port/service name
IFSKP. ;[4418]Yes
MOVSI B,(POINT 7,0) ;[4418]Byte pointer
HRRI B,RPQUE ;[4418]Get queue name
MOVSI A,(POINT 7,0) ;[4418]Pointer
HRRI A,G1SIZ(P2) ;[4418]And copy to end of group 1
SETZ C, ;[4418]End on null
CALL ASOUT ;[4418](A,B,C/A,B)Copy string
MOVEI A,G1SIZ+G0SIZ-7 ;[4418]Get the end of group 1
MOVEM A,7(P1) ;[4418]Save the address of where to find Q name
SKIPE B,RPNODE ;[4418]Do we have a node name?
MOVEM B,5(P1) ;[4418]SAVE IN GROUP 0 (MAJOR MOD)
SKIPE B,DSTNOD ;[4418]/DEST:?
MOVEM B,5(P1) ;[4418]SAVE IN GROUP 0 (MAJOR MOD)
ENDIF. ;[4418]
SETZM DSTNOD ;[4418]Clear /DEST:
SETZM RPQUE ;[4418]Clear que/port/service
SETZM RPNODE ;[4418]Clear node
RET
;SWITCHES FOR MODIFYING OUTPUT REQUESTS
DEFINE SLIST <
JOBS <TV AFTER,,.MAFTE>
JOBS <TV BEGIN,,.MSBEG>,B%SU
JOBS <TV BEGIN,,.MPBEG>,B%PR
JOBS <TV CARDS,,.MCARDS>,B%SU
JOBS <TV COPIES,,.MCOPI>,,B%SU
REPEAT 0,<
JOBS <TV DEADLINE,,.MDEAD>
>
JOBS <T DELETE,,.MDELE>,,B%SU
JOBS <TV DEPENDENCY-COUNT,,.MDEPE>,B%SU
JOBS <TV DESTINATION-NODE,,.MNODE>,,B%SU
JOBS <TV DESTINATION-NODE,,.MSNOD>,B%SU
JOBS <TV FEET,,.MFEET>,B%SU
JOBS <TV FILE,,.MFILE>,B%PR
JOBS <TV FORMS,,.MFORM>,,B%SU
JOBS <T GENERIC,,.MGENE>,,B%SU
JOBS <T HEADER,,.MHEAD>,,B%SU
JOBS <TV JOBNAME,,.MJOB>
JOBS <TV LIMIT,,.MLIMI>,,B%SU
JOBS <T LOWERCASE,,.MLOWE>,B%PR
JOBS <TV MODE,,.MMODE>,,B%SU
JOBS <T NOHEADER,,.MNOHE>,,B%SU
JOBS <TV NOTE,,.MNOTE>,,B%SU
JOBS <TV OUTPUT,,.MOUTP>,B%SU
JOBS <TV PAGES,,.MPAGE>,B%SU
JOBS <T PRESERVE,,.MPRES>
JOBS <TV PRIORITY,,.MPRIO>
JOBS <TV PROCESSING-NODE,,.MPNOD>,B%SU
JOBS <TV REMOTE-PRINTER,,.MREPR>,B%PR ;[4418]/REMOTE PRINTER:
JOBS <TV REPORT,,.MREPO>,B%PR
JOBS <TV RESTARTABLE,,.MREST>,B%SU
JOBS <TV SEQUENCE,,.MSEQ>
JOBS <TV SPACING,,.MSPAC>,B%PR
JOBS <TV TIME,,.MTIME>,B%SU
JOBS <TV TPLOT,,.MTPLO>,B%SU
JOBS <TV UNIQUE,,.MUNIQ>,B%SU
JOBS <TV UNIT,,.MUNIT>,,B%SU
JOBS <T UPPERCASE,,.MUPPE>,B%PR
JOBS <TV USER,,.MUSER>
>
;TABLE OF MODIFY SWITCHES FOR PRINT
WUTCMD==B%PR ;SPECIFY PRINT COMMAND
$MODPR: TABLE
BUILDJ ;BUILD TABLE OF FILE SWITCHES
TEND
;TABLE OF MODIFY SWITCHES FOR SUBMIT
WUTCMD==B%SU ;SPECIFY SUBMIT
$MODSU: TABLE
BUILDJ
TEND
;TABLE OF MODIFY SWITCHES FOR EVERYTHING ELSE
WUTCMD==0 ;CATCH-ALL VALUE
$MODO: TABLE
BUILDJ
TEND
;CANCEL (REQUEST TYPE) TYPE NAME /SW/SW/SW
.CANCE::PRISTG ;ALLOCATE STORAGE
CALL KILINI ;INITIALIZE
SETZM JNGF ;NO JOBNAME GIVEN YET
CALL GQUE ;GET QUEUE NAME
CAIN P4,X%AR ;CANCEL ARCHIVE?
JRST CANARC ;YES, GO TO EXEC1 TO DO THAT
MOVEM B,IPCFP+KIL.OT ;STORE IT
NOISE (ID)
MOVSI A,[FLDBK. .CMFLD,CM%SDH,,<Name of request, six characters or fewer,
or * to cancel all requests>,,[BRMSK. FILB0.,FILB1.,FILB2.,FILB3.]]
HRRI A,FBLOCK ;PREPARE TO COPY BLOCK
BLT A,FBLOCK+FBLLEN-1
MOVEI B,[FLDDB. .CMSWI,,CSOTAB,,,[
FLDDB. .CMNUM,CM%SDH,5+5,<Request ID number>,,FBLOCK]]
CAIE P4,X%SU ;BATCH?
CAIN P4,X%MO ;OR MOUNT??
MOVE B,(B) ;YES, NO /SPOOLED-OUTPUT ALLOWED
CAIN P4,X%RE ;CANCEL RETRIEVAL?
MOVE B,(B) ;YES, NO /SPOOL
CALL FLDSKP ;GET SWITCH OR JOB NAME
CMERRX </SPOOLED-OUTPUT, request ID number, or jobname required>
LDB C,[331100,,(C)] ;GET FLAVOR OF INPUT
CAIN C,.CMSWI ;SWITCH?
JRST MCSO ;YES
CAIN C,.CMNUM ;REQUEST ID TYPED?
JRST [ MOVEM B,IPCFP+KIL.RQ+.RDBRQ ;YES, REMEMBER WHAT NUMBER WAS TYPED
SETOM JNGF ;PRETEND JOB NAME WAS GIVEN
SKIPG B ;IS THE REQUEST ID POSITIVE?
ERROR <Request ID must be positive> ;NO, COMPLAIN
JRST KIL1] ;CHECK FOR SWITCHES
MOVSI A,774000 ;JOB NAME GIVEN.
TDNN A,ATMBUF ;MAYBE "CANCEL PRINT /SWITCH"
JRST KIL1 ;YES, NULL JOB NAME BEFORE SLASH DOESN'T COUNT!
CALL GJOB1 ;NO, JOBNAME. GET INTERNAL FORM
MOVEM B,IPCFP+KIL.RQ+.RDBJB
MOVEM C,IPCFP+KIL.RQ+.RDBJM ;STORE NAME AND MASK
SETOM JNGF ;REMEMBER JOB NAME GIVEN
KIL1: MOVEI B,[FLDDB. .CMCFM,,,,,[
FLDDB. .CMSWI,,$KILSW,<Switch,>]]
CALL FLDSKP ;READ END OF LINE OR SWITCH
CMERRX <Invalid CANCEL command>
LDB D,[331100,,(C)] ;SEE WHAT TYPE OF ITEM GOT READ
CAIN D,.CMCFM ;END OF LINE?
JRST KILEOL ;YES
JRST KILSWI ;NO, ASSUME A SWITCH
MCSO: CALL GETKEY ;SEE WHICH SWITCH
CAIN P3,.CSO ;CANCELING SPOOLED OUTPUT?
JRST .CSO ;YES, GO DO IT
CALL (P3) ;EXECUTE THE SWITCH
JRST KIL1 ;GET REST OF SWITCHES
;TABLE OF SWITCHES
CSOTAB: TABLE
T SPOOLED-OUTPUT,,.CSO ;CANCEL SPOOLED OUTPUT
TEND
;SWITCH SEEN...
KILSWI: CALL EXSWI ;EXECUTE THE SWITCH
JRST KIL1 ;GO BACK FOR MORE INPUT
;END OF LINE SEEN ON CANCEL COMMAND
KILEOL: SKIPN JNGF ;MAKE SURE JOB NAME SPECIFIED
ERROR <Jobname or request ID required>
CALL QUASND ;COMMUNICATE WITH QUASAR
CALLRET UNMAP ;CLEAN UP AND RETURN
;SWITCH TABLE FOR CANCEL COMMAND
$KILSW: TABLE
TV DESTINATION-NODE,,.KDNOD ;[7.1084]
TV JOBNAME,,.KJOB
TV SEQUENCE,,.KSEQ ;SPECIFY JOB SEQUENCE NUMBER
TV USER,,.KUSER
TEND
;/JOBNAME TYPED ON KILL. FOR INSTANCE, IF THE USER HAS A BUNCH OF JOBS
;ALL OF WHOSE NAME IS "5", HE KILLS THEM ALL WITH "CANCEL BATCH /JOBNAME:5".
;IN THIS CASE, "CANCEL BATCH 5" LOSES, SINCE "5" IS INTERPRETED AS REQUEST
;ID
.KJOB: CALL GJOB ;GET JOB NUMBER
MOVEM B,IPCFP+KIL.RQ+.RDBJB
MOVEM C,IPCFP+KIL.RQ+.RDBJM ;STORE NAME AND MASK
SETOM JNGF ;REMEMBER THAT JOB NAME GIVEN
RET
;SPECIFY WHOSE REQUEST IS TO BE KILLED (MUST BE ENABLED FOR SOMEONE ELSE TO BE SPECIFIED)
.KUSER: USERX <User who owns request being canceled>
CMERRX <Invalid request owner>
HRROI A,IPCFP+MOD.RQ+.RDBOW ;STORE OWNER IDENTIFIER
DIRST ;STORE USER NAME
ERCAL CJERRE ;IF FAILS, TELL USER WHY
RET
;SPECIFY JOB SEQUENCE NUMBER IN cancel COMMAND
.KSEQ: CALL GSEQ ;GET SEQUENCE NUMBER FOR KILL REQUEST
MOVEM B,IPCFP+KIL.RQ+.RDBES ;STORE SEQUENCE NUMBER
RET
;[7.1084]
;SPECIFY DESTINATION-NODE FOR CANCEL PRINT
.KDNOD: FNODEX <Node on which to cancel print request>
CMERRX
CALL GETSXB ; Get SIXBIT node name
MOVEM A,IPCFP+KIL.ND ; [7.1109] Get and put in EQ block
CALL GETPID ;[7.1232] (/A) Get our PID
MOVEM A,IPCFP+KIL.PD ; And tell QUASAR
RET
;INITIALIZATION ROUTINE FOR KILL COMMAND
KILINI: MOVEI A,KIL.SZ ;[7.1109]
STOR A,MS.CNT,IPCFP ;STORE MESSAGE SIZE
MOVEI A,.QOKIL ;SPECIFY THAT THIS IS A KILL REQUEST
STOR A,MS.TYP,IPCFP
SETZM IPCFP+KIL.RQ ;CLEAR OUT DESCRIPTOR BLOCK
MOVE A,[IPCFP+KIL.RQ,,IPCFP+KIL.RQ+1]
BLT A,IPCFP+KIL.SZ-1 ;[7.1109]
RET
;SET DEFAULT (FOR) CARDS
;SET DEFAULT (FOR) PRINT
;SET DEFAULT (FOR) SUBMIT
;SET DEFAULT (FOR) PAPER-TAPE
;SET DEFAULT (FOR) PLOT
.SDPL:: MOVEI P4,X%PL
JRST SD1
.SDC:: MOVEI P4,X%CP
JRST SD1 ;PUNCH CARDS
.SDT:: MOVEI P4,X%TP ;PUNCH PAPER-TAPE
JRST SD1
.SDS:: MOVEI P4,X%SU
JRST SD1
.SDP:: MOVEI P4,X%PR
SD1: PRISTG ;ALLOCATE STORAGE
SETOM SDF ;REMEMBER THAT WE'RE SETTING DEFAULTS
MOVE A,[IOWD QSLEN,DCSTK
IOWD QSLEN,DPSTK
IOWD QSLEN,DSSTK
IOWD QSLEN,DTSTK
IOWD QSLEN,DPLSTK](P4) ;NO, INITIALIZE IT
MOVEM A,IQPT ;REMEMBER INITIAL POINTER FOR STOR1
SKIPN B,@[DCPT
DPPT
DSPT
DTPT
DPLPT](P4) ;PREVIOUS POINTER?
MOVE B,A ;NO, USE INITIAL POINTER
MOVEM B,QPT ;SAVE STACK POINTER FOR ARGS
SETZM ANYS ;SAY NO SWITCHES SEEN YET
SD2: MOVE B,[SDCFDB
SDPFDB
SDSFDB
SDTFDB
SDPLFB](P4) ;DIFFERENT CHOICES FOR DIFFERENT COMMANDS
SKIPN ANYS ;ANY SWITCHES TYPED YET?
MOVE B,(B) ;NO, SO CR NOT ALLOWED YET
CALL FLDSKP ;GET SOME INPUT
JRST BADDEF ;BAD DEFAULT VALUE TYPED
LDB D,[331100,,.CMFNP(C)] ;FIND OUT WHAT GOT TYPED
CAIN D,.CMCFM ;END OF LINE?
JRST SDEOL ;YES
SETOM ANYS ;MARK THAT SWITCHES HAVE BEEN SEEN
CALL EXSWI ;SWITCH TYPED, EXECUTE IT
JRST SD2 ;GO BACK FOR MORE DEFAULTS
BADDEF: XCT [ CMERRX <Invalid SET DEFAULT CARDS command>
CMERRX <Invalid SET DEFAULT PRINT command>
CMERRX <Invalid SET DEFAULT SUBMIT command>
CMERRX <Invalid SET DEFAULT PAPER-TAPE command>
CMERRX <Invalid SET DEFAULT PLOT command>](P4)
;END OF LINE TYPED
SDEOL: TXNE Z,SETDEF ;WHICH PASS ?
JRST SDEOL1 ;SECOND,FINISH
SETOM SDECHO ;[3017] 1ST PASS DONE - DON'T ECHO THIS AGAIN
;CLEAR SOME FLAGS
MOVEI Z,0 ;CLEAR FLAGS
;DO LIKE IN REPARS ;
MOVE A,[40000,,REPARS] ;FLAG IN SBLOCK
MOVEM A,SBLOCK ;STORE
MOVE A,SBLOCK+3 ;RESTORE TEXT POINTERS
MOVEM A,SBLOCK+4
MOVN A,SBLOCK+5
ADDI A,5*CBUFL ;HOW MANY CHAR PARSED
ADDM A,SBLOCK+6 ;CORRECT COUNTS
ADDM A,SBLOCK+5 ;
MOVE A,.J ;FIX JFN STACK
MOVEM A,.JBUFP ;RESTORE JFN STACK FRAME
CALL FLJFNS ;GET RID OF ANY JFN'S THAT WERE USED FOR COMMAND
CALL DOECHO ;ECHOING MAY HAVE BEEN TURNED OFF FOR PASSWORD
MOVSI 17,CMDACS ;MAKE BLT POINTER CMDACS,,0
BLT 17,17 ;RESTORE AC'S TO HOW THEY WERE WHEN THIS PART OF COMMAND STARTED
SETZM PCLDCO ;PCL Clear original command flag
TXO Z,SETDEF ;FIRST,SET FLAG FOR EXSWI
MOVEI A,RERET ;REGULAR ERROR RETURN ADDRESS
MOVEM A,CERET ;SAY WHERE TO GO AFTER PRINTING ERR MSG
JRST CIN0 ;DO REPARS WHITOUT CLEARING FLAGS
SDEOL1: TXZ Z,SETDEF ;SECOND PASS,CLEAR FLAG
SETZM SDECHO ;[3017]CLEAR "DON'T ECHO THIS AGAIN" FLAG
MOVE A,QPT ;GET FINAL POINTER TO DEFAULT LIST
MOVEM A,@[DCPT
DPPT
DSPT
DTPT
DPLPT](P4) ;STORE POINTER IN CORRECT PLACE
MOVE A,PRIFLG ;[4417]Get the print flag
TXNN A,PR%DSL ;[4417]/DESTINATION the last switch in command?
IFSKP. ;[4417]Yes,
MOVE B,DEFDST ;[4417]Yes, save node name
TXNN A,PR%QUL ;[4417]Do we have just queue name
IFSKP. ;[4417]Yes,
HRROI A,DEFQUE ;[4417]Get just queue name
ETYPE <Default printer is queue/port/service %1M on node %2':: >
ELSE. ;[4417]
TXNN A,PR%RML ;[4417]Do we have /REMOTE
IFSKP. ;[4417]Yes,
HRROI A,RPQUE ;[4417]Get default Que/Port/Service name
ETYPE <Default printer is queue/port/service %1M on node %2':: >
ELSE. ;[4417]
SKIPN B,DEFADR ;[4417]Default /REMOTE already exists?
IFSKP. ;[4417]Yes,
MOVNI A,^D10 ;[4417]Initialize counter
MOVEM A,KEYLVL ;[4417]Save it here
CALL RESLV1 ;[4417]Resolve alias
HRROI A,RPQUE ;[4417]Get default Que/Port/Service name
MOVE B,DEFDST ;[4417]Get node name
ETYPE <Default printer is queue/port/service %1M on node %2'::>
SETONE PR%DDF,PRIFLG ;[4417]/DEST takes precedent over
SETZRO PR%RDF,PRIFLG ;[4417]/REMOTE
SETZRO PR%LFT,PRIFLG ;[4417]Clear the left half
ELSE. ;[4417]
MOVE B,DEFDST ;[4417]Get node name
ETYPE <Default /DESTINATION is %2':: >
ENDIF. ;[4417]
ENDIF. ;[4417]
ENDIF. ;[4417]
ELSE. ;[4417]
TXNN A,PR%QUL ;[4417]Just Queue name?
IFSKP. ;[4417]Yes, but no /DESTINATION!!
SETZM DEFQUE ;[4417]Clear just queue name
SETZRO PR%LFT,PRIFLG ;[4417]Clear the left half
ERROR <Default remote printer is not defined. /DESTINATION: switch is missing.>
ENDIF. ;[4417]
TXNN A,PR%RML ;[4417]/REMOTE the last switch in command?
IFSKP. ;[4417]Yes,
HRROI A,DEFREM ;[4417]Get default remote printer name
HRROI B,RPQUE ;[4417]Get default Que/Port/Service name
MOVE C,RPNODE ;[4417]Get default node name
ETYPE <Default printer is %1M --- %2M on node %3' %_> ;[4417]
ENDIF. ;[4417]
ENDIF. ;[4417]
SETZRO PR%LFT,PRIFLG ;[4417]Clear the left half
RET ;DONE
;SET NO DEFAULT (FOR) SUBMIT
.SNDS:: CONFIRM ;WAIT FOR COMMAND CONFIRMATION
XMOVEI A,DSSTK ;XMOVEI IN CASE WE'RE IN ANOTHER SECTION
XMOVEI B,DSPT ;SPECIFY ADDRESS OF STACK AND ADDRESS OF POINTER
CALL REMDEF ;RELEASE UP FREE SPACE
TYPE <All defaults for SUBMIT command cleared
>
RET
;SET NO DEFAULT (FOR) PAPER-TAPE
.SNDTP::CONFIRM ;WAIT FOR COMMAND CONFIRMATION
XMOVEI A,DTSTK
XMOVEI B,DTPT
CALL REMDEF
TYPE <All defaults for PUNCH PAPER-TAPE command cleared
>
RET
;SET NO DEFAULT (FOR) PLOT
.SNDPL::CONFIRM ;WAIT FOR COMMAND CONFIRMATION
XMOVEI A,DPLSTK
XMOVEI B,DPLPT
CALL REMDEF
TYPE <All defaults for PLOT command cleared
>
RET
;SET NO DEFAULT (FOR) CARDS
.SNDCP::CONFIRM ;WAIT FOR COMMAND CONFIRMATION
XMOVEI A,DCSTK
XMOVEI B,DCPT
CALL REMDEF
TYPE <All defaults for PUNCH CARDS command cleared
>
RET
;SET NOT DEFAULT (FOR) PRINT
.SNDP:: CONFIRM
XMOVEI A,DPSTK
XMOVEI B,DPPT
CALL REMDEF
TYPE <All defaults for PRINT command cleared
>
SETZM DEFREM ;[4417]
SETZM DEFUNT ;[4417]
SETZM DEFDST ;[4417]
SETZM DEFADR ;[4417]
SETZM DEFQUE ;[4417]
RET
;INFO DEF PLOT
.IDPL:: MOVEI P4,X%PL
JRST ID0
;INFORMATION (ABOUT) DEFAULTS (FOR) CARDS
.IDC:: MOVEI P4,X%CP ;IDENTIFY
JRST ID0 ;JOIN COMMON CODE
;INFO DEF PAPER-TAPE
.IDP:: MOVEI P4,X%TP
JRST ID0
;INFO DEF PRINT
.IDPRT::MOVEI P4,X%PR
JRST ID0
;INFO DEF SUBMIT
.IDS:: MOVEI P4,X%SU
ID0: PRISTG ;ALLOCATE STORAGE
TXO Z,INFOF ;SAY DOING INFORMATION
SKIPN @[EXP DCPT,DPPT,DSPT,DTPT,DPLPT](P4) ;ANY DEFAULTS?
RET ;NO!
TYPE < SET DEFAULT >
UTYPE @[[ASCIZ /CARDS/]
[ASCIZ /PRINT/]
[ASCIZ /SUBMIT/]
[ASCIZ /PAPER-TAPE/]
[ASCIZ /PLOT/]](P4)
CALL GRVDEF ;GROVEL THROUGH THE DEFAULTS
ETYPE <%_> ;END OF LINE
RET
;INFORMATION ROUTINES
ICONNE: PSWITCH <CONNECTED-DIRECTORY:%2R>
ISEQUE: PSWITCH <SEQUENCE:%2Q>
IHEADE: HRROI A,[0]
CAIE B,0
HRROI A,[ASCIZ /NO/]
PSWITCH <%1MHEADER>
INOTIF: HRROI A,[ASCIZ /YES/]
CAIN B,0
HRROI A,[ASCIZ /NO/]
PSWITCH <NOTIFY:%1M>
IDELET: HRROI A,[ASCIZ /DELETE/]
CAIN B,0
HRROI A,[ASCIZ /PRESERVE/]
PSWITCH <%1M>
ISPACI: PSWITCH <SPACING:%2Q>
IJOBNA: PSWITCH <JOBNAME:%2'>
IBEGIN: PSWITCH <BEGIN:%2Q>
ICARDS: PSWITCH <CARDS:%2Q>
IDEPEN: PSWITCH <DEPENDENCY-COUNT:%2Q>
IFEET: PSWITCH <FEET:%2Q>
IPAGES: PSWITCH <PAGES:%2Q>
IPROTE: PSWITCH <PROTECTION:%2O>
ITPLOT: PSWITCH <TPLOT:%2Q>
ILOGNA: MOVX A,GJ%SHT ;SHORT FORM
STKVAR <SAVJ>
MOVEM B,SAVJ ;REMEMBER POINTER IN CASE GTJFN FAILS
CALL GTJFS ;GET JFN SO WE CAN PRINT FILESPEC IN STANDARD FORM
JRST [ MOVE A,SAVJ ;GTJFN FAILED, JUST TYPE STRING
PSWITCH <LOGNAME:%1M>]
PSWITCH <LOGNAME:%1S>
ITAG: PSWITCH <TAG:%2'>
ICOPIE: PSWITCH <COPIES:%2Q>
IUSER: PSWITCH <USER:%2R>
IOUTPU: MOVE C,B ;COPY THE SWITCH VALUE
CAIN C,%EQOLG ;GET APPROPRIATE VALUE
HRROI B,[ASCIZ /ALWAYS/]
CAIN C,%EQONL
HRROI B,[ASCIZ /NOLOG/]
CAIN C,%EQOLE
HRROI B,[ASCIZ /ERRORS/]
PSWITCH <OUTPUT:%2M>
IWRITE: MOVE C,B ;COPY THE SWITCH VALUE
CAIN C,%BAPND ;GET APPROPRIATE VALUE
HRROI B,[ASCIZ /APPEND/]
CAIN C,%BSCDE
HRROI B,[ASCIZ /SUPERSEDE/]
CAIN C,%BSPOL
HRROI B,[ASCIZ /SPOOL/]
PSWITCH <BATCH-LOG:%2M>
ICASE: HRROI C,[ASCIZ /LOWERCASE/]
CAIN B,PR%UC
HRROI C,[ASCIZ /UPPERCASE/]
CAIN B,PR%ANY
HRROI C,[ASCIZ /GENERIC/]
PSWITCH <%3M>
ILIMIT: PSWITCH <LIMIT:%2Q>
IMETER: PSWITCH <METERS:%2Q>
IREPOR: HRROI A,[ASCIZ /REPORT/]
CALLRET ICOMON
;[7.1073] No defaults allowed for remote printing
ICHRNM: PSWITCH <CHARACTERISTIC:[Defaults not implemented]>
IRPRNT: SKIPN DEFADR ;[4417]Do we have a default remote printer
IFSKP. ;[4417]Yes,
HRROI B,DEFREM ;[4417]Get Alias name
ELSE. ;[4417]
SKIPN DEFQUE ;[4417]Do we have just a default queue name
IFSKP. ;[4417]Yes,
HRROI B,DEFQUE ;[4417]Get queue name
ELSE. ;[4417]No just queue name or remote printer
RET ;[4417]
ENDIF.
ENDIF.
PSWITCH <REMOTE-PRINTER:%2M>
;PRINT /SPOOLED-OUTPUT, PUNCH PAPER-TAPE /SPOOLED-OUTPUT ETC.
.RSO: CONFIRM ;CONFIRM THE COMMAND
MOVEI A,.DFREL ;SAY RELEASE OUTPUT
CALLRET DEFER ;DO THE WORK AND EXIT
;CANCEL PRINT /SPOOLED-OUTPUT
;CANCEL PAPER-TAPE /SPOOLED-OUTPUT
;ETC.
.CSO: CONFIRM ;CONFIRM THE COMMAND
MOVEI A,.DFKIL ;SAY WE'RE CANCELING
CALLRET DEFER ;DO IT AND RETURN
;CALL THIS ROUTINE TO MUCK WITH DEFERRED OUTPUT. GIVE IT
;FUNCTION IN A.
DEFER: SETZM IPCFP ;CLEAR OUT DESCRIPTOR BLOCK
MOVE B,[IPCFP,,IPCFP+1]
BLT B,IPCFP+DFR.SZ-1
STOR A,DF.FNC,IPCFP+DFR.JB ;STORE FUNCTION
MOVEI A,DFR.SZ
STOR A,MS.CNT,IPCFP ;STORE MESSAGE SIZE
MOVEI A,.QODFR ;SPECIFY THAT THIS IS A DEFER REQUEST
STOR A,MS.TYP,IPCFP
XCT GOTYP ;GET REQUEST TYPE
MOVEM A,IPCFP+DFR.OT ;STORE OBJECT TYPE
MOVE A,JOBNO ;GET JOB NUMBER
STOR A,DF.JOB,IPCFP+DFR.JB ;TELL QUASAR JOB NUMBER
CALL QUASND ;GAB WITH QUASAR
CALLRET UNMAP ;CLEAN UP AND RETURN
;UTILITY ROUTINES FOR IPCF FACILITY
;GET PID FOR EXEC AND INIT PDB'S
;RETURNS PID IN A
GETPID: SKIPE A,MYPID ;HAVE ONE ALREADY?
RET ;YES - RETURN
STKVAR <<GUTIL,3>>
MOVE A,[1000,,<IPCFP>B44]
MOVEM A,SNDPDB+.IPCFP ;PAGE TO USE FOR IPCF SEND
MOVEI A,.MUCRE ;FCN TO CREATE A PID
MOVEM A,GUTIL ;STASH IN BLOCK
LDF A,IP%NOA+.FHSLF ;MINE ONLY
MOVEM A,1+GUTIL
MOVEI A,3 ;SIZE OF BLOCK
MOVEI B,GUTIL ;LOC OF BLOCK
MUTIL ;GET PID
CALL CJERR ;OOPS
MOVE A,2+GUTIL ;RETURNS PID HERE
MOVEM A,MYPID ;STORE OF LATER
MOVEI A,.MUPIC ;WE WANT TO PUT PID ON INTERRUPT CHANNEL
MOVE B,MYPID ;OUR PID
DMOVEM A,GUTIL ;SET UP ARGS FOR MUTIL
MOVEI A,IPCCHN ;CHANNEL ON WHICH TO GET INTERRUPTS
MOVEM A,2+GUTIL
MOVEI A,3 ;LENGTH OF ARG BLOCK
MOVEI B,GUTIL ;ADDRESS OF ARG BLOCK
MUTIL ;POST INTERRUPT REQUEST
ERCAL JERR ;SHOULDN'T FAIL
MOVE A,MYPID ;[7.1232] Really return our PID for caller
RET ;RETURN
;ROUTINE TO SEND REQUEST TO QUASAR AND HANDLE ACKNOWLEDGEMENT
;IT RETURNS UNIQUE ID FOR IDENTIFYING RESPONSES
QUASND::STKVAR <SAVQCX>
AOS A,UNIQUE ;GET AN IDENTIFICATION NUMBER
MOVEM A,IPCFP+.MSCOD
MOVEM A,SAVQCX ;REMEMBER IT
MOVEI A,1 ;SAY WE WANT AN ACKNOWLEDGEMENT
SETZM .MSFLG+IPCFP ;[7.1242] But first clear left over data
STOR A,MF.ACK,.MSFLG+IPCFP
CALL GNPID ;[7.1232] (/A) Get NEBULA's PID because it may respond
CALL GQPID ;GET QUASAR'S PID
MOVE B,A
CALL SNDMS1 ;SEND THE REQUEST
CALL CJERR ;FAILED, TELL USER WHY
PRITXT: MOVE B,SAVQCX ;MATCH CODE WITH MESSAGE COMING BACK
MOVE A,QSRPID ;RECEIVE FROM QUASAR
CALL IPCRCV ;GET ANSWER
HRROI B,IPCFP+.OHDRS+ARG.DA ;GET POINTER TO MESSAGE
MOVE A,IPCFP+.MSFLG ;GET MESSAGE CONTROL BITS
TXNE A,MF.NOM ;ANY MESSAGE?
JRST PRI2 ;NO, SO WE MIGHT BE DONE
TXNN A,MF.FAT+MF.WRN ;NOT WARNING OR FATAL ERROR?
JRST PRIT1 ;RIGHT, SO JUST PRINT INFORMATIONAL MESSAGE
TXNE A,MF.FAT ;FATAL?
UERR (B) ;RIGHT, SO PRINT MESSAGE AS AN ERROR AND DON'T RETURN
UETYPE [ASCIZ /%%%2M%%_/] ;WARNING MESSAGE, PRINT AS SUCH
PRI2: TXNE A,MF.MOR ;MORE?
JRST PRITXT ;YES - GO GET IT
MOVE A,SAVQCX ;RETURN ID IN A
RET ;NO, WE'RE DONE
PRIT1: LDB C,[POINT 7,0(B),6]
CAIE C,"["
CAIN C,"%"
SKIPA
CAIN C,"?"
JRST [UETYPE [ASCIZ /%2M%%_/]
JRST PRI2 ]
UETYPE [ASCIZ /[%2M]%_/]
JRST PRI2
;GET PID OF INFO
;STORES IT IN INFPID AND A. ASSUMES THAT NON-ZERO INFPID IS GOOD PID.
GIPID: SKIPE A,INFPID ;ALREADY EXIST?
RET ;YES, WE'RE DONE
MOVEI A,.SPINF ;SAY WE WANT INFO'S PID
CALL GSPID ;GET PID OF INFO
CALL JERRE ;NO ERROR HANDLER (YET!)
MOVEM A,INFPID ;REMEMBER IT
RET
;GET PID OF MDA (MOBY DEVICE ANIMAL)
GMDPID: SKIPE A,MDAPID ;GOT IT ALREADY?
RET ;YES
MOVEI A,.SPMDA ;SAY WE WANT MDA'S PID
CALL GSPID ;GET SPECIAL PID
CALL JERRE ;FAILED
MOVEM A,MDAPID ;REMEMBER IT SO NO GYRATIONS NEXT TIME THROUGH
RET
;[7.1232]
;GNPID - Get NEBULA's PID.
;
; Call with:
; no arguments
; CALL GNPID
;
; Returns:
; +1 - Always, with:
; A/ PID of NEBULA
; NEBPID/ PID of NEBULA
GNPID:: SKIPE A,NEBPID ;Get NEBULA's PID if we have it
RET ;We had it, so done
MOVEI A,.SPNEB ;Say we want NEBULA's PID
CALL GSPID ;(A/A) Get his PID
SETZ A, ;Couldn't, oh, well, say we don't have one
MOVEM A,NEBPID ;Save NEBULA's PID
RET
;GET PID OF QUASAR
GQPID:: SKIPE A,QSRPID ;ALREADY HAVE ONE?
RET ;YES, DONE
CALL GQPID1 ;TRY TO GET PID
JRST GQPID2 ;FAILED, PRINT MESSAGE AND TRY AGAIN
RET ;GOT IT, RETURN
GQPID2: TYPE <%Waiting for QUASAR to start...
>
GQPID3: MOVEI A,^D3000 ;SLEEP FOR 3 SECONDS AND TRY AGAIN
DISMS
CALL GQPID1 ;TRY AGAIN
JRST GQPID3 ;DIDN'T GET IT YET
RET ;GOT IT
GQPID1: MOVEI A,.SPQSR ;SAY WE WANT QUASAR'S PID
CALL GSPID ;GET SPECIAL PID
RET ;FAILED
MOVEM A,QSRPID ;GOT IT
RETSKP
;ROUTINE TO GET A SPECIAL PID. CALL IT WITH FUNCTION IN A. SKIPS WITH PID IN A.
;NON-SKIP MEANS ERROR IN AC1.
GSPID: STKVAR <SPID,<QUTILB,3>>
MOVEM A,SPID ;REMEMBER SPECIAL FUNCTION
MOVEI A,3 ;LENGTH OF ARGUMENT BLOCK
MOVEI B,QUTILB ;ADDRESS OF ARG BLOCK
MOVEI C,.MURSP ;DESIRED FUNCTION (GET PID FROM SYSTEM PID TABLE)
MOVEM C,QUTILB ;STORE FUNCTION
MOVE C,SPID ;GET SPECIAL FUNCTION
MOVEM C,1+QUTILB ;STORE INDEX WE WANT
MUTIL ;GET DESIRED PID
RET ;FAILED, SINGLE RETURN
MOVE A,2+QUTILB ;GOT PID
RETSKP
SUBTTL GQSRPD - GET PID OF USER'S PRIVATE QUASAR
;PID FORMAT IS [USERNAME]QUASAR
;[7.1232] Also gets [USERNAME]NEBULA for NEBULA's PID. If there
;is no NEBULA running, then it doesn't look for a private NEBULA.
GQSRPD:: TRVAR <USERID>
MOVEM A,USERID ;SAVE THE USERID
JUMPN A,GQSR.1 ;IF SET,,SKIP THIS
SETOM A ;WANT THIS JOB
HRROI B,USERID ;PUT USER ID HERE
MOVEI C,.JIUNO ;WANT USER NUMBER
GETJI ;GET IT
CALL CJERR ;NO GOOD !!
GQSR.1: SETZM IPCFP+.IPCI1 ;NO MESSAGE COPY
HRROI A,IPCFP+.IPCI2 ;TEXT OUTPUT ADDRESS
MOVEI B,"[" ;GET LEFT BRACKET
BOUT ;PUT IT OUT
MOVE B,USERID ;GET THE USER ID BACK
DIRST ;CONVERT IT TO THE USER NAME
CALL CJERR ;NO GOOD
HRROI B,[ASCIZ /]QUASAR/] ;GET REST OF PID NAME
SETZ C, ;END ON NULL
SOUT ;END THE NAME '[USERNAME]QUASAR'
MOVE A,[1,,.IPCIW] ;CODE,,FCN
MOVEI B,0 ;SEND TO INFO
CALL SNDMSG ;GO SEND MESSAGE
CALL CJERR
GQSR.2: CALL GIPID ;GET PID OF INFO
CALL IPCRCV ;RECEIVE MESSAGE FROM INFO
TXNE A,IP%CFE+IP%CFM ;QUASAR THERE?
JRST NOPQSR ;NO QUASAR JOB YET...
MOVE A,IPCFP ;GET RETURNED WORD
CAME A,[1,,.IPCIW] ;CHECK EXPECTED
JRST GQSR.2 ;TRY AGAIN
MOVE A,IPCFP+.IPCI1 ;THIS IS THE PID WE WANT
MOVEM A,QSRPID ;SAVE IT
CALL GNBPID ;[7.1232] Get private NEBULA PID
RET ;AND RETURN
;[7.1232]
;GNBPID - Get private NEBULA PID after getting private QUASAR PID.
;This is "invisible". That is if we fail, then we assume that cluster
;GALAXY is not being tested so we don't care about NEBULA.
;
; Called with:
; No arguments
; CALL GNBPID
;
; Returns:
; +1 - Always
GNBPID: SETZM NEBPID ;Say we don't have NEBULA's PID yet
SETZM IPCFP+.IPCI1 ;No message copy
MOVEI A,IPCFP+.IPCI2 ;Text output address
HRLI A,(POINT 7,) ;Make a byte pointer
MOVEI B,"[" ;Get left bracket
IDPB B,A ;Stick in left bracket
MOVE B,USERID ;Get the user ID back
DIRST% ;Convert it to the username
ERJMP R ;If we can't do this, then forget it
HRROI B,[ASCIZ /]NEBULA/] ;Get rest of PID name
SETZ C, ;End on null
SOUT% ;End the name '[USERNAME]NEBULA'
ERJMP .+1 ;Surely, you jest
MOVE A,[1,,.IPCIW] ;Code,,Function
MOVEI B,0 ;Send to [SYSTEM]INFO
CALL SNDMSG ;(A,B/) Go send message
RET ;That's life in the big city
GNBPD2: CALL GIPID ;(/A) Get PID of [SYSTEM]INFO
CALL IPCRCV ;(A/) Receive message from [SYSTEM]INFO
TXNE A,IP%CFE+IP%CFM ;NEBULA there?
RET ;No
MOVE A,IPCFP ;Get returned word
CAME A,[1,,.IPCIW] ;Check expected
JRST GNBPD2 ;Try again
MOVE A,IPCFP+.IPCI1 ;This is the PID we want
MOVEM A,NEBPID ;Save it
RET ;And done
;NO PRIVATE QUASAR YET!
NOPQSR: TYPE <%Waiting for Private QUASAR to Start...
>
MOVEI A,^D5000 ;GET 5 SECONDS
DISMS ;WAIT 5 SECONDS
JRST GQSR.1 ;AND TRY AGAIN
;ROUTINE TO DO RECEIVE (PACKET AND PAGE MODE)
;THIS ROUTINE TAKES THE PID IN A WHOSE MESSAGE YOU WANT TO RECEIVE. IT
;RETURNS THE MESSAGE IN IPCFP AND THE FLAGS, AS RECEIVED IN .IPCFL, IN A.
;IF A IS QUASAR'S PID (AS ADVERTISED BY QSRPID), B CONTAINS THE IDENTIFICATION
;NUMBER YOU ARE RECEIVING.
IPCRCV::TRVAR <SAVIFG,MESIDN,QUAIDN,SAVIPP> ;MUST NOT BE STKVAR DUE TO SAVIPP
MOVEM A,MESIDN ;REMEMBER IDENTIFIER OF MESSAGE
MOVEM B,QUAIDN ;REMEMBER IDENTIFIER FOR QUASAR MESSAGE
MOVEM P,SAVIPP ;REMEMBER STACK IN CASE NOTRANSPARENT INTERRUPT OUT OF SUBROUTINE
IPCAGN: MOVE P,SAVIPP ;IN CASE INTERRUPTED OUT OF SUBROUTINE
CALL IPCOFF ;PREVENT NEW MESSAGES WHILE WE'RE PERUSING
MOVE A,MESIDN ;GET IDENTIFYING INFORMATION
MOVE B,QUAIDN
CALL IPCFND ;FIND THE MESSAGE IN THE QUEUE
JRST NOMESS ;IT'S NOT THERE
MOVE C,IPCFGS(B) ;GET FLAGS THAT GO WITH MESSAGE
MOVEM C,SAVIFG ;REMEMBER FLAGS
MOVEI A,IPCBPN(B) ;GET PAGE NUMBER OF MESSAGE
LSH A,9+22 ;9 TO MAKE ADDRESS, 22 TO PUT IT IN LEFT HALF
HRRI A,IPCFP ;BLT POINTER TO MOVE MESSAGE TO IPCFP
BLT A,IPCFP+777 ;MOVE ENTIRE MESSAGE
MOVE A,B ;SAY WHICH MESSAGE TO FLUSH
CALL IPCFLS ;FLUSH MESSAGE FROM BUFFER
CALL IPCON ;TURN COM CHANNEL BACK ON
MOVE A,SAVIFG ;GIVE CALLER THE FLAGS
RET ;DONE
;HERE WITH IPCF QUEUE INDEX TO FLUSH A MESSAGE FROM THE QUEUE. THIS IS DONE,
;FOR INSTANCE, IF THE MESSAGE IS ONE WE'VE BEEN WAITING FOR AND HAVE JUST
;RECEIVED, OR THE MESSAGE IS ONE WE'VE DECIDED WE NEVER WANT.
IPCFLS: HRRI B,IPCBPN(A) ;GET PAGE NUMBER OF PAGE BEING ERASED
SETZM IPCTBL(A) ;CLEAR THE SLOT
HRROI A,-1 ;PREPARE TO REMOVE PAGE FROM OUR MAP
HRLI B,.FHSLF ;REMOVE FROM OURSELF
MOVEI C,0 ;NO REPETITION COUNT
PMAP ;REMOVE PAGE
SKIPL OLDIDX ;IS THERE A WAITING MESSAGE?
SETOM IPCWTF ;YES, SIGNAL INTERRUPT TO READ IT IN
SETOM OLDIDX ;[3015] PREVENT INFINITE LOOPING IN NOMESS
RET
;HERE IF MESSAGE WE WERE LOOKING FOR ISN'T RECEIVED YET
NOMESS: MOVEI A,IPCAGN ;ADDRESS TO GO BACK TO NEXT TIME A MESSAGE COMES IN
MOVEM A,IPCCTL ;SET UP CONTROL WORD SAYING WHERE TO GO WHEN NEXT MESSAGE RECEIVED
CALL IPCON ;TURN ON INTERRUPTS AGAIN
SKIPGE OLDIDX ;IS THERE A MESSAGE WAITING?
WAIT ;NO, WAIT FOR A COM INTERRUPT (TO IPCAGN)
CALL IPCFLM ;YES, FLUSH OLD MESSAGE AND FORCE INTERRUPT
;ROUTINE TO SKIP IF A SOUGHT MESSAGE HAS ARRIVED. HAND IT IN REGISTER
;A THE PID FROM WHOM YOU WANT A MESSAGE. IF THE PID IS QUASAR'S, SUPPLY
;THE .MSCOD IN REGISTER B. IF YOU GIVE QUASAR'S PID, THIS ROUTINE WILL MATCH
;A MESSAGE FROM EITHER QUASAR OR MDA.
;WHEN SKIPS, A CONTAINS ADDRESS OF MESSAGE
;ALSO ON SKIP, B CONTAINS BUFFER SLOT NUMBER OF MESSAGE.
;THIS ROUTINE IS CAREFUL TO DELIVER OLDER MESSAGES BEFORE NEWER ONES, AND
;TO THROW AWAY "DEAD LETTERS"
IPCFND::STKVAR <IPCIX,IPCCAN,IPCOLD,MESPID,QUAID2>
MOVEM A,MESPID ;REMEMBER PID OF MESSAGE WE'RE LOOKING FOR
MOVEM B,QUAID2 ;REMEMBER QUASAR IDENTIFICATION
SETOM IPCCAN ;SAY THERE ARE NO CANDIDATES YET
HRLOI A,377777 ;START WITH OLDEST BIRTHDAY SO FAR AS SOMETHING IN FUTURE
MOVEM A,IPCOLD
MOVEI A,IPCMAX ;INITIALIZE POINTER TO IPCF QUEUES
MOVEM A,IPCIX
FM1: SOSGE C,IPCIX ;STEP TO NEXT SLOT TO EXAMINE
JRST FM2 ;NO, EVERYTHING'S BEEN CONSIDERED
SKIPN IPCTBL(C) ;ANY MESSAGE IN THIS SLOT?
JRST FM1 ;NO, SKIP IT
MOVE A,MESPID ;GET PID OF MESSAGE WE'RE LOOKING FOR
CAMN A,IPCTBL(C) ;HAVE WE JUST FOUND ENTRY?
IFSKP. ;[7.1232]
CAME A,QSRPID ;[7.1232] Doesn't match. Are we seeking a QUASAR message?
JRST FM4 ;[7.1232] No, so definitely doesn't match
CALL GMDPID ;SEEKING QUASAR MESSAGE, GET MDA'S PID
MOVE C,IPCIX
CAMN A,IPCTBL(C) ;IS CURRENT MESSAGE FROM MDA?
JRST IPCFN1 ;YES, ACCEPT IT AS THOUGH FROM QUASAR
CALL GNPID ;[7.1232] (/A) Now try NEBULA's
MOVE C,IPCIX ;[7.1232] Get index
CAME A,IPCTBL(C) ;[7.1232] Message from NEBULA?
JRST FM4 ;[7.1232] Seeking QUASAR, but current isn't from either QUASAR, MDA or NEBULA so doesn't match
ENDIF.
IPCFN1: MOVE A,MESPID
CAME A,QSRPID ;WE MAY HAVE FOUND MESSAGE. ARE WE SEEKING A QUASAR MESSAGE?
JRST FM3 ;NO, SO WE'VE DEFINITELY WON
MOVEI D,IPCBPN(C) ;YES, GET PAGE NUMBER CONTAINING MESSAGE
LSH D,9 ;MAKE ADDRESS OF MESSAGE
MOVE D,.MSCOD(D) ;GET QUASAR IDENTIFICATION CODE
CAME D,QUAID2 ;IS IT THE CORRECT CODE?
JRST FM4 ;NO, KEEP SEARCHING FOR MESSAGE
FM3: MOVE A,IPCAGE(C) ;GET BIRTHDAY OF INTERESTING MESSAGE
CAML A,IPCOLD ;IS THIS ONE OLDER THAN BEST SO FAR?
JRST FM1 ;NO, NOT TIME TO DELIVER THIS ONE
MOVEM A,IPCOLD ;YES, REMEMBER BIRTHDAY OF THIS ONE
MOVEM C,IPCCAN ;REMEMBER CANDIDATE
JRST FM1
FM2: SKIPGE C,IPCCAN ;ANY CANDIDATES?
RET ;MESSAGE NOT FOUND
MOVE B,C ;RETURN SLOT NUMBER IN B
LSH C,9 ;MAKE ADDRESS
ADDI C,IPCBUF ;MAKE ABSOLUTE ADDRESS OF MESSAGE
MOVE A,C ;RETURN MESSAGE ADDRESS IN A
RETSKP ;SKIP TO SHOW MESSAGE FOUND
;GET TO HERE FROM ABOVE WHEN MESSAGE ENCOUNTERED IN THE QUEUE ISN'T ONE WE'RE
;LOOKING FOR. VERIFY HERE IF ANYONE IS LOOKING FOR IT. IF NOT, FLUSH IT
;SO AS TO FREE UP ITS SLOT IN THE QUEUE
FM4: SKIPN A,IPCTBL(C) ;GET PID THAT SENT THIS MESSAGE
JRST FM1 ;EMPTY SLOT, SO ITS ALREADY FLUSHED
CAMN A,QSRPID ;[7.1232] Did QUASAR send it?
IFSKP. ;[7.1232] If not,
CAMN A,MDAPID ;[7.1232] How about MOUNTR?
JRST FM41 ;[7.1232] Yes
CAME A,NEBPID ;[7.1232] And last, is it NEBULA?
JRST FM5 ;[7.1232] No, so flush it
; JRST FM41 ;[7.1232] It's NEBULA, so use it
ENDIF. ;[7.1232]
FM41: MOVEI B,IPCBPN(C) ;[7.1232] QUASAR sent it, get its page number
LSH B,9 ;GET ADDRESS OF MESSAGE IN BUFFER
MOVE B,.MSCOD(B) ;GET ID OF MESSAGE WE'RE EXAMINING
MOVEI D,NOWPTR ;SCAN PENDING MOUNTS
FMLUP: SKIPN D,MLNK(D) ;MORE BLOCKS IN LINK?
JRST FM5 ;NO, SO FLUSH MESSAGE
CAME B,MQID(D) ;IS THIS MESSAGE ONE WE'RE WAITING FOR?
JRST FMLUP ;NO, KEEP LOOKING
JRST FM1 ;YES, DON'T FLUSH IT
;HERE IF WE'VE DECIDED TO FLUSH THE MESSAGE
FM5: MOVE A,C ;INDEX OF MESSAGE TO FLUSH
CALL IPCFLS ;FLUSH JUNK MESSAGE FROM QUEUE
JRST FM1 ;CONTINUE SCANNING FOR ORIGINAL MESSAGE
;CALL IPCHEK TO PRINT RESPONSES FROM IPCF MESSAGES WHICH HAVE BEEN
;RECEIVED. WHEN THIS IS DONE:
;
; o AT COMMAND LEVEL, IF SOME MESSAGES HAVE ARRIVED
;
; o WITHIN IPCF INTERRUPT, IF BUFFER IS FULL
IPCHEK::CALLRET CHECKM ;CHECK FOR COMPLETED /NOWAITS AND RETURN
;INTERRUPT TO HERE WHEN AN IPCF MESSAGE IS SENT TO US
IPCINT::SKIPN IPCALF ;ALLOWED TO DO IPCF INTERRUPTS?
SETOM IPCWTF ;NO, SO REMEMBER THAT THERE'S ONE WAITING
SKIPN IPCALF ;ALLOWED TO TAKE IPCF INTERRUPTS?
DEBRK ;NO, SO DON'T DO ANYTHING
SETZM IPCWTF ;YES, SO SAY NONE WAITING ANYMORE
CALL SAVACS ;DON'T CLOBBER CODE THAT WAS RUNNING
CALL IPCIN1 ;WORK IN SUBROUTINE SO STK/TRVAR MAY BE USED
SKIPE A,IPCCTL ;GET SPECIAL PLACE TO DISMISS TO
MOVEM A,PCTAB+LV.IPC ;YES, TELL MONITOR TO GO THERE
SETZM IPCCTL ;REQUIRE IPCCTL TO BE SET UP IF WANTED AGAIN
CALL NACL ;SKIP IF NOT AT COMMAND LEVEL
JRST [ CALL IPCHEK ;AT COMMAND LEVEL, ANNOUNCE RECEIPT OF MESSAGE
MOVEI A,CMDIN4
MOVEM A,PCTAB+LV.IPC ;FORCE EXEC TO REPROMPT
JRST .+1]
CALL RESACS ;RESTORE AC'S
DEBRK
;THE FOLLOWING ROUTINE RECEIVES ANY OUTSTANDING IPCF MESSAGES. IT IS CALLED
;AT INTERRUPT LEVEL. DO NOT CALL IT OUTSIDE OF INTERRUPT LEVEL, SINCE IT
;MAY GET INTERRUPTED AND CALLED FROM THE MIDDLE OF ITSELF, CAUSING AN IPCF
;MESSAGE TO BE LOST
IPCIN1: STKVAR <<RCVPDB,PDBSIZ+1>,IPSLOT,ISAGE>
HRLOI A,377777 ;START WITH VERY YOUNG MESSAGE AS OLDEST SO FAR
MOVEM A,ISAGE
IPCMR1: MOVEI A,IPCMAX ;GET NUMBER OF SLOTS IN MESSAGE TABLE
IPB1: SOJL A,IPBE2 ;NO FREE SLOT, GO CREATE ONE
SKIPE IPCTBL(A) ;FIND A FREE SLOT?
JRST [ MOVE B,IPCAGE(A) ;NO, GET BIRTHDAY OF OLD MESSAGE
CAML B,ISAGE ;OLDEST SEEN SO FAR?
JRST IPB1 ;NO
MOVEM B,ISAGE ;YES, REMEMBER OLDEST AGE SEEN SO FAR
MOVEM A,OLDIDX ;REMEMBER INDEX OF OLDEST SEEN
JRST IPB1] ;CONTINUE LOOKING FOR FREE SLOT
IPBE3: SETOM OLDIDX ;TELL IPCRCV AND CHECKM THERE'S A FREE SLOT
MOVEM A,IPSLOT ;REMEMBER WHICH SLOT WE'RE USING
IPCMOR: MOVEI A,IPCBPN(A) ;GET IPCF BUFFER PAGE NUMBER
IPB3: HRLI A,1000 ;MESSAGE IS 1000 WORDS LONG
MOVEM A,.IPCFP+RCVPDB
SETOM .IPCFR+RCVPDB ;WE WANT MESSAGE FOR ANY PID WE OWN
MOVX A,IP%CFB!IP%CFV ;DON'T BLOCK, PAGE MODE
MOVEM A,.IPCFL+RCVPDB
DORCV: MOVEI A,PDBSIZ ;PDB SIZE
MOVEI B,RCVPDB ;PDB ADDR
MRECV ;RECEIVE MSG
JRST [CAIE A,IPCF15 ;NO PID CREATED YET? (SUCH AS AT STARTUP)
CAIN A,IPCFX2 ;ERROR SAYS NO MORE MESSAGES?
RET ;YES, DONE
CAIE A,IPCF16 ;WRONG DATA MODE?
JRST [SETOM IPCWTF ;NO, UNEXPECTED ERROR - SET MSG WAITING
MOVEI A,JERRE ;GET ERROR ROUTINE TO EXECUTE
MOVEM A,IPCCTL ;EXIT TO THERE IF WE CAN
RET ] ;AND RETURN
MOVX A,IP%CFV ;YES, GET PAGE BIT
ANDCAM A,.IPCFL+RCVPDB ;TRY NON-PAGE MODE
HRRZ A,.IPCFP+RCVPDB ;GET PAGE NUMBER
LSH A,9 ;CONVERT PAGE NUMBER TO AN ADDRESS
HRRM A,.IPCFP+RCVPDB ;SAVE ADDRESS IN PDB
JRST DORCV]
MOVE A,.IPCFC+RCVPDB ;GET CAPS OF SENDER
TXNN A,SC%WHL!SC%OPR ;PRIVILEGED?
JRST [MOVE A,IPSLOT ;NO, GET OLD SLOT BACK
JRST IPCMOR ] ;IGNORE THIS MESSAGE AND GET NEXT
MOVE A,.IPCFS+RCVPDB ;GOOD MESSAGE, GET PID OF SENDER
MOVE B,IPSLOT ;GET INDEX FOR STORING MESSAGE
SETOM IPCRCF ;MARK THAT SOME MESSAGES HAVE BEEN RECEIVED
MOVEM A,IPCTBL(B) ;SAVE THIS ENTRY
MOVE A,.IPCFL+RCVPDB ;GET FLAGS
MOVEM A,IPCFGS(B) ;SAVE FLAGS
AOS A,UNIQUE ;GET A BIRTHMARK FOR THIS MESSAGE
MOVEM A,IPCAGE(B) ;SO WE'LL KNOW WHAT ORDER TO DELIVER MESSAGES
JRST IPCMR1 ;LOOP FOR MORE MESSAGES
;GET HERE WHEN THERE'S NO ROOM TO PUT A WAITING MESSAGE
IPBE2: SKIPE IPCCTL ;IS SOMEONE LOOKING FOR SOMETHING?
JRST [ SETOM IPCWTF ;YES, FORCE INTERRUPT TO HAPPEN AGAIN
RET] ;MAYBE WHAT WE WANT HAS ARRIVED!
MOVEI A,20 ;SEE IF THERE'S ANOTHER PACKET WAITING
MOVEM A,RCVPDB
SETOM 1+RCVPDB ;FOR ANY PID WE OWN
MOVEI A,PDBSIZ+1 ;ARG BLOCK SIZE
MOVEI B,RCVPDB ;ARG BLOCK ADDR
MUTIL
ERJMP [CAIE A,IPCFX2 ;ERROR SAYS NO MORE MESSAGES?
CALL JERRE ;NO, UNEXPECTED ERROR
SETOM OLDIDX ;TELL IPCRCV AND CHECKM
RET] ;THAT NO MESSAGE IS WAITING
RET ;WE CAN'T RECEIVE MESSAGE, IPCRCV OR CHECKM CAN FLUSH
IPCFLM::STKVAR <IOLDPD> ;SUBROUTINE TO FLUSH OLD MESSAGES
CALL IPCOFF ;TURN OFF INTERRUPTS DURING FLUSH
MOVE C,OLDIDX ;GET INDEX OF MESSAGE BEING FLUSHED (OLDEST IN QUEUE)
MOVE B,IPCTBL(C) ;GET SENDER OF MESSAGE WE'RE FLUSHING
MOVEM B,IOLDPD ;REMEMBER PID OF MESSAGE BELING FLUSHED
ETYPE <%_%%%EXEC: IPCF buffer full; discarding message(s)>
CALL GQPID ;GET QUASAR'S PID
CAMN A,IOLDPD ;IS THE MESSAGE FROM QUASAR?
ETYPE < from QUASAR%_>
CALL GMDPID ;SEE IF FROM MDA
CAMN A,IOLDPD
ETYPE < from MDA%_> ;FEEL FREE TO ADD!
MOVE A,OLDIDX ;GET INDEX OF OLD MESSAGE
CALL IPCFLS ;THROW IT AWAY
CALL IPCON ;TURN ON INTERRUPTS (ONE WILL BE TAKEN)
RET ;AND GO BACK (CLEANING UP)
;ROUTINE TO SEND MSG TO PID IN B
;FCN CODE IN A
SNDMSG::MOVEM A,IPCFP+.IPCI0 ;STASH CODE
SNDMS1::MOVEM B,SNDPDB+.IPCFR ;PID TO SEND TO
CALL GETPID ;MAKE SURE WE HAVE A PID
LDF A,IP%CFS+IP%CFV ;FLAGS
MOVEM A,SNDPDB+.IPCFL
MOVEI A,MYPID ;SET UP SENDERS PID
MOVEM A,SNDPDB+.IPCFS
MOVEI A,4 ;PDB SIZE
MOVEI B,SNDPDB
MSEND ;XMIT
JRST BADPID ;GO CHECK FOR INVALID PID
RETSKP ;OK RETURN
;TABLE OF KNOWN SPECIAL SYSTEM PIDS
SPTBL: QSRPID,,GQPID ;CELL HOLDING PID,,ROUTINE TO INIT PID
MDAPID,,GMDPID
INFPID,,GIPID
NEBPID,,GNPID ;[7.1232] NEBULA's PID
SPLEN==.-SPTBL ;NUMBER OF ENTRIES IN TABLE
BADPID: CAIE A,IPCFX4 ;IS PROBLEM "RECEIVER'S PID INVALID"?
RET ;NO, LET CALLER HANDLE IT
MOVEI A,SPLEN ;INDEX INTO SPECIAL PID TABLE
MOVE B,.IPCFR+SNDPDB ;GET BAD PID
BAD1: SOJL A,[MOVEI A,IPCFX4 ;MESSAGE WASN'T BEING SENT TO SPECIAL PID, LET CALLER HANDLE PROBLEM
RET]
HLRZ C,SPTBL(A) ;GET ADDRESS OF CELL CONTAINING SPECIAL PID
CAME B,(C) ;HAVE WE FOUND THE BAD PID?
JRST BAD1 ;NOT YET, KEEP LOOKING
SETZM (C) ;FORCE THIS PID TO BE RECALCULATED
HRRZ A,SPTBL(A) ;GET ROUTINE TO CALL
CALL (A) ;RECALCULATE REQUESTED PID
MOVE B,A ;GET REVISED PID IN B
JRST SNDMS1 ;GO TRY TO RESEND MESSAGE
SUBTTL FILDEF - CHECK TO SEE IF WE ARE FILLING IN DEFAULTS
;FILDEF - Check PRIFLG to see if we filling in the defaults.
; returns +1 not doing defaults
; returns +2 doing defaults
FILDEF: MOVE A,PRIFLG ;[4417]Get the print flag word
TXNN A,PR%DEF ;[4417]Doing defaults?
RET ;[4417]No, +1 return
RETSKP ;[4417]Yes, +2 return
END