Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_1_19910112
-
6-1-exec/execqu.mac
There are 47 other files named execqu.mac in the archive. Click here to see a list.
;[SRI-NIC]SRC:<6-1-EXEC>EXECQU.MAC.44, 10-May-89 16:20:16, Edit by MKL
; add /TWOSIDED (same as DOUBLE)
;[SRI-NIC]SRC:<6-1-EXEC>EXECQU.MAC.42, 17-Feb-89 02:02:59, Edit by MKL
; cleanup SLISTs. alphabetize properly!
;SRC:<6-1-EXEC>EXECQU.MAC.37, 21-Apr-87 11:15:11, Edit by KNIGHT
;SRC:<6-1-EXEC>EXECQU.MAC.36, 10-Feb-87 15:21:15, Edit by KNIGHT
; Don't blast FP.FFF ever, no one uses FORTRAN here anyhows
;SRC:<6-1-EXEC>EXECQU.MAC.35, 3-Oct-86 09:42:11, Edit by KNIGHT
; Only blast FP.FFF only if FORTRAN file, we set it earlier
;SRC:<6-1-EXEC>EXECQU.MAC.34, 3-Oct-86 08:27:51, Edit by KNIGHT
; Map PKT file for SET DEFAULT...
;SRC:<6-1-EXEC>EXECQU.MAC.33, 30-Sep-86 16:11:09, Edit by KNIGHT
; Pagereversal and collation for print command
;SRC:<6-1-EXEC>EXECQU.MAC.32, 30-Sep-86 10:21:10, Edit by KNIGHT
;SRC:<6-1-EXEC>EXECQU.MAC.31, 22-Sep-86 10:31:10, Edit by KNIGHT
; Default to LSRSPL if ASCII file and LASER command
;SRC:<6-1-EXEC>EXECQU.MAC.30, 15-Aug-86 13:57:10, Edit by KNIGHT
; PSSSPL, not PSSPL (I know, it's a kludge)
;SRC:<6-1-EXEC>EXECQU.MAC.29, 15-Aug-86 10:33:41, Edit by KNIGHT
;SRC:<6-1-EXEC>EXECQU.MAC.28, 13-Aug-86 12:50:05, Edit by KNIGHT
; Append a space to PSSPL
;SRC:<6-1-EXEC>EXECQU.MAC.27, 12-Aug-86 10:00:42, Edit by KNIGHT
;SRC:<6-1-EXEC>EXECQU.MAC.26, 11-Aug-86 16:43:32, Edit by KNIGHT
; Specify a spooler if no unit specified, QUASAR will pick a unit from that
;SRC:<6-1-EXEC>EXECQU.MAC.25, 11-Aug-86 15:40:43, Edit by KNIGHT
; Make modify /unit do the right thing
;SRC:<6-1-EXEC>EXECQU.MAC.24, 11-Aug-86 12:51:08, Edit by KNIGHT
; Merge PRINT, LASER and TPRINT commands, make .FPFPS get set on both
; FDB contents and extensions
;SRC:<6-1-EXEC>EXECQU.MAC.23, 28-Jul-86 09:50:55, Edit by KNIGHT
; .LSUNI, not .LSUNT
;SRC:<6-1-EXEC>EXECQU.MAC.22, 28-Jul-86 09:28:17, Edit by KNIGHT
;SRC:<6-1-EXEC>EXECQU.MAC.21, 28-Jul-86 09:17:18, Edit by KNIGHT
; Explicitly parse unit keyword without using KEYWD UUO
;SRC:<6-1-EXEC>EXECQU.MAC.20, 25-Jul-86 16:05:05, Edit by KNIGHT
; Allow INFORMATION OUTPUT /UNIT
;SRC:<6-1-EXEC>EXECQU.MAC.19, 25-Jul-86 12:24:59, Edit by KNIGHT
; Rework UNIT code so that we send printer name to QUASAR, who will then do
; the translation to a real unit number
; Use PKTPAG+.UTOFF as an index, not a table start
;SRC:<6-1-EXEC>EXECQU.MAC.18, 25-Jul-86 09:42:03, Edit by KNIGHT
;SRC:<6-1-EXEC>EXECQU.MAC.17, 24-Jul-86 15:54:56, Edit by KNIGHT
;SRC:<6-1-EXEC>EXECQU.MAC.15, 24-Jul-86 14:35:31, Edit by KNIGHT
; GUNIT now uses printer keywords, not unit numbers
;SRC:<6-1-EXEC>EXECQU.MAC.13, 6-Mar-86 14:01:36, Edit by KNIGHT
; Invalid TPRINT...not invalid PLOT command...
;SRC:<6-1-EXEC>EXECQU.MAC.12, 25-Feb-86 14:18:10, Edit by KNIGHT
;SRC:<6-1-EXEC>EXECQU.MAC.11, 20-Feb-86 14:01:48, Edit by KNIGHT
;SRC:<6-1-EXEC>EXECQU.MAC.10, 20-Feb-86 13:08:09, Edit by KNIGHT
; Add MODIFY FOREIGN-PRINTER, CANCEL
;[SRI-NIC]SRC:<6-1-EXEC>EXECQU.MAC.6, 2-Dec-85 16:34:56, Edit by MKL
; EM34 User IPCF, CS141 pid stuff
;SRC:<6-1-EXEC>EXECQU.MAC.5, 4-Nov-85 10:35:14, Edit by KNIGHT
; Define .CANON
;SRC:<6-1-EXEC>EXECQU.MAC.4, 4-Nov-85 09:52:42, Edit by KNIGHT
; Flush ROTATE switch
;SRC:<6-1-EXEC>EXECQU.MAC.3, 4-Nov-85 09:41:37, Edit by KNIGHT
; Dike Stanford font, reverse, etc. code with NICSW
; Fix typo on IFE NICSW conditional
;SRC:<6-1-EXEC>EXECQU.MAC.2, 1-Nov-85 16:05:17, Edit by KNIGHT
;NIC changes:
; [NIC1026] LASER and PRINT now default to /NOTIFY:NO
; [NIC1004] Added LASER and disabled CANON. For some reason, the latter
; doesn't work. Set LASER defaults to reverse and collate.
;<6-1-EXEC.FT6>EXECQU.MAC.2, 12-Aug-85 13:25:55, Edit by WHP4
;FT6 merge
;Stanford changes:
; Remove account stuff
; Extensive CANON laser printer support
; Default to /NOHEADER/NOTIFY:YES
; Add hack to prohibit printing of binary files (keys on extensions)
; Fix MODIFY PRINT /NOHEADER and /HEADER to work, not to do the opposite
; /ROTATE command for Canon. Implemented by simulating /MODE:BCD
; Pass a string to LPTSPL for foreign switches
; Fix double occurence of the /SPACING: switch for PRINT/CANON commands
; CSLI Changes: CANON/LPT default of unit:0
;Sierra changes:
; PRINI sets default output device to unit 0 for PRINT and CANON
;GSB changes:
; /MVP for /DESTINATION-NODE:MVP::
; IBM6640 spooler support
;LOTS changes:
; /CERAS, /TERMAN
;LOTS/GSB changes:
; /HOLD, /RELEASE
; need WHEEL for multiple copies
;SUMEX/CSLI changes
; Add SUMEX style IMAGEN support and implement the /REVERSE switch
;
; 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
;TOPS20 'EXECUTIVE' COMMAND LANGUAGE
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. 1980,1985
;ALL RIGHTS RESERVED.
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)
IFN STANSW,<
IFN GSBSW,<
DEFSM IB,10 ;IBM6640 DEFINITIONS
DEFSM AI,11 ;ADMISSIONS IBM6640
>;IFN GSBSW
>;IFN STANSW
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
<
IFE STANSW,<
TRVAR <JNGF,ANYS,SDF,ASYF,<FDBBLK,FDBSIZ>,<SCRLIM,EQLMSZ>,IQPT,QPT,QIDX,FSIZE,NEWJFN,PRIJFN,SAVEA,PRESF,FILSF,CSF>
>;IFE STANSW
IFN STANSW,<
IFE GSBSW,<
TRVAR <JNGF,ANYS,SDF,ASYF,<FDBBLK,FDBSIZ>,<SCRLIM,EQLMSZ>,IQPT,QPT,QIDX,FSIZE,NEWJFN,PRIJFN,SAVEA,PRESF,FILSF,CSF>
>;IFE GSBSW
IFN GSBSW,<
TRVAR <JNGF,ANYS,SDF,ASYF,<FDBBLK,FDBSIZ>,<SCRLIM,EQLMSZ>,IQPT,QPT,QIDX,FSIZE,NEWJFN,PRIJFN,SAVEA,PRESF,FILSF,CSF,IBM6F,IBM6M>
>;IFN GSBSW
>;IFN STANSW
>
;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
IFN NICSW,<
LASERF==1B6 ;ON IF DOING LASER COMMAND
TPRINF==1B7 ;ON IF DOING TPRINT COMMAND
>;IFN NICSW
;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
IFE NICSW,<
.PLOT:: MOVEI P4,X%PL ;SAY THIS IS "PLOT"
JRST X1 ;FINISH LIKE THE REST OF 'EM
>;IFE NICSW
IFN NICSW,<
.PLOT:: TXZ Z,LASERF ;NOT A LASER COMMAND
TXO Z,TPRINF ;BUT IT IS A TPRINT COMMAND
JRST XALLL ;JOIN COMMON CODE
>;IFN NICSW
;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
IFN NICSW,<
.CANON::
.LASER: TXZ Z,TPRINF
TXOA Z,LASERF ;'Cause I always fergit .CANON
>;IFN NICSW
IFE NICSW,<
IFN STANSW,<
.CANON::SKIPA P4,[X%CP] ;CANON COMMAND USES THE CDP DEVICE
>;IFN STANSW
>;IFE NICSW
.PRINT::
IFN NICSW,<
TXZ Z,LASERF!TPRINF ;NOT LASER COMMAND
XALLL:
>;IFN NICSW
MOVEI P4,X%PR
X1: NOISE (FILES)
X2: PRISTG ;ALLOCATE LOCAL STORAGE
IFN STANSW,<
IFN GSBSW,<
SETZM IBM6F ;NO IBM6640 COMMAND SEEN YET
;NONZERO VALUE IN HERE INDICATES UNIT NUMBER
SETZM IBM6M ;NO MAGCARDS-IBM6640 COMMAND SEEN YET.
>;IFN GSBSW
>;IFN STANSW
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
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
IFN NICSW,<
TXNE Z,LASERF!TPRINF ;TPRINT OR LASER COMMAND?
JRST YESSS ;YES, DON'T USE /SPOOLED-OUTPUT
>;IFN NICSW
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 [IFE STANSW,<CMERRX <Invalid PUNCH CARDS command>>
IFE NICSW,<
IFN STANSW,<
IFE CSLISW!SUMXSW,<CMERRX <Invalid CANON command>>
IFN CSLISW!SUMXSW,<CMERRX <Invalid IMPRINT command>>
>;IFN STANSW
>;IFE NICSW
IFN NICSW,<CMERRX <Invalid LASER command>> ;[NIC1004]
CMERRX <Invalid PRINT command>
CMERRX <Invalid SUBMIT command>
CMERRX <Invalid PUNCH PAPER-TAPE command>
IFE NICSW,<
CMERRX <Invalid PLOT command>](P4)
>;IFE NICSW
IFN NICSW,<
CMERRX <Invalid TPRINT command>](P4)
>;IFN NICSW
;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
IFE STANSW,<
MOVX C,1B2+1B5+1B8+1B11+1B14+JS%PAF ;WE WANT COMPLETE FILESPEC, PUNCTUATED
HRRZ B,PRIJFN ;GET JFN
JFNS ;STORE THE NAME
>;IFE STANSW
IFN STANSW,<
CAIE P4,X%PR ;PRINT COMMAND?
IFSKP. ;YES.
PUSH P,A
PUSH P,D
MOVE D,A ;REMEMBER WHERE WE PUT IT...
SETZM 0(D) ;SET THAT WORD TO NULLS...
HRRZ B,PRIJFN
MOVX C,FLD(.JSAOF,JS%TYP) ;WANT EXTENSION ONLY
JFNS% ;CONVERT IT
MOVEI A,ILLEXT ;GET ADDRESS OF ILLEGAL EXTENSION TABLE
MOVE B,0(D) ;GET THE EXTENSION RETURNED...
DO.
MOVE C,0(A) ;GET AN ILLEGAL EXTENSION
IFN. C ;IS THERE ONE?
CAME B,C ;IS THE EXTENSION ILLEGAL?
AOJA A,TOP. ;NO--LOOP UP TO TOP
ERROR <Illegal to PRINT binary files>
ENDIF.
ENDDO.
POP P,D
POP P,A
ENDIF.
MOVX C,FLD(.JSAOF,JS%DEV)!FLD(.JSAOF,JS%DIR)!FLD(.JSAOF,JS%NAM)!FLD(.JSAOF,JS%TYP)!JS%PAF
MOVE B,PRIJFN ;GET JFN
TXNN B,GJ%UHV ;HIGHEST VERSION SPECIFIED?
TXO C,FLD(.JSAOF,JS%GEN) ;NO, INCLUDE GENERATION IN JFNS
HRRZS B
JFNS% ;STORE NAME
>;IFN STANSW
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
IFN STANSW,<
ILLEXT: ASCII/ABS/
ASCII/APL/
ASCII/BIN/
ASCII/CAL/
ASCII/CKP/
ASCII/DMS/
; ASCII/DVI/
ASCII/EXE/
ASCII/HGH/
IFN GSBSW,<
ASCII/IMP/
>;IFN GSBSW
ASCII/LOW/
ASCII/MUS/
ASCII/MUSE/
ASCII/OVR/
ASCII/PLO/
ASCII/PLT/
IFN GSBSW,<
ASCII/PRESS/
>;IFN GSBSW
ASCII/REL/
ASCII/SAV/
ASCII/SHR/
ASCII/SYM/
ASCII/UNV/
Z ;THIS TABLE MUST END WITH A ZERO
>;IFN STANSW
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
IFN STANSW,<
IFN GSBSW,<
;PRTIBM - PRINT A FILE ONTO THE IBM6640 PRINTER BY CALLING THE IBMPRT.EXE
; PROGRAM
PRTIBM: CAIE A,1 ;ONLY ONE AT A TIME (A POLICY) ON IBM6
CMERRX <Only one file may be queued for the IBM6640 with a single PRINT command>
MOVEI P2,EQHSIZ(P1) ;RESET FILE PARAMETER POINTER
CALL GETFP ;GET THE FILE NAME
HRLI A,(POINT 7,) ;MAKE A BYTE POINTER OUT OF THE NAME POINTER
MOVEM A,RSPTR ;WILL DUMP THIS STRING INTO RSCAN BUFFER
DO.
ILDB B,A ;MOVE BYTE POINTER TO END OF FILENAME STRING.
JUMPN B,TOP.
ENDDO.
MOVNI B,1 ;MOVE THE POINTER ONE BACK (sigh)
ADJBP B,A
MOVE A,B
SKIPN IBM6M ;PRINTING ON MAGCARDS?
IFSKP.
HRROI B,[ASCII\ /MAG\] ;PUT IN " /MAG" (FOR MAGNETIC CARDS)
MOVNI C,5 ;IN RSCAN BUFFER.
SOUT%
ENDIF.
SETZ B,
MOVE C,IBM6F ;GET UNIT NUMBER
CAIN C,1 ;WAS ITS VALUE ONE? (BASEMENT IBM)
HRROI B,[ASCII\ /BAS\] ;YES - USE IT
CAIN C,2 ;WAS ITS VALUE TWO? (ADMISSIONS IBM)
HRROI B,[ASCII\ /ADM\] ;YES - USE IT
SKIPN B ;IF NEITHER,THEN SOMETHING STRANGE;USE DEFAULT
IFSKP.
MOVNI C,5 ;IN RSCAN BUFFER.
SOUT%
ENDIF.
MOVEI B,"J"-100 ;END THE LINE WITH A LINE FEED.
IDPB B,A
HRROI B,[ASCIZ/SYS:IBMFPR.EXE/] ;WANT IBMPRT.EXE
JRST PERUN ;go run it as an ephemeron
>;IFN GSBSW
>;IFN STANSW
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
IFN STANSW,<
IFN GSBSW,<
SKIPE IBM6F ;IBM6640 FLAG?
JRST PRTIBM ;YEP...
>;IFN GSBSW
>;IFN STANSW
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,FLD(.JSAOF,JS%TYP) ;WE WANT THE EXTENSION
MOVE A,CSBUFP ;WRITE IT INTO FREE SPACE
JFNS ;GET EXTENSION
IFN NICSW,<
TXNN Z,TFILES ;IS /FILE SWITCH IN EFFECT?
SKIPE FILSF
RET ;YES, LEAVE NOW
MOVE A,CSBUFP ;GET EXTENSION
HRROI B,[ASCIZ /IMP/] ;SEE IF EXTENSION IS "IMP"
STCMP%
MOVEI C,.FPFAS ;GET ASCII CODE
IFE. A ;IS IT "IMP"?
MOVEI C,.FPFIM ;YES
ELSE.
MOVE A,CSBUFP ;GET EXTENSION
HRROI B,[ASCIZ /PS/] ;SEE IF EXTENSION IS "PS"
STCMP%
IFE. A
MOVEI C,.FPFPS ;FILE TYPE IS PostScript
ELSE.
HRRZ A,PRIJFN ;GET THE JFN AGAIN
MOVE B,[1,,.FBCTL] ;GET THE FDB'S FLAG WORD
MOVEI C,B ;STASH IT IN B
GTFDB%
IFJER.
MOVEI C,.FPFAS ;ON FAILURE, ASSUME ASCII FILE
ELSE.
MOVEI C,.FPFAS ;ASSUME ASCII FILE
LOAD B,FB%FCF,B ;GET THE FILE TYPE
CAIN B,.FBIMP ;IMPRESS?
MOVEI C,.FPFIM ;YES
CAIN B,.FBPS ;PostScript?
MOVEI C,.FPFPS ;YES
ENDIF.
ENDIF.
ENDIF.
LOAD A,RO.ATR,.EQROB+.ROBAT(P1) ;GET THE PHYSICAL UNIT FLAG
CAIN A,%PHYCL ;NOT SET YET?
IFSKP.
SETZ A, ;INDICATE NO SPOOLER SELECTED YET
CAIN C,.FPFIM ;IMPRESS FILE?
MOVE A,[SIXBIT/LSRSPL/] ;THIS IS THE IMPRESS SPOOLER
CAIN C,.FPFPS ;PostScript FILE?
MOVE A,[SIXBIT/SPDSPL/] ;THIS IS THE PostScript SPOOLER
IFE. A
IFXN. Z,LASERF
MOVE A,[SIXBIT/LSRSPL/] ;THIS IS THE IMPRESS SPOOLER
ELSE.
MOVE A,[SIXBIT/LPTSPL/] ;ELSE, USE THIS SPOOLER
ENDIF.
ENDIF.
STOLIM A,.EQLIM(P1),SPNAME ;STORE IT
MOVE B,CNGEAR ;GET STORAGE AREA
STOR C,FP.FFF,.FPINF(B) ;STORE INFORMATION AWAY
ENDIF.
>;IFN NICSW
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
IFE NICSW,<
TRYDAT: TXNN Z,TFILES ;IS /FILE SWITCH IN EFFECT?
SKIPE FILSF
RET ;YES, LEAVE
IFE STANSW,<
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
>;IFE STANSW
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
>;IFE NICSW
IFN NICSW,<
TRYDAT:
LSTSEN:
>;IFN NICSW
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
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,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
CALLRET GROVEX ;GROVEL THROUGH REAL ARGS
;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
JUMPE A,R ;RETURN IF THERE ARE NO DEFAULTS
;ELSE FALL INTO GROVEX
GROVEX: ADJSP Q2,1-ISIZ ;SO FIRST INCREMENT GETS TO BEGINNING
GRV1: ADJSP Q2,ISIZ ;POINT TO NEXT ENTRY
CAML Q2,QPT ;STILL IN THE STACK ?
RET ;NOPE-GO AWAY
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
IFE STANSW,<
ACC2 ;ACCOUNT STRING
>;IFE STANSW
IFN STANSW,<
IFN SUMXSW,<
ACC2 ;ACCOUNT STRING
>;IFN SUMXSW
>;IFN STANSW
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
; FILS <TV BEGIN,,.PB> ;BEGIN ON SPECIFIC PAGE
JOBS <TV BEGIN,,.SBEG>,B%SU ;BEGIN PROCESSING ON SPECIFIC LINE
FILS <T BOOK>,B%PR ;[NIC1004] TWO FORMS, SIDE BY SIDE
; JOBS <TV CARDS>,B%SU ;NUMBER OF CARDS JOB IS ALLOWED TO PRINT
FILS <TV COLLATION>,B%PR ;[NIC1004] COPY COLLATION
JOBS <TV CONNECTED-DIRECTORY,,.BCON>,B%SU ;DIRECTORY TO CONNECT BATCH JOB TO
FILS <TV COPIES>,B%PR ;HOW MANY COPIES
FILS <T DELETE>,B%PR ;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
FILS <T DOUBLE>,B%PR ;[NIC1004]
;[NIC1004] TWO FORMS, ABOVE AND BELOW
; 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
; FILS <TV FILE>,,B%SU ;[NIC1004] WHICH TYPE OF FILE IT IS
; FILS <TV FONT>,B%PR ;TO SPECIFY A FONT FOR THE CANON
; JOBS <TV FOREIGN-SWITCHES,,.FORSW>,B%PR ;FOREIGN SWITCHES
FILS <TV FORMLENGTH>,B%PR ;[NIC1004] LINES PER PAGE
; JOBS <TV FORMS>,B%PR ;KIND OF PAPER TO USE
FILS <TV FORMWIDTH>,B%PR ;[NIC1004] CHARACTERS PER LINE
JOBS <T GENERIC>,B%PR ;[NIC1004] ANY UNIT
FILS <T HEADER>,B%PR ;[NIC1004] HEADER FOR PRINT ONLY
; JOBS <T HOLD>,B%PR ;HOLD PRINT UNTIL RELEASED
; FILS <T IBM6640,,.IBM66>,B%PR ;PRINT ON THE IBM 6640
JOBS <TV JOBNAME,,.GOBNA> ;SPECIFY NON-DEFAULT JOBNAME
FILS <T LANDSCAPE>,B%PR ;[NIC1004] ROTATE THE PAGE
FILS <TV LEFTMARGIN>,B%PR ;[NIC1004] LEFT MARGIN OFFSET
JOBS <TV LIMIT>,B%PR ;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
; FILS <T MAGCARDS-IBM6640,,.IBM6M>,B%PR ;PRINT ON THE IBM6640 MAGCARDS
; JOBS <TV METERS>,B%TP ;PUNCH SO MANY METERS OF PAPER TAPE
FILS <TV MODE>,B%PR ;[NIC1004] MODE FOR PRINT ONLY
; JOBS <T MVP,,.MVP>,B%PR ;/MVP FOR /DESTINATION-NODE:MVP::
FILS <T NOHEADER>,B%PR ;[NIC1004] NOHEADER FOR PRINT ONLY
; JOBS <T NOHOLD>,B%PR ;DON'T HOLD PRINT
JOBS <TV NOTE>,B%PR ;PUT NOTE ON OUTPUT
JOBS <TV NOTIFY> ;GET NOTIFICATION WHEN REQUEST IS PROCESSED
; FILS <TV OUTLINES>,B%PR ;PUT OUTLINE BOX AROUND IMAGEN OUTPUT
JOBS <TV OUTPUT>,B%SU ;CONTROL WHETHER LOG FILE GETS PRINTED
; JOBS <T P391,,.TF391>,B%PR ;/P391 FOR /DESTINATION-NODE:TF::
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
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
FILS <T REVERSE>,B%PR ;REVERSE PAGES ON IMAGEN OUTPUT
; FILS <TV REVERSE>,B%PR ;REVERSE PAGES ON IMAGEN OUTPUT
; FILS <T ROTATE>,B%CP ; "/ROTATE" switch for LSRSPL, to be generalized
; JOBS <T ROTATE,,.ROTA>,B%PR ; "/ROTATE" SWITCH FOR THE LN01
; FILS <TV ROTATE>,B%PR ;ROTATE IMAGEN OUTPUT (LANDSCAPE MODE)
; FILS <TV RULELINES>,B%PR ;PUT RULELINES ON IMAGEN OUTPUT
JOBS <TV SEQUENCE> ;SEQUENCE NUMBER OF REQUEST
; FILS <TV SPACING>,B%PR ;SINGLE OR DOUBLE SPACING
; FILS <TV SPACING> ;SINGLE OR DOUBLE SPACING
FILS <TV SPACING>,B%PR ;SINGLE OR DOUBLE SPACING
FILS <T STANDARD>,B%PR ;[NIC1004] STANDARD PAGE LAYOUT
JOBS <TV TAG>,B%SU ;START PROCESSING AT THIS TAG
FILS <T TEKTRONIX>,B%PR ;SELECT TEK4014 EMULATION ON CANON
; JOBS <T TERMAN,,.TERMA>,B%PR ;/TERMAN FOR /DESTINATION-NODE:TERMAN::
JOBS <TV TIME,,.QUTML>,B%SU ;SPECIFY EXECUTION TIME LIMIT FOR JOB
FILS <TV TOPMARGIN>,B%PR ;[NIC1004] TOP OFFSET
JOBS <TV TPLOT>,B%SU ;SPECIFY PLOTTER TIME JOB IS ALLOWED
FILS <TV TWOCOLUMNS,,.BOOK>,B%PR ;TWO COLUMN IMAGEN OUTPUT
IFN NICSW,<
FILS <T TWOSIDES,,.TWOSD>,B%PR ;TWO SIDED PRINTING (ON HP)
>
; FILS <TV TYPESIZE>,B%PR ;POINT SIZE OF COUR FONT FOR IMAGEN
JOBS <TV UNIQUE>,B%SU ;SPECIFY UNIQUENESS OF JOB (WHETHER CONCURRENCY ALLOWED OR NOT)
JOBS <TV UNIT>,B%PR ;[NIC1004] SPECIFY UNIT NUMBER
; 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
;WHEN THE USER TYPES "?" AFTER THE WORD "PRINT", HE WANTS TO SEE TWO
;DISTINCT LISTS. HOWEVER, NOTE THAT THERES "/FORMS" IN ONE LIST AND "/FILE" IN
;THE OTHER. HENCE WHEN USER TYPES "/F$", HE SHOULD GET A DING BECAUSE
;IT'S AMBIGUOUS. ALSO, "/F" SHOULD BE AN ERROR, FOR THE SAME REASON.
;HOWEVER, THE WAY MONITOR WORKS, "/F" WILL MATCH /FORMS UNIQUELY BECAUSE
;MONITOR DOESN'T CHECK MORE THAN ONE LIST IF SOMETHING MATCHES. HENCE
;TO MAKE THINGS WORK DESIRABLY, WE MUST INCLUDE ALL SWITCHES IN BOTH
;LISTS, AND ARRANGE FOR EACH LIST TO HAVE THE APPROPRIATE ENTRIES MARKED
;AS "INVISIBLE", SO THAT USER WILL JUST SEE TWO SEPARATE DIFFERENT LISTS
;AND "/F" WILL ACT AMBIGUOUS. TO DO ALL THIS, THE FOLLOWING HAIR:
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,,I,COM,NCOM,<SWITCH>
>
DEFINE FILS(SWITCH,COM,NCOM)
< DOSWX FILS,I,,COM,NCOM,<SWITCH>
>
DEFINE DOSWX (TYPE,HACK1,HACK2,COM,NCOM,SWITCH)
<
IFNB <COM>,<IFN COM&WUTCMD,<TYPE <SWITCH>>>
IFB <COM>,<
IFG %%C,<HACK1'SWITCH>
IFE %%C,<HACK2'SWITCH>
IFL %%C,<IFIDN <TYPE><JOBS>,<SWITCH>>>
IFNB <NCOM>,<IFN NCOM&WUTCMD,<RELOC .-1>>
>
;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
IFN STANSW,<
IFN LOTSW!GSBSW,<
PUSH P,B ;SAVE # OF COPIES
CAIG B,1 ;.GT.1?
IFSKP. ;YES, HASSLE IF NOT WOPR.
MOVX B,WHLU+OPRU
CALL PRVCK
ERROR <WHEEL or OPERATOR capabilities required for multiple copies>
ENDIF.
POP P,B
>;IFN LOTSW!GSBSW
>;IFN STANSW
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
IFE STANSW,<
T ASCII,,%FPCAS
T BCD,,%FPCBC
T BINARY,,%FPCBI
T IMAGE,,%FPCIM
>;IFE STANSW
IFN STANSW,<
IFE CSLISW!SUMXSW,<
T ASCII,,%FPCAS
T BCD,,%FPCBC
T BINARY,,%FPCBI
T IMAGE,,%FPCIM
>;IFE CSLISW!SUMXSW
IFN CSLISW!SUMXSW,<
T DAISY,,%FPCBC
T IMPRESS,,%FPCIM
T PRINTER,,%FPCAS
T TEKTRONIX,,%FPCBI
>;IFN CSLISW!SUMXSW
>;IFN STANSW
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 <MODE:%4M>
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
IFE NICSW,<
JOBS <T ELEVEN,,.FPF11>
>;IFE NICSW
IFN NICSW,< ;[NIC1004] LASER COMMAND
JOBS <T ELEVEN,,.FPF11>,B%PR ;[NIC1004]
>;IFN NICSW
JOBS <T FORTRAN,,.FPFFO>,B%PR
IFN NICSW,< ;[NIC1004] LASER COMMAND
JOBS <T IMPRESS,,.FPFIM>,B%PR ;[NIC1004]
JOBS <T POSTSCRIPT,,.FPFPS>,B%PR
>;IFN NICSW
>
$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
IFN NICSW,< ;[NIC1004] LASER COMMAND
;[NIC1004] REVERSE FILE ORDER ON LASER PRINTER
.REVER: KEYWD $YESNO ;[NIC1004]
T Yes,,1 ;[NIC1004]
CMERRX <YES or NO required> ;[NIC1004]
MOVE B,P3 ;[NIC1004]
MOVE A,[IREVER,,REVER2] ;[NIC1004]
CALLRET STOR1 ;[NIC1004]
;[NIC1004] TURN ON PAGE COLLATION FOR LASER PRINT
.COLLA: KEYWD $YESNO ;[NIC1004]
T Yes,,1 ;[NIC1004]
CMERRX <YES or NO required> ;[NIC1004]
MOVE B,P3 ;[NIC1004]
MOVE A,[ICOLLA,,COLLA2] ;[NIC1004]
CALLRET STOR1 ;[NIC1004]
;[NIC1004] SPECIFY CHARACTERS PER LINE
.FORMW: DECX <Decimal number of characters per line> ;[NIC1004]
CMERRX ;[NIC1004]
SKIPL B ;[NIC1004] RANGE CHECK IT
CAILE B,^D132 ;[NIC1004]
ERROR <Invalid formwidth requested> ;[NIC1004]
MOVE A,[IFORMW,,FORMW2] ;[NIC1004]
CALLRET STOR1 ;[NIC1004]
;[NIC1004] SPECIFY LINES PER PAGE
.FORML: DECX <Decimal number of lines per page> ;[NIC1004]
CMERRX ;[NIC1004]
SKIPL B ;[NIC1004] RANGE CHECK IT
CAILE B,^D66 ;[NIC1004]
ERROR <Invalid formlength requested> ;[NIC1004]
MOVE A,[IFORML,,FORML2] ;[NIC1004]
CALLRET STOR1 ;[NIC1004]
;[NIC1004] SPECIFY TOP OFFSET
.TOPMA: DECX <Number of blank lines at top of page> ;[NIC1004]
CMERRX ;[NIC1004]
SKIPGE B ;[NIC1004]
ERROR <Invalid top margin requested> ;[NIC1004]
MOVE A,[ITOPMA,,TOPMA2] ;[NIC1004]
CALLRET STOR1 ;[NIC1004]
;[NIC1004] SPECIFY LEFT OFFSET
.LEFTM: DECX <Column number in which to begin printing> ;[NIC1004]
CMERRX ;[NIC1004]
SKIPGE B ;[NIC1004]
ERROR <Invalid left margin requested> ;[NIC1004]
MOVE A,[ILEFTM,,LEFTM2] ;[NIC1004]
CALLRET STOR1 ;[NIC1004]
;[NIC1004] PAGE FORMATS
.STAND: MOVEI B,1 ;[NIC1004]
MOVE A,[ISTAND,,STAND2] ;[NIC1004]
CALLRET STOR1 ;[NIC1004]
.DOUBL: MOVEI B,1 ;[NIC1004]
MOVE A,[IDOUBL,,DOUBL2] ;[NIC1004]
CALLRET STOR1 ;[NIC1004]
;[NIC1004]
.TWOSD: MOVEI B,1 ;[NIC1004]
MOVE A,[ITWSD,,TWSD2] ;[NIC1004]
CALLRET STOR1 ;[NIC1004]
;[NIC1004]
.BOOK: MOVEI B,1 ;[NIC1004]
MOVE A,[IBOOK,,BOOK2] ;[NIC1004]
CALLRET STOR1 ;[NIC1004]
.LANDS: MOVEI B,1 ;[NIC1004]
MOVE A,[ILANDS,,LANDS2] ;[NIC1004]
CALLRET STOR1 ;[NIC1004]
REVER2: STOR B,FP.REV,.FPINF(Q1) ;[NIC1004]
RET ;[NIC1004]
COLLA2: STOR B,FP.COL,.FPINF(Q1) ;[NIC1004]
RET ;[NIC1004]
FORMW2: HRLM B,.FPFR1(Q1) ;[NIC1004]
RET ;[NIC1004]
FORML2: HRRM B,.FPFR1(Q1) ;[NIC1004]
RET ;[NIC1004]
TOPMA2: HRLM B,.FPFR2(Q1) ;[NIC1004]
RET ;[NIC1004]
LEFTM2: HRRM B,.FPFR2(Q1) ;[NIC1004]
RET ;[NIC1004]
STAND2: SETZB B,.FPFR1(Q1) ;[NIC1004]
STOR B,FP.2PG,.FPINF(Q1) ;[NIC1004]
RET ;[NIC1004]
BOOK2: SETZM .FPFR1(Q1) ;[NIC1004]
MOVEI B,1 ;[NIC1004]
STOR B,FP.2PG,.FPINF(Q1) ;[NIC1004]
RET ;[NIC1004]
DOUBL2: MOVE B,[^D132,,0] ;[NIC1004]
MOVEM B,.FPFR1(Q1) ;[NIC1004]
MOVEI B,1 ;[NIC1004]
STOR B,FP.2PG,.FPINF(Q1) ;[NIC1004]
RET ;[NIC1004]
TWSD2: MOVE B,[^D80,,0] ;[NIC1004]
MOVEM B,.FPFR1(Q1) ;[NIC1004]
MOVEI B,1 ;[NIC1004]
STOR B,FP.2PG,.FPINF(Q1) ;[NIC1004]
RET ;[NIC1004]
LANDS2: MOVE B,[^D132,,0] ;[NIC1004]
MOVEM B,.FPFR1(Q1) ;[NIC1004]
SETZ B, ;[NIC1004]
STOR B,FP.2PG,.FPINF(Q1) ;[NIC1004]
RET ;[NIC1004]
>;IFN NICSW
IFE NICSW,<
IFN STANSW,<
IFN GSBSW,<
;ADMISSIONS-IBM6640 SWITCH
.IBM6A: MOVEI A,2 ;SET THE FLAG - TO UNIT TWO.
MOVEM A,IBM6F
RET
;IBM6640 SWITCH
.IBM66: MOVEI A,1
MOVEM A,IBM6F ;SET THE FLAG - TO UNIT ONE.
RET
;MAGCARDS-IBM6640 SWITCH
.IBM6M: SKIPN IBM6F ;IF NOT SET, ASSUME DEFAULT PRINTER (UNIT 1)
AOS IBM6F ;KLUDGEY WAY TO SET KNOWN VALUE OF ZERO TO ONE.
SETOM IBM6M ;YES, WE *ARE* PRINTING ON IBM6 MAGCARDS
RET
;ANAHEIM LN-01 SWITCHS
.ROTA: KEYWD $YESNO
T YES,,1 ;"/ROTATE" IMPLIES "/ROTATE:YES"
CMERRX <YES or NO required>
MOVE B,P3
MOVE A,[IROT,,ROT2]
CALL STOR1
RET
F%ROT=1B34
ROT2: EXCH A,.EQCST(P1)
SKIPE B
TDO A,[F%ROT]
EXCH A,.EQCST(P1)
RET
IROT: HRROI A,[ASCIZ/YES/]
SKIPN B
HRROI A,[ASCIZ/NO/]
PSWITCH <ROTATE:%1M>
>;IFN GSBSW
IFN LOTSW!GSBSW,<
.NOHOL: TDZA B,B ;DON'T HOLD PRINT
.HOLD: MOVEI B,1 ;HOLD UNTIL MOD/RELEASE
MOVE A,[IHOLD,,HOLD2]
CALLRET STOR1
HOLD2: STOR B,EQ.HBO,.EQSEQ(P1) ;SAY HOLD OR DON'T HOLD
RET
>;IFN LOTSW!GSBSW
IFN CSLISW!SUMXSW,<
;/OUTLINES:YES or NO -- Put boxes around Imagen output
.OUTLI: CALL GRES ;Get YES/NO with default being YES
MOVE A,[IOUTLI,,OUTLI1] ;Info,,setup addrs
CALLRE STOR1
OUTLI1: STOR B,FP.OLN,.FPINF(Q1)
RET
IOUTLI: HRROI A,[ASCII \NO\
ASCII \YES\](B)
PSWITCH <OUTLINES:%1M>
;/ROTATE:YES or NO -- Rotate Imagen output 90 degrees
.ROTAT: CALL GRES ;Get YES/NO with default being YES
MOVE A,[IROTAT,,ROTAT1] ;Info,,setup addrs
CALLRE STOR1
ROTAT1: STOR B,FP.ROT,.FPINF(Q1)
RET
IROTAT: HRROI A,[ASCII \NO\
ASCII \YES\](B)
PSWITCH <ROTATE:%1M>
;/RULELINES:YES or NO -- One rule line every two lines of Imagen output
.RULEL: CALL GRES ;Get YES/NO with default being YES
MOVE A,[IRULEL,,RULEL1] ;Info,,setup addrs
CALLRE STOR1
RULEL1: STOR B,FP.RUL,.FPINF(Q1)
RET
IRULEL: HRROI A,[ASCII \NO\
ASCII \YES\](B)
PSWITCH <RULELINES:%1M>
;/TWOCOLUMNS:YES or NO -- Two column Imagen output (automatically rotated)
.TWOCO: CALL GRES ;Get YES/NO with default being YES
MOVE A,[ITWOCO,,TWOCO1] ;Info,,setup addrs
CALLRE STOR1
TWOCO1: STOR B,FP.2CL,.FPINF(Q1)
RET
ITWOCO: HRROI A,[ASCII \NO\
ASCII \YES\](B)
PSWITCH <TWOCOLUMNS:%1M>
;/REVERSE:YES or NO -- Reverse pages on Imagen output
.REVER: CALL GRES ;Get YES/NO with default being YES
TRC B,1 ;Make YES=0 and NO=1 so default is to reverse
MOVE A,[IREVER,,REVER1] ;Info,,setup addrs
CALLRE STOR1
REVER1: STOR B,FP.REV,.FPINF(Q1)
RET
IREVER: HRROI A,[ASCII \YES\
ASCII \NO\](B)
PSWITCH <REVERSE:%1M>
;/TYPESIZE:n -- Use COURn font for Imagen output (uses DAISY language)
.TYPES: KEYWD $TYPSZ
T 12,,4 ;Default is 12 point
CMERRX <Invalid TYPESIZE value>
MOVEI B,(P3) ;Copy result
MOVE A,[ITYPES,,TYPES1] ;Info,,setup addrs
CALLRE STOR1
$TYPSZ: TABLE
T 0,,0
T 10,,3
T 12,,4
T 14,,5
T 7,,1
T 8,,2
TEND
TYPES1: STOR B,FP.XXX,.FPINF(Q1)
RET
ITYPES: MOVE A,[EXP 0,7,^D8,^D10,^D12,^D14](B)
PSWITCH <TYPESIZE:%1Q>
>;IFN CSLISW!SUMXSW
>;IFN STANSW
>;IFE NICSW
;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
IFE STANSW,<
.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
>;IFE STANSW
IFN STANSW,<
IFN SUMXSW!NICSW,<
.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
>;IFN SUMXSW!NICSW
>;IFN STANSW
;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
IFE NICSW,<
IFN STANSW,<
IFE CSLISW!SUMXSW,<
;FONT FAMILY SPECIFICATION FOR CANON COMMAND
.FONT: CALL GFONT ;READ FONT NAME
MOVE A,[INOTE,,FONT2] ;SET UP ARGUMENT BLOCK
CALLRET STOR1 ;STASH ARGUMENTS
FONT2: DMOVEM B,.EQCST+1(P1) ;FONT NAME GOES INTO WORDS 1 AND 2
RET ; OF THE CUSTOMER PORTION OF REQUEST
IFONT: HRROI A,[ASCIZ /FONT/] ;SAY DOING /FONT
CALLRET ICOMON ;USE COMMON ROUTINE
;READ THE FONT FROM THE USER
GFONT: MOVEI B,[FLDDB. .CMQST,,,<Font to use when printing a text file,>,,[
FLDDB. .CMFLD,CM%SDH]] ;NOTE MAY OR MAY NOT BE IN QUOTES
CALL FLDSKP ;READ IN THE FONT NAME
CMERRX <Bad font name>
MOVE A,[440700,,ATMBUF] ;PREPARE TO CHANGE FONT TO SIXBIT
MOVE B,[440600,,Q2]
SETZB Q2,Q3 ;START WITH CLEAR NOTE
FONT1: CALL CACKLE ;GET CHARACTER FROM NOTE
IFNSK.
DMOVE B,Q2 ;RETURN FONT NAME IN B AND C
RET
ENDIF.
CAMN B,[000600,,Q3]
ERROR <Font name too long>
IDPB C,B ;STORE CHARACTER OF NOTE
JRST FONT1 ;GO BACK FOR MORE
;TEKTRONIX EMULATION SPECIFICATION FOR CANON COMMAND
IFNDEF .FPTEK,<.FPTEK==11> ;IN CASE NOT DEFINED IN SYSTEM COPY OF QSRMAC
.TEKTR: MOVE A,[ITEKTR,,TEKTR2]
MOVX B,.FPTEK
CALL STOR1 ;TURN ON TEK4014 EMULATION BIT
RET
TEKTR2: STOR B,FP.FFF,.FPINF(Q1)
RET
;ROTATE SPECIFICATION FOR CANON COMMAND
.ROTAT: MOVE A,[IMODE,,MOD2]
MOVX B,%FPCBC ;hack! /MODE:BCD tells it to rotate
CALLRET STOR1
;PAGE-REVERSAL SPECIFICATION FOR CANON COMMAND
IFNDEF .FPREV,<.FPREV==12> ;IN CASE NOT IN SYSTEM COPY OF QSRMAC
.REVER: MOVE A,[IREVRS,,REVRS2]
MOVX B,.FPREV
CALLRET STOR1 ;FLAG THIS FILE TO BE PRINTED PAGE-BACKWARDS
REVRS2: STOR B,FP.FFF,.FPINF(Q1)
RET
>;IFE CSLISW!SUMXSW
;PARSE THE FOREIGN-SWITCHES
.FORSW: MOVEI B,[FLDDB. .CMQST,,,<Data to pass to remote printer,>,,[
FLDDB. .CMFLD,CM%SDH]] ;NOTE MAY OR MAY NOT BE IN QUOTES
CALL FLDSKP ;READ IN THE STRING
CMERRX <Bad foreign switch input>
MOVE A,[440700,,ATMBUF] ;PREPARE TO SAVE INPUT
CALL BUFFS ;COPY TO FREE SPACE
MOVE B,A ;SAVE STRING PTR IN B
MOVE A,[IFORSW,,FORSW2] ;DISPATCH ROUTINES
CALLRET STOR1 ;SAVE THEM FOR LATER
FORSW2: PUSH P,B ;SAVE PTR TO DATA
MOVE A,B ;GET COPY FOR BCOUNT
CALL BCOUNT ;COUNT CHARACTERS AND WORDS
ADDI A,.EQCST(P1) ;GET LAST ADDRESS TO COPY
CAIL A,.EQDEC(P1) ;OVERFLOW?
MOVE A,.EQDEC-1(P1) ;GET HIGHEST ADDRESS (10)
HRRI B,.EQCST(P1) ;WHERE TO COPY IN RH
HRL B,0(P) ;GET PTR IN LH
BLT B,@A ;COPY THE STRING
POP P,A ;GET PTR TO STRING
CALL STREM ;RETURN IT TO FREE SPACE
RET ;DONE
IFORSW: PSWITCH <FOREIGN-SWITCHES:%2M>
MOVE A,B ;GET PTR TO RETURN
CALL STREM ;RETURN IT TO FREE SPACE
RET ;DONE
>;IFN STANSW
>;IFE NICSW
;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
;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
IFN NICSW,<
CALL CHKPKT ;Need to map printer keyword tables?
CALL MAPPKT ;Yes, do so.
>;IFN NICSW
RET
IFN NICSW,<
;Check for a new printer keyword table file
CHKPKT::MOVX A,GJ%SHT!GJ%OLD ;Old file
HRROI B,[ASCIZ /SYSTEM:PRINTER-KEYWORD-TABLES.BIN.0/]
GTJFN%
IFNJE.
HRRZS A
MOVE B,[1,,.FBWRT] ;Last write time
MOVEI C,B ;In there
GTFDB% ;Get it
RLJFN% ;And release it
TRN ;...
CAMG B,PKTTIM## ;A newer version ??
IFSKP.
MOVEM B,PKTTIM ;Yes
RET ;Indicate must map the file
ENDIF.
ENDIF.
RETSKP ;Indicate no map necessary
MAPPKT: ACVAR <PKTJFN>
MOVX A,GJ%SHT!GJ%OLD ;Old file
HRROI B,[ASCIZ /SYSTEM:PRINTER-KEYWORD-TABLES.BIN.0/]
GTJFN%
ERROR <Cannot map SYSTEM:PRINTER-KEYWORD-TABLES.BIN>
HRRZS A
MOVEM A,PKTJFN ;Save the jfn
MOVE B,[1,,.FBWRT] ;Last write time
MOVEI C,PKTTIM ;There
GTFDB% ;Get it
MOVX B,FLD(^D36,OF%BSZ)!OF%RD
OPENF% ;Open the file
ERROR <Cannot open SYSTEM:PRINTER-KEYWORD-TABLES.BIN>
HRLZ A,PKTJFN ;Get the jfn,,zero
MOVEI B,<PKTPAG##_-^D9> ;And the buffer address in page number form
HRLI B,.FHSLF ;This process
MOVX C,PM%CNT!PM%RD!PM%CPY!PM%PLD!FLD(2,PM%RPT)
PMAP% ;Map the file
MOVEI A,PKTPAG ;Address of the buffer
SETMM (A) ;Make the table private
SETMM 1000(A) ;And the strings
MOVE A,PKTJFN ;Get the JFN again
CLOSF% ;Close the file
TRN
RLJFN% ;Release the JFN
TRN ;...
ENDAV.
MOVEI A,PKTPAG ;Address of the buffer
ADDM A,.UTOFF(A) ;The address of the unit names table
ADDM A,.PTOFF(A) ;The address of the paper types table
ADDM A,.FTOFF(A) ;The address of the form types table
HRLZ B,@.UTOFF(A) ;Get the number of keywords here
IFN. B
MOVNS B ;Make it negative
ADD B,.UTOFF(S1) ;And point at the table
DO.
HLRZ C,1(B) ;Get the keyword name address
ADDI C,PKTPAG ;Add in the table address
HRLZS C ;And get it back into the left half
HRR C,1(B) ;Get the value address
ADDI C,PKTPAG ;Add the table address in here, also
MOVEM C,1(B) ;Put back the entry with absolute addresses
AOBJN B,TOP. ;Do all of the entries in the table
ENDDO.
ENDIF.
HRLZ B,@.PTOFF(A) ;Get the number of keywords here
IFN. B
MOVNS B ;Make it negative
ADD B,.PTOFF(A) ;And point at the table
DO.
HLRZ C,1(B) ;Get the keyword name address
ADDI C,PKTPAG ;Add in the table address
HRLZS C ;And get it back into the left half
HRR C,1(B) ;Get the value address
ADDI C,PKTPAG ;Add the table address in here, also
MOVEM C,1(B) ;Put back the entry with absolute addresses
AOBJN B,TOP. ;Do all of the entries in the table
ENDDO.
ENDIF.
HRLZ B,@.FTOFF(A) ;Get the number of keywords here
IFN. B
MOVNS B ;Make it negative
ADD B,.FTOFF(A) ;And point at the table
DO.
HLRZ C,1(B) ;Get the keyword name address
ADDI C,PKTPAG ;Add in the table address
HRLZS C ;And get it back into the left half
HRR C,1(B) ;Get the value address
ADDI C,PKTPAG ;Add the table address in here, also
MOVEM C,1(B) ;Put back the entry with absolute addresses
AOBJN S2,TOP. ;Do all of the entries in the table
ENDDO.
ENDIF.
RET ;Return
>;IFN NICSW
;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)
IFN STANSW,<
IFE NICSW,<
MOVEI A,1 ;DEFAULT TO /NOTIFY:YES
STOR A,EQ.NOT,.EQSEQ(P1)
>;IFE NICSW
IFN SIERSW!CSLISW,< ;;CANON AND LPT DEFAULT TO UNIT:0 ON SIERRA
SETZRO RO.UNI,.EQROB+.ROBAT(P1) ;DEFAULT TO UNIT:0
MOVEI A,1 ;SAY "PHYSICAL UNIT SUPPLIED"
CAIE P4,X%SU ;DON'T DO THIS FOR SUBMIT COMMANDS
STOR A,RO.PHY,.EQROB+.ROBAT(P1) ;...
>;IFN SIERSW!CSLISW
>;IFN STANSW
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
IFE NICSW,<
IFN STANSW,<
CAIE P4,X%CP ;UNLESS THIS IS A CANON COMMAND
STOR A,FP.NFH,GLBBLK+.FPINF ;THE DEFAULT IS /NOHEADER
>;IFN STANSW
>;IFE NICSW
MOVEI P1,EQ0 ;NO GLOBAL JOB SWITCH BLOCK FOR PRINT COMMAND
IFN NICSW,< ;[NIC1004] SET LASER DEFAULTS
STOR A,FP.REV,GLBBLK+.FPINF ;[NIC1004] DEFAULT REVERSE YES
STOR A,FP.COL,GLBBLK+.FPINF ;[NIC1004] AND COLLATE YES
>;IFN NICSW
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 <T CERAS,,.NOCER>,B%PR ;SYNONYM FOR /DESTINATION-NODE:CERAS::
; JOBS <TV DESTINATION-NODE,,.LNODE>,B%PR
JOBS <T FAST> ;OMIT ALL SWITCHES
; JOBS <T MVP,,.NOMVP>,B%PR ;SYNONYM FOR /DESTINATION-NODE:MVP::
; JOBS <T P391,,.NO391>,B%PR ;SYNONYM FOR /DESTINATION-NODE:TF::
JOBS <TV PROCESSING-NODE,,.LNODE>,B%SU
; JOBS <T TERMAN,,.NOTER>,B%PR ;SYNONYM FOR /DESTINATION-NODE:TERMAN::
JOBS <TV UNIT,,.LUNIT>,B%PR
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
IFN NICSW,<
;/UNIT:name CAUSES ONLY REQUESTS BY SPECIFIC UNIT TO BE PRINTED
.LUNIT: HELPX <Unit for which requests will be listed>
CALL CHKPKT ;NEED TO MAP PRINTER KEYWORD TABLES?
CALL MAPPKT ;YES, DO SO.
CALL GUNIT ;GET THE UNIT IN B IN SIXBIT
MOVE A,B ;MOVE IT TO A
MOVE B,[2,,.LSUNI] ;SPECIFY UNIT
CALLRET STASH ;STASH SPECIFIED PRINTER NAME
>;IFN NICSW
;/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
;/P391 FOR DEST NODE P391
IFN STANSW,<
IFN GSBSW,<
.NO391: MOVE A,[SIXBIT/P391/] ;SIXBIT FOR TF::
MOVE B,[2,,.ORNOD] ;GET LENGTH OF BLOCK AND TYPE
CALLRET STASH ;STASH THE BLOCK AND RETURN
>;IFN GSBSW
>;IFN STANSW
;/MVP FOR DEST NODE MVP
IFN STANSW,<
IFN GSBSW,<
.NOMVP: MOVE A,[SIXBIT/MVP/] ;SIXBIT FOR MVP::
MOVE B,[2,,.ORNOD] ;GET LENGTH OF BLOCK AND TYPE
CALLRET STASH ;STASH THE BLOCK AND RETURN
>;IFN GSBSW
>;IFN STANSW
.LNODE: 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
IFN STANSW,<
IFN LOTSW,<
CALLRET STASH ;STASH THE BLOCK AND RETURN
.NOCER: SKIPA A,[SIXBIT/CERAS/] ;SIXBIT FOR CERAS::
.NOTER: MOVE A,[SIXBIT/TERMAN/];SIXBIT FOR TERMAN::
MOVE B,[2,,.ORNOD] ;GET LENGTH OF BLOCK AND TYPE
>;IFN LOTSW
>;IFN STANSW
; CALLRET STASH ;STASH THE BLOCK AND RETURN
;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: PSWITCH <DESTINATION-NODE:%2'::>
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
IFN STANSW,<
IFN LOTSW,<
.CERAS: SKIPA B,[SIXBIT/CERAS/] ;SIXBIT NAME FOR CERAS:: NODE
.TERMA: MOVE B,[SIXBIT/TERMAN/];SIXBIT NAME FOR TERMAN:: NODE
MOVE A,[IDESTI,,NODE2]
CALLRET STOR1 ;REMEMBER IT
>;IFN LOTSW
IFN GSBSW,<
.MVP: MOVE B,[SIXBIT/MVP/] ;SIXBIT NAME FOR MVP:: NODE
MOVE A,[IDESTI,,NODE2]
CALLRET STOR1 ;REMEMBER IT
.TF391: MOVE B,[SIXBIT/P391/] ;SIXBIT NAME FOR TF:: (391) NODE
MOVE A,[IDESTI,,NODE2]
CALLRET STOR1 ;REMEMBER IT
>;IFN GSBSW
>;IFN STANSW
NODE2: 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
GDNODE: FNODEX <Network node to receive output>
GNODEA: CMERRX <Invalid node>
GNODEB: CALL GETSXB ;GET SIXBIT OF NODE
MOVE B,A
RET
;SPECIFIC UNIT NUMBER
.UNIT: CALL GUNIT ;GET UNIT
MOVE A,[IUNIT,,UNIT2]
CALLRET STOR1
UNIT2:
IFE NICSW,<
STOR B,RO.UNI,.EQROB+.ROBAT(P1)
MOVEI A,1 ;SAY "PHYSICAL UNIT SUPPLIED"
STOR A,RO.PHY,.EQROB+.ROBAT(P1)
>;IFE NICSW
IFN NICSW,<
STOLIM B,.EQLIM(P1),PRNT ;STORE THE UNIT NAME
MOVEI A,%PHYCL
STOR A,RO.ATR,.EQROB+.ROBAT(P1)
SETZ A,
STOLIM A,.EQLIM(P1),SPNAME
>;IFN NICSW
RET
IFE NICSW,<
IUNIT: PSWITCH <UNIT:%2O>
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>
RET
>;IFE NICSW
IFN NICSW,<
IUNIT: PSWITCH <UNIT:%2'>
GUNIT: MOVE A,PKTPAG+.UTOFF
MOVEM A,CMDAT ;Prepare to parse a keyword w/o confirmation
MOVX A,CMKEY
MOVEM A,CMFNP
MOVEI B,FBLOCK
CALL FIELDX ;Input the field
SETZM CMDEF ;Don't let same default be used over.
SETZM CMHLP ;Don't let same help be used over
SETZM CMBRK ;Don't let same break mask be used over
TXNE A,CM%NOP ;Make sure field parsed all right
CMERRX <No such printer> ;Bad keyword
HRRZ B,(B) ;Get pointer to sixbit data
MOVE B,(B) ;Return sixbit data in B
RET
>;IFN NICSW
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
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
IFN STANSW,<
IFN GSBSW,<
;TEMP DEFN OF .OTIBM - NEVER USED SO IT DOESN'T MATTER
.OTIBM==74
>;IFN GSBSW
>;IFN STANSW
$QUEUE: TABLE
; T ADMISSIONS-IBM640,,[.OTIBM,,X%AI]
T ARCHIVE,,[.OTARC,,X%AR]
T BATCH,,[.OTBAT,,X%SU]
; T CANON,,[.OTCDP,,X%CP]
; T CARDS,,[.OTCDP,,X%CP]
; T IBM6640,,[.OTIBM,,X%IB]
; T IMPRINT,,[.OTCDP,,X%CP]
; T FOREIGN-PRINTER,,[.OTPLT,,X%PL]
; T LASER,,[.OTCDP,,X%CP] ;[NIC1004] LASER
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 CANON,,[.OTCDP,,X%CP]
; T CARDS,,[.OTCDP,,X%CP]
; T PAPER-TAPE,,[.OTPTP,,X%TP]
; T PLOT,,[.OTPLT,,X%PL]
; T IMPRINT,,[.OTCDP,,X%CP]
; T FOREIGN-PRINTER,,[.OTPLT,,X%PL]
; T LASER,,[.OTCDP,,X%CP] ;[NIC1004]
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
IFN STANSW,<
IFN GSBSW,<
.MMVP: MOVE B,[SIXBIT/MVP/] ;/MVP INSTEAD OF /DESTINATION-NODE:MVP::
MOVEM B,5(P1) ;SAVE IN GROUP 0 (MAJOR MOD)
RET
.M391: MOVE B,[SIXBIT/P391/] ;/P391 INSTEAD OF /DESTINATION-NODE:TF::
MOVEM B,5(P1) ;SAVE IN GROUP 0 (MAJOR MOD)
RET
>;IFN GSBSW
IFN LOTSW,<
.MCERA: SKIPA B,[SIXBIT/CERAS/] ;/CERAS INSTEAD OF /DESTINATION-NODE:CERAS::
.MTERM: MOVE B,[SIXBIT/TERMAN/];/TERMAN INSTEAD OF /DESTINATION-NODE:TERMAN::
MOVEM B,5(P1)
RET
>;IFN LOTSW
>;IFN STANSW
;/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
IFE NICSW,<
STOR B,RO.UNI,4(P1)
MOVEI A,1 ;SAY SPECIFIC UNIT SUPPLIED
STOR A,RO.PHY,4(P1)
>;IFE NICSW
IFN NICSW,<
MOVEM B,4(P1) ;STORE THE UNIT NAME
>;IFN NICSW
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
IFN STANSW,<
IFN LOTSW!GSBSW,<
;RELEASE
.MRELE: TDZA A,A
;HOLD
.MHOLD: MOVEI A,1
MOVEM A,15(P2)
RET
>;IFN LOTSW!GSBSW
>;IFN STANSW
;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
;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 <T CERAS,,.MCERA>,B%PR
JOBS <TV COPIES,,.MCOPI>,,B%SU
; 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 <T HOLD,,.MHOLD>
JOBS <TV JOBNAME,,.MJOB>
JOBS <TV LIMIT,,.MLIMI>,,B%SU
JOBS <T LOWERCASE,,.MLOWE>,B%PR
; JOBS <TV MODE,,.MMODE>,,B%SU
JOBS <TV MODE,,.MMODE>,B%PR ;[NIC1004]
; JOBS <T MVP,,.MMVP>,B%PR
JOBS <TV NODE,,.MNOTE>,B%PR ;[NIC1004]
; JOBS <T NOHEADER,,.MNOHE>,,B%SU
JOBS <T NOHEADER,,.MNOHE>,B%PR ;[NIC1004]
; JOBS <TV NOTE,,.MNOTE>,,B%SU
JOBS <TV OUTPUT,,.MOUTP>,B%SU
; JOBS <T P391,,.M391>,B%PR
JOBS <TV PAGES,,.MPAGE>,B%SU
JOBS <T PRESERVE,,.MPRES>
JOBS <TV PRIORITY,,.MPRIO>
JOBS <TV PROCESSING-NODE,,.MPNOD>,B%SU
; JOBS <T RELEASE,,.MRELE>
JOBS <TV REPORT,,.MREPO>,B%PR
JOBS <TV RESTARTABLE,,.MREST>,B%SU
JOBS <TV SEQUENCE,,.MSEQ>
JOBS <TV SPACING,,.MSPAC>,B%PR
; JOBS <T TERMAN,,.MTERM>,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
IFN STANSW,<
IFN GSBSW,<
;CANIBM will parse/call program to cancel ibm requests
CANIBM: MOVEI B,[FLDDB. .CMNUM,CM%SDH,5+5,<IBM6640 request ID number>]
CALL FLDSKP
CMERRX <IBM6640 request ID number required>
MOVEM B,IPCFP+KIL.RQ+.RDBRQ ;REMEMBER WHAT NUMBER WAS TYPED
SETOM JNGF ;PRETEND JOB NAME WAS GIVEN
CONFIRM ;CONFIRM THE COMMAND
MOVE A,CSBUFP ;BUILD RSCAN STRING FOR SYS:IBMCAN.EXE
;(NOTE THAT WE DO NOT NEED THE SPACE WE
; USE TO BE KEPT, SO WE LEAVE CSBUFP ALONE)
MOVE B,IPCFP+KIL.RQ+.RDBRQ ;GET ID NUMBER
MOVX C,FLD(^D10,NO%RDX) ;DECIMAL OUTPUT
NOUT ;OUTPUT THE NUMBER
ERCAL JERR
HRROI B,[ASCII\ /BAS\] ;OUTPUT DEVICE NAME...
CAIN P4,X%AI ;ADMISSIONS IBM6640 CANCEL REQUEST?
HRROI B,[ASCII\ /ADM\] ;YES - USE IT
MOVNI C,5 ;IN RSCAN BUFFER.
SOUT%
MOVEI B,"J"-100 ;OUTPUT A LINE FEED CHARACTER
IDPB B,A
MOVE A,CSBUFP ;GET OLD POINTER BACK...
MOVEM A,RSPTR ;STORE IT AS THE RSCAN POINTER FOR PERUN
HRROI B,[ASCIZ/SYS:IBMFCA.EXE/] ;WANT IBMPRT.EXE
CALLRE PERUN ;GO RUN IT.
>;IFN GSBSW
>;IFN STANSW
;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)
IFN STANSW,<
IFN GSBSW,<
CAIN P4,X%IB ;IBM6640 CANCEL REQUEST?
JRST CANIBM ;YES - IBM6640 ONLY ALLOWS CANCELLING NUMBERS.
CAIN P4,X%AI ;ADMISSIONS IBM6640 CANCEL REQUEST?
JRST CANIBM ;YES
>;IFN GSBSW
>;IFN STANSW
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 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
;INITIALIZATION ROUTINE FOR KILL COMMAND
KILINI:
MOVEI A,MSHSIZ+1+RDBSIZ
STOR A,MS.CNT,IPCFP ;STORE MESSAGE SIZE (THE "1" IS FOR THE QUEUE NAME)
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.RQ+RDBSIZ-1
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
IFN NICSW,<
CALL CHKPKT
CALL MAPPKT
>;IFN NICSW
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 [IFE STANSW,<CMERRX <Invalid SET DEFAULT CARDS command>>
IFE NICSW,<
IFN STANSW,<
IFE CSLISW!SUMXSW,<CMERRX <Invalid SET DEFAULT CANON command>>
IFN CSLISW!SUMXSW,<CMERRX <Invalid SET DEFAULT IMPRINT command>>
>;IFN STANSW
>;IFE NICSW
IFN NICSW,<CMERRX <Invalid SET DEFAULT LASER command>> ;[NIC1004]
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
;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
MOVE A,QPT ;GET FINAL POINTER TO DEFAULT LIST
MOVEM A,@[DCPT
DPPT
DSPT
DTPT
DPLPT](P4) ;STORE POINTER IN CORRECT PLACE
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
IFE STANSW,<
TYPE <All defaults for PUNCH CARDS command cleared
>>;IFE STANSW
IFE NICSW,<
IFN STANSW,<
IFE CSLISW!SUMXSW,<
TYPE <All defaults for CANON command cleared
>>;IFE CSLISW!SUMXSW
IFN CSLISW!SUMXSW,<
TYPE <All defaults for IMPRINT command cleared
>>;IFN CSLISW!SUMXSW
>;IFN STANSW
>;IFE NICSW
IFN NICSW,< ;[NIC1004] LASER COMMAND
ETYPE <All defaults for LASER command cleared%_> ;[NIC1004]
>;IFN NICSW
RET
;SET NOT DEFAULT (FOR) PRINT
.SNDP:: CONFIRM
XMOVEI A,DPSTK
XMOVEI B,DPPT
CALL REMDEF
TYPE <All defaults for PRINT command cleared
>
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 @[IFE STANSW,<[ASCIZ /CARDS/]>
IFE NICSW,<
IFN STANSW,<
IFE CSLISW!SUMXSW,<[ASCIZ /CANON/]>
IFN CSLISW!SUMXSW,<[ASCIZ /IMPRINT/]>
>;IFN STANSW
>;IFE NICSW
IFN NICSW,<[ASCIZ /LASER/]> ;[NIC1004]
[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>
IFN STANSW,<
IFN LOTSW,<
I8LPI: HRROI A,[ASCIZ /8LPI/]
SKIPN B
HRROI A,[ASCIZ /6LPI/]
PSWITCH <%1M>
>;IFN LOTSW
IFN LOTSW!GSBSW,<
IHOLD: HRROI A,[ASCIZ /HOLD/]
SKIPN B
HRROI A,[ASCIZ /NOHOLD/]
PSWITCH <%1M>
>;IFN LOTSW!GSBSW
IFE CSLISW!SUMXSW,<
ITEKTR: HRROI A,[0]
CAIE B,0
HRROI A,[ASCIZ /NO/]
PSWITCH <%1MTEK4014-MODE>
IREVRS: HRROI A,[0]
CAIE B,0
HRROI A,[ASCIZ /NO/]
PSWITCH <%1MREVERSE>
>;IFE CSLISW!SUMXSW
>;IFN STANSW
IHEADE: HRROI A,[0]
CAIE B,0
HRROI A,[ASCIZ /NO/]
PSWITCH <%1MHEADER>
IFN NICSW,< ;[NIC1004] LASER COMMAND
IREVER: HRROI A,[ASCIZ /Yes/] ;[NIC1004]
CAIN B,0 ;[NIC1004]
HRROI A,[ASCIZ /No/] ;[NIC1004]
PSWITCH <Reverse:%1M> ;[NIC1004]
ICOLLA: HRROI A,[ASCIZ /Yes/] ;[NIC1004]
CAIN B,0 ;[NIC1004]
HRROI A,[ASCIZ /No/] ;[NIC1004]
PSWITCH <Collation:%1M> ;[NIC1004]
IFORMW: PSWITCH <Formwidth:%2Q> ;[NIC1004]
IFORML: PSWITCH <Formlength:%2Q> ;[NIC1004]
ITOPMA: PSWITCH <Topmargin:%2Q> ;[NIC1004]
ILEFTM: PSWITCH <Leftmargin:%2Q> ;[NIC1004]
IDOUBL: PSWITCH <Double> ;[NIC1004]
ITWSD: PSWITCH <TwoSided> ;[NIC1004]
IBOOK: PSWITCH <Book> ;[NIC1004]
ISTAND: PSWITCH <Standard> ;[NIC1004]
ILANDS: PSWITCH <Landscape> ;[NIC1004]
>;IFN NICSW
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: IFE STANSW,<PSWITCH <CARDS:%2Q>>
IFN STANSW,<
IFE CSLISW!SUMXSW,<PSWITCH <CANON:%2Q>>
IFN CSLISW!SUMXSW,<PSWITCH <IMPRINT:%2Q>>
>;IFN STANSW
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
;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? ;EM34 make global
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
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
STOR A,MF.ACK,.MSFLG+IPCFP
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
;CS141 *** Begin ***
;Version of above which RETSKP's on success.
XGIPID::SKIPE A,INFPID ;EM118 ALREADY EXIST?
RETSKP ;Yes - done
MOVEI A,.SPINF ;SAY WE WANT INFO'S PID
CALL GSPID ;GET PID OF INFO
RET
AOS (P) ;Success return
MOVEM A,INFPID ;REMEMBER IT
RET
;CS141 *** End ***
;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
;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
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
RET ;AND RETURN
;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
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
CAME A,IPCTBL(C) ;HAVE WE JUST FOUND ENTRY?
JRST [ CAME A,QSRPID ;DOESN'T MATCH. ARE WE SEEKING A QUASAR MESSAGE?
JRST FM4 ;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 .+1 ;YES, ACCEPT IT AS THOUGH FROM QUASAR
JRST FM4] ;SEEKING QUASAR, BUT CURRENT ISN'T FROM EITHER QUASAR OR MDA, SO DOESN'T MATCH
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
CAME A,QSRPID ;DID QUASAR SEND IT?
JRST [ CAME A,MDAPID ;NO, DID MDA SEND IT?
JRST FM5 ;NO, SO FLUSH IT
JRST .+1] ;YES, TREAT LIKE QUASAR
MOVEI B,IPCBPN(C) ;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]
HLRZ B,.IPCFP+RCVPDB ;EM34 Length of message received
HRRZ A,.IPCFP+RCVPDB ;EM34 Location of message
CAIL B,1000 ;EM34 A page?
LSH A,9 ;EM34 Make an address, then
HLRZ B,.MSGFL(A) ;EM34 Get magic number field from message
CAME B,[.MSGNM] ;EM34 is it our magic number?
IFSKP. ;EM34 Yes
MOVE B,.IPCFS+RCVPDB ;EM34 USRMSG wants sender's PID here...
MOVE C,.IPCFD+RCVPDB ;EM34 and the user # here
CALL USRMSG ;EM34 Then it's a message from a user
JRST IPCMOR ;EM34 and go back for more
ENDIF. ;EM34
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
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
END