Trailing-Edge
-
PDP-10 Archives
-
bb-m836d-bm
-
tools/enqtst/enqtst.mac
There is 1 other file named enqtst.mac in the archive. Click here to see a list.
; UPD ID= 15, RIP:<7.TOOLS-TAPE>ENQTST.MAC.6, 26-Feb-88 10:26:29 by GSCOTT
;TCO 7.1236 - Update copyright notice.
; UPD ID= 10, RIP:<7.TOOLS-TAPE>ENQTST.MAC.5, 8-Feb-88 14:26:05 by LOMARTIRE
;Edit 4 - Take out priv check at startup and let ENQX15 and ENQX16 be returned.
; UPD ID= 9, RIP:<7.TOOLS-TAPE>ENQTST.MAC.4, 20-Jan-88 14:00:15 by LOMARTIRE
;Edit 3 - Use new wording for EN%QCC bit in Lock-Block. Also, remove
;duplicate definitions which are now in MONSYM.
; UPD ID= 4, RIP:<7.TOOLS-TAPE>ENQTST.MAC.3, 6-Oct-87 09:35:37 by LOMARTIRE
;Edit 2 - Fix PSI channel 0 reporting at GOPS00 and ENQC display.
; UPD ID= 1, RIP:<7.TOOLS-TAPE>ENQTST.MAC.2, 7-Aug-87 09:16:18 by LOMARTIRE
;Edit 1 - Add new flags for .ENQCD. Add the ADJUST command. Update TOC.
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1988.
; ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
; ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
; INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
; COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
; OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
; TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
; AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
; SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
TITLE ENQTST - A program to test the ENQ/DEQ facility
SEARCH MONSYM,MACSYM
SALL
SUBTTL Table of Contents
; Table of Contents for ENQTST
;
;
; Section Page
; 1. Storage and Flags. . . . . . . . . . . . . . . . . . . 2
; 2. Macro Definitions. . . . . . . . . . . . . . . . . . . 3
; 3. Initialization . . . . . . . . . . . . . . . . . . . . 4
; 4. Command Parsing. . . . . . . . . . . . . . . . . . . . 4
; 4.1. Command Table . . . . . . . . . . . . . . . . 4
; 5. Help Command . . . . . . . . . . . . . . . . . . . . . 5
; 6. Exit Command . . . . . . . . . . . . . . . . . . . . . 6
; 7. General Subroutines
; 7.1. RETSKP Processing . . . . . . . . . . . . . . 7
; 7.2. Fatal JSYS Error. . . . . . . . . . . . . . . 7
; 7.3. Non-fatal JSYS Error. . . . . . . . . . . . . 7
; 7.4. Command Error . . . . . . . . . . . . . . . . 7
; 7.5. Print Last Error Code . . . . . . . . . . . . 7
; 7.6. Parse Input Filespec. . . . . . . . . . . . . 8
; 7.7. Parse Arbitrary Filespec. . . . . . . . . . . 8
; 7.8. Release Unwanted JFNS . . . . . . . . . . . . 8
; 7.9. Check File Status . . . . . . . . . . . . . . 8
; 8. Command Processing . . . . . . . . . . . . . . . . . . 9
; 8.1. Enable Cluster-wide ENQ . . . . . . . . . . . 9
; 8.2. Open a File . . . . . . . . . . . . . . . . . 10
; 8.3. Close a File. . . . . . . . . . . . . . . . . 11
; 8.4. Begin a Request . . . . . . . . . . . . . . . 12
; 8.5. Adjust a Request. . . . . . . . . . . . . . . 13
; 8.6. End a Request . . . . . . . . . . . . . . . . 14
; 8.7. Clear Requests. . . . . . . . . . . . . . . . 15
; 8.8. Set a Request Parameter . . . . . . . . . . . 16
; 8.8.1. Keyword Table. . . . . . . . . . . . 16
; 8.8.2. Group Number . . . . . . . . . . . . 17
; 8.8.3. Level Number . . . . . . . . . . . . 18
; 8.8.4. Pool Amount. . . . . . . . . . . . . 19
; 8.8.5. Object Type. . . . . . . . . . . . . 20
; 8.8.6. Pool Total . . . . . . . . . . . . . 21
; 8.8.7. PSI Channel. . . . . . . . . . . . . 22
; 8.8.8. Request ID . . . . . . . . . . . . . 23
; 8.8.9. User Code. . . . . . . . . . . . . . 24
; 8.8.10. Flags. . . . . . . . . . . . . . . . 25
; 8.8.10.1. Keyword Table . . . . . . . 25
; 8.8.10.2. Shared. . . . . . . . . . . 26
; 8.8.10.3. Exclusive . . . . . . . . . 26
; 8.8.10.4. Ignore Levels . . . . . . . 26
; 8.8.10.5. Require Levels. . . . . . . 26
; 8.8.10.6. Nesting . . . . . . . . . . 26
; 8.8.10.7. No Nesting. . . . . . . . . 26
; 8.8.10.8. Long Term . . . . . . . . . 26
; 8.8.10.9. Normal. . . . . . . . . . . 26
; 8.8.11. String . . . . . . . . . . . . . . . 27
; 8.8.12. Mask Block . . . . . . . . . . . . . 28
; 8.9. Do the ENQ. . . . . . . . . . . . . . . . . . 29
; 8.9.1. Switch Table . . . . . . . . . . . . 29
; 8.10. Do the DEQ. . . . . . . . . . . . . . . . . . 30
; 8.10.1. Switch Table . . . . . . . . . . . . 30
; 8.11. Do the ENQC . . . . . . . . . . . . . . . . . 31
; 8.11.1. Switch Table . . . . . . . . . . . . 31
; 9. Interrupt Processing . . . . . . . . . . . . . . . . . 32
;VERSION NUMBER DEFINITIONS
VMAJOR==1 ;MAJOR VERSION NUMBER
VMINOR==0 ;MINOR VERSION NUMBER
VEDIT==4 ;EDIT NUMBER
VWHO==0 ;GROUP WHO LAST EDITED PROGRAM (0=DEC DEVELOPMENT)
VENQT==<VWHO>B2+<VMAJOR>B11+<VMINOR>B17+VEDIT
STDAC. ;DEFINE STANDARD ACS
SUBTTL Storage and Flags
PDLEN==^D100 ;LENGTH OF STACK
PDL: BLOCK PDLEN ;STACK
EGTBLK: BLOCK 17 ;GTJFN BLOCK FOR COMND
ENQHLP: ASCIZ/SYS:ENQTST.HLP/ ;ENQTST HELP FILE NAME
HLPJFN: BLOCK 1 ;JFN FOR HELP FILE
STRSZE==100 ;SIZE OF TEMP STRING BUFFER
STRBUF: BLOCK STRSZE ;TEMP STRING BUFFER
CBUFSZ==400 ;COMMAND BUFFER SIZE
CMDBUF: BLOCK CBUFSZ ;COMMAND BUFFER
ABUFSZ==400 ;ATOM BUFFER SIZE
ATMBUF: BLOCK ABUFSZ ;ATOM BUFFER
CMDSBK: COMMD ;COMMAND STATE BLOCK
.PRIIN,,.PRIOU
-1,,[ASCIZ/ENQTST> /]
-1,,CMDBUF
-1,,CMDBUF
5*CBUFSZ-1
0
-1,,ATMBUF
5*ABUFSZ-1
EGTBLK
ENQFLG: BLOCK 1 ;FLAGS FOR ENQTST
BEGIP==1B0 ;BEGIN COMMAND HAS BEEN ISSUED - MUST BE BIT 0
ADNUM: BLOCK 1 ;[1] TEMP LOCATION FOR OPNUM DURING ADJUST
OPNUM: BLOCK 1 ;NUMBER OF REQUESTS IN OPERATION
OPMAX==10 ;MAXIMUM NUMBER OF REQUESTS IN AN ARGBLOCK
OPJFNS: BLOCK OPMAX ;JFNS FOR REQUESTS
JFNNUM: BLOCK 1 ;NUMBER OF TOTAL JFNS
OPSTRG: BLOCK OPMAX*^D50 ;STRING SPACE FOR REQUESTS
OPMASK: BLOCK OPMAX*^D16 ;MASK SPACE FOR REQUESTS
OPASIZ==4*OPMAX+2 ;SIZE OF ARGBLOCK
OPABLK: BLOCK OPASIZ ;ARGBLOCK FOR OPERATION
OPISIZ==3*OPMAX ;SIZE OF ENQC% RETURN BLOCK
OPIBLK: BLOCK OPISIZ ;BLOCK FOR ENQC% STATUS
OPDSIZ==400 ;SIZE FOR DUMP BLOCK
OPDBLK: OPDSIZ
BLOCK OPDSIZ-1 ;BLOCK FOR ENQC% DUMP
;REQUEST VARIABLES - MUST HAVE LKFLAG FIRST.
;ALSO, ANYTHING PAST LKREQ IS NOT CLEARED DURING BEGIN COMMAND.
LKFLAG: BLOCK 1 ;FLAGS FOR REQUEST
LKLVL: BLOCK 1 ;LEVEL FOR REQUEST
LKTYPE: BLOCK 1 ;TYPE OF REQUEST (JFN, -1, -2, -3)
LKSTUC: BLOCK 1 ;USER CODE OR POINTER TO STRING SPACE
LKPOOL: BLOCK 1 ;POOL FOR REQUEST
LKGRP: BLOCK 1 ;GROUP FOR REQUEST
LKMASK: BLOCK 1 ;POINTER TO MASK SPACE
LKREQ: BLOCK 1 ;REQUEST-ID FOR REQUEST
LKPSI: BLOCK 1 ;PSI FOR REQUEST
PSIPC1: BLOCK 1 ;LEVEL 1 PC
LEVTAB: PSIPC1 ;LEVEL 1 PC
BLOCK 2 ;OTHER LEVELS UNUSED
CHNENA: XWD 770000,017777 ;CHANNELS TO ACTIVATE
CHNTAB: XWD 1,GOPS00 ;LEVEL 1,,INTERRUPT ROUTINE
XWD 1,GOPS01 ;LEVEL 1,,INTERRUPT ROUTINE
XWD 1,GOPS02 ;LEVEL 1,,INTERRUPT ROUTINE
XWD 1,GOPS03 ;LEVEL 1,,INTERRUPT ROUTINE
XWD 1,GOPS04 ;LEVEL 1,,INTERRUPT ROUTINE
XWD 1,GOPS05 ;LEVEL 1,,INTERRUPT ROUTINE
BLOCK ^D17 ;RESERVED CHANNELS
XWD 1,GOPS23 ;LEVEL 1,,INTERRUPT ROUTINE
XWD 1,GOPS24 ;LEVEL 1,,INTERRUPT ROUTINE
XWD 1,GOPS25 ;LEVEL 1,,INTERRUPT ROUTINE
XWD 1,GOPS26 ;LEVEL 1,,INTERRUPT ROUTINE
XWD 1,GOPS27 ;LEVEL 1,,INTERRUPT ROUTINE
XWD 1,GOPS28 ;LEVEL 1,,INTERRUPT ROUTINE
XWD 1,GOPS29 ;LEVEL 1,,INTERRUPT ROUTINE
XWD 1,GOPS30 ;LEVEL 1,,INTERRUPT ROUTINE
XWD 1,GOPS31 ;LEVEL 1,,INTERRUPT ROUTINE
XWD 1,GOPS32 ;LEVEL 1,,INTERRUPT ROUTINE
XWD 1,GOPS33 ;LEVEL 1,,INTERRUPT ROUTINE
XWD 1,GOPS34 ;LEVEL 1,,INTERRUPT ROUTINE
XWD 1,GOPS35 ;LEVEL 1,,INTERRUPT ROUTINE
SUBTTL Macro Definitions
DEFINE T (COMMAND,ADDRESS) < ;;MACRO TO CREATE COMMAND LIST
IFB <ADDRESS>,<[ASCIZ/COMMAND/],,.'ADDRESS>
IFNB <ADDRESS>,<[ASCIZ/COMMAND/],,ADDRESS>
>
DEFINE NOISE (MSG) < ;;MACRO TO PARSE NOISE WORDS
MOVEI T1,CMDSBK ;;GET ADDRESS OF COMMAND BLOCK
MOVEI T2,[FLDDB. .CMNOI,,<-1,,[ASCIZ/MSG/]>]
COMND ;;PARSE NOISE WORDS
ERJMP FJERR ;;FATAL JSYS ERROR
TXNE T1,CM%NOP ;;PARSE SUCCESSFUL?
JRST COMERR ;;NO, OUTPUT ERROR
>
DEFINE CONFIRM < ;;MACRO TO CONFIRM COMMAND
MOVEI T1,CMDSBK ;;GET COMMAND STATE BLOCK ADDRESS
MOVEI T2,[FLDDB. .CMCFM]
COMND ;;PARSE CONFIRMATION
ERJMP FJERR ;;FATAL JSYS ERROR
TXNE T1,CM%NOP ;;PARSE SUCCESSFUL?
JRST COMERR ;;NO, OUTPUT ERROR
>
DEFINE CRLF < ;;MACRO TO PRINT CR AND LF
HRROI T1,[ASCIZ/
/]
PSOUT ;;PRINT NEW LINE
ERJMP .+1 ;;IGNORE ERROR
>
DEFINE ERR (MSG) < ;;MACRO TO PRINT ERROR MESSAGE
HRROI T1,[ASCIZ\MSG\] ;;POINT TO MESSAGE
PSOUT ;;PRINT ERROR MESSAGE
ERJMP .+1 ;;IGNORE ERROR
>
SUBTTL Initialization
ENTVEC: JRST START ;LOCATION TO START
JRST START ;LOCATION TO CONTINUE
VENQT ;ENQTST VERSION WORD
START: RESET ;START FRESH
MOVEI T1,.FHSLF ;GET THIS FORK
MOVE T2,[LEVTAB,,CHNTAB] ;POINT AT INTERRUPT TABLES
SIR ;TELL MONITOR WHERE THEY ARE
ERJMP FJERR ;ERROR
MOVE T2,CHNENA ;GET CHANNELS TO ACTIVATE
AIC ;ACTIVATE THEM
ERJMP FJERR ;ERROR
EIR ;ENABLE INTERRUPT SYSTEM
ERJMP FJERR ;ERROR
; JRST ENQTST ;CONTINUE WITH PARSING
SUBTTL Command Parsing
ENQTST: MOVE P,[IOWD PDLEN,PDL] ;SET UP STACK
MOVEI T1,CMDSBK
MOVEI T2,[FLDDB. .CMINI]
COMND ;INITIALIZE COMND JSYS
ERJMP FJERR ;FATAL JSYS ERROR
COMMD: MOVE P,[IOWD PDLEN,PDL] ;SET UP FRESH STACK
MOVEI T2,[FLDDB. .CMKEY,,CMDLST]
COMND ;PARSE COMMAND
ERJMP FJERR ;FATAL JSYS ERROR
TXNE T1,CM%NOP ;SUCCESSFUL PARSE?
JRST COMERR ;NO, REPORT ERROR
HRRZ T2,(T2) ;GET DISPATCH ADDRESS
JRST (T2) ;DO COMMAND
SUBTTL Command Parsing -- Command Table
CMDLST: CMDLEN,,CMDLEN
T (ADJUST,ADJUST) ;ADJUST A REQUEST
T (BEGIN,BEGIN) ;BEGIN A REQUEST
T (CLEAR,CLEAR) ;CLEAR ALL REQUESTS
T (CLOSE,CLOSE) ;CLOSE A FILE
T (DEQ,DODEQ) ;DEQ%
T (ENABLE,ENA) ;ENABLE CLUSTER-WIDE ENQ FOR PROCESS
T (END,END) ;END A REQUEST
T (ENQ,DOENQ) ;ENQ%
T (ENQC,DOENQC) ;ENQC%
T (EXIT,EXIT) ;EXIT
T (HELP,HELP) ;HELP
T (OPEN,OPEN) ;OPEN A FILE
T (SET,SET) ;SET A REQUEST PARAMETER
CMDLEN==.-CMDLST-1 ;LENGTH OF COMMAND LIST
SUBTTL Help Command
HELP: NOISE (with ENQTST) ;PARSE NOISE WORDS
CONFIRM ;CONFIRM COMMAND
SKIPE T1,HLPJFN ;HAVE A HELP FILE JFN?
CALL RELJFN ;YES, RELEASE IT
SETZM HLPJFN ;CLEAR IT
MOVX T1,GJ%SHT!GJ%OLD ;WANT EXISTING FILE
HRROI T2,ENQHLP ;NAME OF HELP FILE
GTJFN ;GET JFN
IFJER. ;GOT AN ERROR!
MOVX T1,GJ%SHT!GJ%OLD ;TRY AGAIN
HRROI T2,[ASCIZ/HLP:ENQTST.HLP/] ;ALTERNATE HELP SPEC
GTJFN ;GET JFN
IFJER. ;ANOTHER ERROR, QUIT!
ERR(
%ENQTST: Unable to locate SYS:ENQTST.HLP or HLP:ENQTST.HLP
?ENQTST: Help unavailable) ;PRINT ERROR
JRST ENQTST ;RESTART
ENDIF.
ENDIF.
HRRM T1,HLPJFN ;SAVE JFN
MOVX T2,OF%RD!OF%RTD ;ALLOW READ ACCESS
OPENF ;OPEN FILE
IFJER. ;CAN'T OPEN IT!
ERR(
%ENQTST: Unable to open help file - ) ;FIRST PART OF ERROR
CALL GETERR ;REPORT MOST RECENT ERROR
ERR(?ENQTST: Help unavailable) ;REST OF ERROR MSG
JRST ENQTST ;RESTART
ENDIF.
HELP1: MOVE T1,HLPJFN ;GET SOURCE JFN
BIN ;GET A BYTE
IFJER. ;CAN'T
CALL FILSTS ;CHECK FILE STATUS
JRST HELP2 ;END OF FILE REACHED - FINISHED
ERR(?ENQTST: Help unavailable) ;PRINT ERROR
JRST ENQTST ;REST OF ERROR MESSAGE
ENDIF.
HRROI T1,T2 ;POINT TO BYTE
PSOUT ;PRINT IT
ERJMP FJERR ;ERROR
JRST HELP1 ;CONTINUE
HELP2: MOVE T1,HLPJFN ;GET HELP FILE JFN
CLOSF ;CLOSE IT
IFJER.
ERR(
%ENQTST: Unable to close help file - ) ;FIRST PART OF ERROR MESSAGE
CALL GETERR ;REPORT MOST RECENT ERROR
ENDIF.
JRST ENQTST ;GET ANOTHER COMMAND
SUBTTL Exit Command
EXIT: NOISE (from ENQTST) ;PARSE NOISE
CONFIRM ;CONFRIM COMMAND
STOP: HALTF ;END EXECUTION
JRST START ;IN CASE OF CONTINUE
SUBTTL General Subroutines -- RETSKP Processing
RSKP: AOS 0(P) ;INCREMENT RETURN ADDERSS
RET ;NOW DO RETURN
SUBTTL General Subroutines -- Fatal JSYS Error
FJERR: CRLF ;NEW LINE
HRROI T1,[ASCIZ/?Fatal ENQTST error: /]
PSOUT ;PRINT ERROR HEADER
ERJMP .+1 ;IGNORE ERROR
CALL GETERR ;GET AND PRINT ERROR
JRST STOP ;HALT EXECUTION
SUBTTL General Subroutines -- Non-fatal JSYS Error
JERR: CRLF ;NEW LINE
HRROI T1,[ASCIZ/?ENQTST error: /]
PSOUT ;PRINT ERROR HEADER
ERJMP .+1 ;IGNORE ERROR
CALL GETERR ;GET AND PRINT ERROR
JRST ENQTST ;RESTART
SUBTTL General Subroutines -- Command Error
COMERR: CRLF ;NEW LINE
HRROI T1,[ASCIZ/?ENQTST command error: /]
PSOUT ;PRINT ERROR HEADER
ERJMP .+1 ;IGNORE ERROR
CALL GETERR ;GET AND PRINT ERROR
JRST ENQTST ;RESTART
SUBTTL General Subroutines -- Print Last Error Code
GETERR: HRROI T1,STRBUF ;PLACE IN STRING BUFFER
MOVE T2,[.FHSLF,,-1] ;GET OUT MOST RECENT ERROR
HRRZI T3,STRSZE ;SIZE OF BUFFER
ERSTR ;GET ERROR STRING
JFCL ;ERROR
SKIPA T1,[POINT 7,[ASCIZ/Unknown error code/]] ;ERROR
HRROI T1,STRBUF ;POINT TO ERROR STRING
PSOUT ;PRINT ERROR
ERJMP .+1 ;IGNORE ERROR
CRLF ;NEW LINE
MOVEI T1,.PRIIN
CFIBF ;CLEAR INPUT BUFFER
ERJMP .+1 ;IGNORE ERROR
RET ;RETURN
SUBTTL General Subroutines -- Parse Input Filespec
INSPC: MOVEI T1,CMDSBK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. .CMIFI]
COMND ;PARSE INPUT FILESPEC
ERJMP FJERR ;FATAL JSYS ERROR
TXNE T1,CM%NOP ;PARSE SUCCESSFUL?
JRST COMERR ;NO, REPORT ERROR
RET ;RETURN
SUBTTL General Subroutines -- Parse Arbitrary Filespec
ARSPC: MOVEI T1,CMDSBK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. .CMFIL,<CM%HPP+CM%SDH>,,<filespec>]
COMND ;PARSE KEY FILESPEC
ERJMP FJERR ;FATAL JSYS ERROR
TXNE T1,CM%NOP ;SUCCESSFUL PARSE?
JRST COMERR ;NO, REPORT ERROR
RET ;RETURN
RET ;RETURN
SUBTTL General Subroutines -- Release Unwanted JFNS
RELJFN: RLJFN ;RELEASE IT
ERJMP .+1 ;IGNORE ERROR
RET ;RETURN
SUBTTL General Subroutines -- Check File Status
; PRINTS ERROR MESSAGE IF NOT AT EOF
; RETURNS+1: IF AT EOF
; +2: IF NOT AT EOF
FILSTS: GTSTS ;GET FILE STATUS
ERJMP FJERR ;ERROR
TXNE T2,GS%EOF ;AT END OF FILE?
RET ;YES
ERR(
%ENQTST: File I/O error - ) ;FIRST PART OF MESSAGE
CALL GETERR ;PRINT MOST RECENT ERROR
RETSKP ;SKIP
SUBTTL Command Processing
SUBTTL Command Processing -- Enable Cluster-wide ENQ
ENA: NOISE (cluster-wide ENQ functionality for process)
CONFIRM ;CONFIRM THE COMMAND
MOVEI T1,.ENECL ;GET THE FUNCTION CODE
ENQ% ;ENABLE IT
ERJMP FJERR ;FATAL ERROR
JRST ENQTST ;DONE
SUBTTL Command Processing -- Open a File
OPEN: MOVE T1,JFNNUM ;GET NUMBER OF JFNS
CAIE T1,OPMAX ;ARE THERE ANY MORE SLOTS?
IFSKP. ;NO
ERR(
?ENQTST: No more available file numbers for OPEN
%ENQTST: CLOSE some files to obtain some more)
JRST ENQTST ;RESTART
ENDIF.
NOISE (file) ;PARSE NOISE
CALL ARSPC ;PARSE ARBITRARY FILESPEC
MOVEM T2,Q1 ;SAVE JFN FOR A MOMENT
CONFIRM ;CONFIRM THE COMMAND
SETOM Q2 ;INIT LOOP COUNTER
DO. ;NOW SCAN THE TABLE FOR AN EMPTY SLOT
AOS Q2 ;MOVE TO NEXT SLOT
CAIG Q2,OPMAX-1 ;PAST THE END?
IFSKP. ;YES
ERR(
?ENQTST: Fatal internal error - OPJFNS and/or JFNNUM are wrong!)
JRST STOP ;QUIT DUE TO IMPOSSIBLE ERROR
ENDIF.
SKIPE OPJFNS(Q2) ;IS THIS SLOT EMPTY?
LOOP. ;NO, DO NEXT SLOT
ENDDO.
AOS JFNNUM ;ONE MORE FILE SLOT IN USE
HRRZM Q1,OPJFNS(Q2) ;STORE JFN
HRRZ T1,Q1 ;PUT JFN IN CORRECT SPOT
MOVX T2,OF%RD+OF%WR+OF%THW ;OPEN THE FILE FOR ...
OPENF ;... SHARED READ/WRITE
ERJMP FJERR ;ERROR
TMSG <
[ENQTST: OPEN was successful. Use file number >
MOVX T1,.PRIOU ;PRIMARY OUTPUT
MOVE T2,Q2 ;NUMBER TO PRINT
MOVEI T3,^D10 ;DECIMAL
NOUT ;PRINT THE NUMBER TO USE FOR FILE
ERJMP FJERR ;ERROR
TMSG < to refer to the file.]
>
JRST ENQTST ;DONE
SUBTTL Command Processing -- Close a File
CLOSE: NOISE (file number) ;PARSE NOISE
MOVEI T1,CMDSBK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. .CMNUM,<CM%HPP+CM%SDH>,^D10,<file number obtained from OPEN>]
COMND ;PARSE NUMBER
ERJMP FJERR ;FATAL JSYS ERROR
TXNE T1,CM%NOP ;SUCCESSFUL PARSE?
JRST COMERR ;NO, REPORT ERROR
MOVEM T2,Q1 ;[1] Save results for a moment
CONFIRM ;[1] Confirm the command
SKIPL Q1 ;IS THE NUMBER NEGATIVE?
IFSKP. ;YES - BAD INPUT
ERR(
?ENQTST: A file number can never be negative)
JRST ENQTST ;DONE
ENDIF.
SKIPE T1,OPJFNS(Q1) ;[1] GET THE JFN FOR THE FILE NUMBER
IFSKP. ;NO MATCHING JFN!
ERR(
?ENQTST: There is no file number which matches input value)
JRST ENQTST ;DONE
ENDIF.
CLOSF ;CLOSE THE FILE
ERJMP FJERR ;ERROR
SETZM OPJFNS(Q1) ;CLEAR THE SLOT
SOS JFNNUM ;ONE LESS FILE NUMBER IN USE
JRST ENQTST ;DONE
SUBTTL Command Processing -- Begin a Request
BEGIN: MOVE T1,OPNUM ;GET NUMBER OF REQUESTS
CAIE T1,OPMAX ;IS THERE ANY MORE ROOM?
IFSKP. ;NO
ERR(
?ENQTST: No more available request slots
%ENQTST: CLEAR this request set and then more can be specified)
JRST ENQTST ;RESTART
ENDIF.
NOISE (a new request) ;PARSE NOISE
CONFIRM ;CONFIRM COMMAND LINE
SKIPL ENQFLG ;HAS A BEGIN ALREADY BEEN ISSUED?
IFSKP. ;YES! ERROR.
ERR(
?ENQTST: A BEGIN/ADJUST has already been issued and is in progress
%ENQTST: End it with an END before issuing another BEGIN)
JRST ENQTST ;RESTART
ENDIF.
SKIPE OPNUM ;ARE THERE ANY OTHER REQUESTS YET?
IFSKP. ;NO, SO INIT ARGBLOCK
SETZM OPABLK ;ZERO FIRST WORD OF ARGBLOCK
MOVE T1,[OPABLK,,OPABLK+1]
BLT T1,OPABLK+OPASIZ-1 ;CLEAR THE ENTIRE ARGBLOCK
ENDIF.
SETZM LKFLAG ;ZERO FIRST REQUEST VARIABLE
MOVE T1,[LKFLAG,,LKFLAG+1]
BLT T1,LKREQ-1 ;CLEAR ALL THE OTHER REQUEST VARIABLES
AOS OPNUM ;ANOTHER REQUEST IN ARGBLOCK
MOVE T1,ENQFLG ;GET FLAGS
TXO T1,BEGIP ;SET BEGIN-IN-PROGRESS BIT
MOVEM T1,ENQFLG ;REPLACE WORD
JRST ENQTST ;DONE
SUBTTL Command Processing -- Adjust a Request
ADJUST: NOISE (a current request) ;[1] PARSE NOISE
MOVEI T1,CMDSBK ;[1] GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. .CMNUM,<CM%HPP+CM%SDH>,^D10,<request number>] ;[1]
COMND ;[1] PARSE NUMBER
ERJMP FJERR ;[1] FATAL JSYS ERROR
TXNE T1,CM%NOP ;[1] SUCCESSFUL PARSE?
JRST COMERR ;[1] NO, REPORT ERROR
MOVEM T2,Q1 ;[1] SAVE NUMBER FOR A MOMENT
CONFIRM ;[1] CONFIRM THE COMMAND
SKIPL ENQFLG ;[1] HAS A BEGIN ALREADY BEEN ISSUED?
IFSKP. ;[1] YES! ERROR.
ERR(
?ENQTST: A BEGIN/ADJUST has already been issued and is in progress
%ENQTST: End it with an END before issuing another ADJUST) ;[1]
JRST ENQTST ;[1] RESTART
ENDIF. ;[1]
SKIPLE Q1 ;[1] IS THE NUMBER NEGATIVE?
IFSKP. ;[1] YES - BAD INPUT
ERR(
?ENQTST: A request number can never be negative or zero) ;[1]
JRST ENQTST ;[1] DONE
ENDIF. ;[1]
CAMG Q1,OPNUM ;[1] IS THE NUMBER TOO BIG?
IFSKP. ;[1] YES - BAD INPUT
ERR(
?ENQTST: Request number too large) ;[1]
JRST ENQTST ;[1] DONE
ENDIF. ;[1]
MOVE T1,OPNUM ;[1] GET THE CURRENT NUMBER OF REQUESTS
MOVEM T1,ADNUM ;[1] SAVE IT FOR LATER
MOVEM Q1,OPNUM ;[1] NOW SET UP INPUT AS CURRENT REQUEST
;[1] NOW RESTORE THE REQUEST VARIABLES FROM THE ARGBLOCK
MOVEI T2,OPABLK ;[1] GET ADDRESS OF ARGBLOCK
SOS Q1 ;[1] NOW CALCULATE OFFSET INTO ARGBLOCK
IMULI Q1,4 ;[1]
ADD T2,Q1 ;[1] ADD OFFSET TO ARGBLOCK POINTER
HLLZ T1,.ENQLV(T2) ;[1] RESTORE FLAGS AND LEVEL
TXZ T1,EN%LVL ;[1] MASK OFF LEVEL
MOVEM T1,LKFLAG ;[1] SAVE THE FLAGS
LOAD T1,EN%LVL,.ENQLV(T2) ;[1] RESTORE ...
MOVEM T1,LKLVL ;[1] ... LOCK LEVEL
HRRZ T1,.ENQLV(T2) ;[1] RESTORE ...
MOVEM T1,LKTYPE ;[1] ... TYPE OF LOCK
MOVE T1,.ENQUC(T2) ;[1] RESTORE ...
MOVEM T1,LKSTUC ;[1] ... USER CODE OR STRING POINTER
HLRZ T1,.ENQRS(T2) ;[1] RESTORE ...
MOVEM T1,LKPOOL ;[1] ... POOL TOTAL
HRRZ T1,.ENQRS(T2) ;[1] RESTORE ...
MOVEM T1,LKGRP ;[1] ... SHARER GROUP OR NUMBER FROM POOL
MOVE T1,.ENQMS(T2) ;[1] RESTORE ...
MOVEM T1,LKMASK ;[1] ... MASK BLOCK ADDRESS
MOVE T1,ENQFLG ;[1] GET FLAGS
TXO T1,BEGIP ;[1] SET BEGIN-IN-PROGRESS BIT
MOVEM T1,ENQFLG ;[1] REPLACE WORD
JRST ENQTST ;[1] DONE
SUBTTL Command Processing -- End a Request
END: NOISE (the current request) ;PARSE NOISE
CONFIRM ;CONFIRM COMMAND LINE
SKIPGE ENQFLG ;HAS A BEGIN BEEN ISSUED?
IFSKP. ;YES! ERROR.
ERR(
?ENQTST: A BEGIN/ADJUST has not yet been issued so there is no request to END)
JRST ENQTST ;RESTART
ENDIF.
;NOW FILL IN THE HEADER WORDS OF THE ARGBLOCK (.ENQLN AND .ENQID)
MOVEI T2,OPABLK ;GET ADDRESS OF ARGBLOCK
SKIPE ADNUM ;[1] Is an adjust in progress?
IFSKP. ;[1] No
MOVE T1,OPNUM ;[1] GET NUMBER OF REQUESTS
HRLZM T1,.ENQLN(T2) ;[1] PUT IN ARGBLOCK
IMULI T1,4 ;[1] CALCULATE ARGBLOCK SIZE
ADDI T1,2 ;[1]
HRRM T1,.ENQLN(T2) ;[1] PUT IN ARGBLOCK
ENDIF. ;[1]
MOVE T1,LKPSI ;GET PSI CHANNEL
HRLZM T1,.ENQID(T2) ;PUT IN ARGBLOCK
MOVE T1,LKREQ ;GET REQUEST ID
HRRM T1,.ENQID(T2) ;PUT IN ARGBLOCK
MOVE T1,OPNUM ;NOW CALCULATE OFFSET INTO ARGBLOCK
SOS T1
IMULI T1,4
ADD T2,T1 ;ADD OFFSET TO ARGBLOCK POINTER
;NOW FILL IN THE REQUEST SPECIFIC WORDS IN THE ARGBLOCK (.ENQLV TO .ENQMS)
MOVE T1,LKFLAG ;GET THE FLAGS
MOVEM T1,.ENQLV(T2) ;PUT IN ARGBLOCK
MOVE T1,LKLVL ;GET LOCK LEVEL
STOR T1,EN%LVL,.ENQLV(T2) ;PUT IN ARGBLOCK
MOVE T1,LKTYPE ;GET TYPE OF LOCK
HRRM T1,.ENQLV(T2) ;PUT IN ARGBLOCK
MOVE T1,LKSTUC ;GET USER CODE OR STRING POINTER
MOVEM T1,.ENQUC(T2) ;PUT IN ARGBLOCK
MOVE T1,LKPOOL ;GET POOL TOTAL
HRLZM T1,.ENQRS(T2) ;PUT IN ARGBLOCK
MOVE T1,LKGRP ;GET SHARER GROUP OR NUMBER FROM POOL
HRRM T1,.ENQRS(T2) ;PUT IN ARGBLOCK
MOVE T1,LKMASK ;GET MASK BLOCK ADDRESS
MOVEM T1,.ENQMS(T2) ;PUT IN ARGBLOCK
MOVE T1,ENQFLG ;GET FLAGS
TXZ T1,BEGIP ;CLEAR BEGIN-IN-PROGRESS BIT
MOVEM T1,ENQFLG ;REPLACE WORD
SKIPN T1,ADNUM ;[1] Were we doing an adjust?
IFSKP. ;[1] Yes
MOVEM T1,OPNUM ;[1] Restore OPNUM
SETZM ADNUM ;[1] No more adjust
ENDIF. ;[1]
JRST ENQTST ;DONE
SUBTTL Command Processing -- Clear Requests
CLEAR: NOISE (all previous and current requests) ;PARSE NOISE
CONFIRM ;CONFIRM COMMAND
SETZM ENQFLG ;CLEAR FLAG
SETZM OPNUM ;NO MORE REQUESTS
SETZM ADNUM ;[1] No more adjust
SETZM OPABLK ;ZERO FIRST WORD OF ARGBLOCK
MOVE T1,[OPABLK,,OPABLK+1]
BLT T1,OPABLK+OPASIZ-1 ;CLEAR THE ENTIRE ARGBLOCK
SETZM LKREQ ;CLEAR REQUEST-ID
SETZM LKPSI ;CLEAR PSI CHANNEL
JRST ENQTST ;DONE
SUBTTL Command Processing -- Set a Request Parameter
SET: SKIPGE ENQFLG ;HAS A REQUEST BEEN BEGUN?
IFSKP. ;NO, DIE IMMEDIATELY
ERR(
?ENQTST: No BEGIN/ADJUST has been issued to start a request
%ENQTST: No request parameters can be SET until this is done)
JRST ENQTST ;QUIT
ENDIF.
NOISE (request parameter) ;PARSE NOISE
MOVEI T2,[FLDDB. .CMKEY,,SETLST]
COMND ;PARSE COMMAND
ERJMP FJERR ;FATAL JSYS ERROR
TXNE T1,CM%NOP ;SUCCESSFUL PARSE?
JRST COMERR ;NO, REPORT ERROR
HRRZ T2,(T2) ;GET DISPATCH ADDRESS
JRST (T2) ;DO COMMAND
SUBTTL Command Processing -- Set a Request Parameter -- Keyword Table
SETLST: SETLEN,,SETLEN
T (ASCIZ-STRING,ASTRG) ;ASCIZ STRING
T (FLAG,REQFL) ;FLAGS
T (GROUP-NUMBER,GPNUM) ;GROUP NUMBER
T (LEVEL-NUMBER,LEVEL) ;LEVEL NUMBER
T (MASK-BLOCK,MASK) ;MASK BLOCK
T (NUMBER-FROM-POOL,PLNUM) ;NUMBER REQUESTED FROM POOL
T (OBJECT-TYPE,OBTYPE) ;OBJECT TYPE (FILE NUMBER, -1, -2, -3)
T (POOL-TOTAL,PLTOT) ;POOL TOTAL
T (PSI-CHANNEL,PSI) ;PSI
T (REQUEST-ID,REQID) ;REQUEST-ID
T (USER-CODE,UCODE) ;USER CODE
SETLEN==.-SETLST-1 ;LENGTH OF PARAMETER LIST
SUBTTL Command Processing -- Set a Request Parameter -- Group Number
GPNUM: NOISE (to) ;PARSE NOISE
MOVEI T1,CMDSBK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. .CMNUM,<CM%HPP+CM%SDH>,^D10,<number of sharer group>]
COMND ;PARSE NUMBER
ERJMP FJERR ;FATAL JSYS ERROR
TXNE T1,CM%NOP ;SUCCESSFUL PARSE?
JRST COMERR ;NO, REPORT ERROR
MOVEM T2,Q1 ;SAVE THE NUMBER
CONFIRM ;CONFIRM THE COMMAND
MOVEM Q1,LKGRP ;SAVE THE INPUT
SETZM LKPOOL ;CAN'T HAVE POOL TOTAL IF SHARER GROUPS USED
JRST ENQTST ;DONE
SUBTTL Command Processing -- Set a Request Parameter -- Level Number
LEVEL: NOISE (to) ;PARSE NOISE
MOVEI T1,CMDSBK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. .CMNUM,<CM%HPP+CM%SDH>,^D10,<level number of request>]
COMND ;PARSE NUMBER
ERJMP FJERR ;FATAL JSYS ERROR
TXNE T1,CM%NOP ;SUCCESSFUL PARSE?
JRST COMERR ;NO, REPORT ERROR
MOVEM T2,Q1 ;SAVE THE NUMBER
CONFIRM ;CONFIRM THE COMMAND
MOVEM Q1,LKLVL ;SAVE THE INPUT
JRST ENQTST ;DONE
SUBTTL Command Processing -- Set a Request Parameter -- Pool Amount
PLNUM: NOISE (to) ;PARSE NOISE
MOVEI T1,CMDSBK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. .CMNUM,<CM%HPP+CM%SDH>,^D10,<number of resources from pool>]
COMND ;PARSE NUMBER
ERJMP FJERR ;FATAL JSYS ERROR
TXNE T1,CM%NOP ;SUCCESSFUL PARSE?
JRST COMERR ;NO, REPORT ERROR
MOVEM T2,Q1 ;SAVE THE NUMBER
CONFIRM ;CONFIRM THE COMMAND
MOVEM Q1,LKGRP ;SAVE THE INPUT
JRST ENQTST ;DONE
SUBTTL Command Processing -- Set a Request Parameter -- Object Type
OBTYPE: NOISE (to) ;PARSE NOISE
MOVEI T1,CMDSBK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. .CMNUM,<CM%HPP+CM%SDH>,^D10,<object type: file number, -1, -2, -3>]
COMND ;PARSE NUMBER
ERJMP FJERR ;FATAL JSYS ERROR
TXNE T1,CM%NOP ;SUCCESSFUL PARSE?
JRST COMERR ;NO, REPORT ERROR
MOVEM T2,Q1 ;SAVE THE NUMBER
CONFIRM ;CONFIRM THE COMMAND
SKIPGE Q1 ;IS THIS A FILE TYPE
IFSKP. ;YES
CAIGE Q1,OPMAX ;IS THE VALUE TOO HIGH?
SKIPN Q1,OPJFNS(Q1) ;OR NO JFN FOR FILE NUMBER?
IFNSK. ;YES - ERROR!
ERR(
?ENQTST: Object type is invalid
%ENQTST: Value is too high or no corresponding file for file number)
JRST ENQTST ;DONE
ENDIF.
ENDIF.
MOVEM Q1,LKTYPE ;SAVE THE INPUT
JRST ENQTST ;DONE
SUBTTL Command Processing -- Set a Request Parameter -- Pool Total
PLTOT: NOISE (to) ;PARSE NOISE
MOVEI T1,CMDSBK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. .CMNUM,<CM%HPP+CM%SDH>,^D10,<pool total>]
COMND ;PARSE NUMBER
ERJMP FJERR ;FATAL JSYS ERROR
TXNE T1,CM%NOP ;SUCCESSFUL PARSE?
JRST COMERR ;NO, REPORT ERROR
MOVEM T2,Q1 ;SAVE THE NUMBER
CONFIRM ;CONFIRM THE COMMAND
MOVEM Q1,LKPOOL ;SAVE THE INPUT
JRST ENQTST ;DONE
SUBTTL Command Processing -- Set a Request Parameter -- PSI Channel
PSI: NOISE (to) ;PARSE NOISE
MOVEI T1,CMDSBK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. .CMNUM,<CM%HPP+CM%SDH>,^D10,<PSI channel: 0-5, 23-35>]
COMND ;PARSE NUMBER
ERJMP FJERR ;FATAL JSYS ERROR
TXNE T1,CM%NOP ;SUCCESSFUL PARSE?
JRST COMERR ;NO, REPORT ERROR
MOVEM T2,Q1 ;SAVE THE NUMBER
CONFIRM ;CONFIRM THE COMMAND
MOVEM Q1,LKPSI ;SAVE THE INPUT
JRST ENQTST ;DONE
SUBTTL Command Processing -- Set a Request Parameter -- Request ID
REQID: NOISE (to) ;PARSE NOISE
MOVEI T1,CMDSBK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. .CMNUM,<CM%HPP+CM%SDH>,^D10,<ID for entire request>]
COMND ;PARSE NUMBER
ERJMP FJERR ;FATAL JSYS ERROR
TXNE T1,CM%NOP ;SUCCESSFUL PARSE?
JRST COMERR ;NO, REPORT ERROR
MOVEM T2,Q1 ;SAVE THE NUMBER
CONFIRM ;CONFIRM THE COMMAND
MOVEM Q1,LKREQ ;SAVE THE INPUT
JRST ENQTST ;DONE
SUBTTL Command Processing -- Set a Request Parameter -- User Code
UCODE: NOISE (to) ;PARSE NOISE
MOVEI T1,CMDSBK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. .CMNUM,<CM%HPP+CM%SDH>,^D10,<user code>]
COMND ;PARSE NUMBER
ERJMP FJERR ;FATAL JSYS ERROR
TXNE T1,CM%NOP ;SUCCESSFUL PARSE?
JRST COMERR ;NO, REPORT ERROR
MOVEM T2,Q1 ;SAVE THE NUMBER
CONFIRM ;CONFIRM THE COMMAND
TXO Q1,5B2 ;PUT IN PROPER FORMAT
LOAD T3,NMFLG,Q1 ;GET FIRST BYTE
CAIN T3,NUMVAL ;IS THIS A USER CODE?
IFSKP. ;NO - INVALID ENTRY
ERR(
?ENQTST: The value entered is not a valid user code)
JRST ENQTST ;RESTART
ENDIF.
MOVEM Q1,LKSTUC ;SAVE THE INPUT
JRST ENQTST ;DONE
SUBTTL Command Processing -- Set a Request Parameter -- Flags
REQFL: NOISE (named) ;PARSE NOISE
MOVEI T2,[FLDDB. .CMKEY,,FLGLST]
COMND ;PARSE COMMAND
ERJMP FJERR ;FATAL JSYS ERROR
TXNE T1,CM%NOP ;SUCCESSFUL PARSE?
JRST COMERR ;NO, REPORT ERROR
HRRZ T2,(T2) ;GET DISPATCH ADDRESS
JRST (T2) ;DO COMMAND
SUBTTL Command Processing -- Set a Request Parameter -- Flags -- Keyword Table
FLGLST: FLGLEN,,FLGLEN
T (EXCLUSIVE,FEXCL) ;EXCLUSIVE
T (IGNORE-LEVEL-NUMBERS,FIGLV) ;IGNORE LEVEL NUMBERS
T (LONG-TERM-LOCK,FLNG) ;THIS IS A LONG TERM LOCK
T (NESTING,FNEST) ;ALLOW NESTING
T (NO-NESTING,FNNST) ;DISALLOW NESTING
T (NORMAL-LOCK,FNORM) ;THIS IS NOT A LONG TERM LOCK
T (REQUIRE-LEVEL-NUMBERS,FRELV) ;REQUIRE LEVEL NUMBERS
T (SHARED,FSHAR) ;SHARED
FLGLEN==.-FLGLST-1 ;LENGTH OF PARAMETER LIST
SUBTTL Command Processing -- Set a Request Parameter -- Flags -- Shared
FSHAR: CONFIRM ;CONFIRM THE COMMAND
MOVE T1,LKFLAG ;GET FLAGS
TXO T1,EN%SHR ;SET SHARED FLAG
MOVEM T1,LKFLAG ;RESTORE FLAGS
JRST ENQTST ;DONE
SUBTTL Command Processing -- Set a Request Parameter -- Flags -- Exclusive
FEXCL: CONFIRM ;CONFIRM THE COMMAND
MOVE T1,LKFLAG ;GET FLAGS
TXZ T1,EN%SHR ;CLEAR SHARED FLAG
MOVEM T1,LKFLAG ;RESTORE FLAGS
JRST ENQTST ;DONE
SUBTTL Command Processing -- Set a Request Parameter -- Flags -- Ignore Levels
FIGLV: CONFIRM ;CONFIRM THE COMMAND
MOVE T1,LKFLAG ;GET FLAGS
TXO T1,EN%BLN ;SET LEVEL FLAG
MOVEM T1,LKFLAG ;RESTORE FLAGS
JRST ENQTST ;DONE
SUBTTL Command Processing -- Set a Request Parameter -- Flags -- Require Levels
FRELV: CONFIRM ;CONFIRM THE COMMAND
MOVE T1,LKFLAG ;GET FLAGS
TXZ T1,EN%BLN ;CLEAR LEVEL FLAG
MOVEM T1,LKFLAG ;RESTORE FLAGS
JRST ENQTST ;DONE
SUBTTL Command Processing -- Set a Request Parameter -- Flags -- Nesting
FNEST: CONFIRM ;CONFIRM THE COMMAND
MOVE T1,LKFLAG ;GET FLAGS
TXO T1,EN%NST ;SET NEST FLAG
MOVEM T1,LKFLAG ;RESTORE FLAGS
JRST ENQTST ;DONE
SUBTTL Command Processing -- Set a Request Parameter -- Flags -- No Nesting
FNNST: CONFIRM ;CONFIRM THE COMMAND
MOVE T1,LKFLAG ;GET FLAGS
TXZ T1,EN%NST ;CLEAR NEST FLAG
MOVEM T1,LKFLAG ;RESTORE FLAGS
JRST ENQTST ;DONE
SUBTTL Command Processing -- Set a Request Parameter -- Flags -- Long Term
FLNG: CONFIRM ;CONFIRM THE COMMAND
MOVE T1,LKFLAG ;GET FLAGS
TXO T1,EN%LTL ;SET LONG TERM FLAG
MOVEM T1,LKFLAG ;RESTORE FLAGS
JRST ENQTST ;DONE
SUBTTL Command Processing -- Set a Request Parameter -- Flags -- Normal
FNORM: CONFIRM ;CONFIRM THE COMMAND
MOVE T1,LKFLAG ;GET FLAGS
TXZ T1,EN%LTL ;CLEAR LONG TERM FLAG
MOVEM T1,LKFLAG ;RESTORE FLAGS
JRST ENQTST ;DONE
SUBTTL Command Processing -- Set a Request Parameter -- String
ASTRG: NOISE (to) ;PARSE NOISE
MOVEI T1,CMDSBK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. .CMQST,<CM%HPP+CM%SDH>,,<string enclosed in quotes>]
COMND ;PARSE NUMBER
ERJMP FJERR ;FATAL JSYS ERROR
TXNE T1,CM%NOP ;SUCCESSFUL PARSE?
JRST COMERR ;NO, REPORT ERROR
CONFIRM ;CONFIRM THE COMMAND
MOVE T1,OPNUM ;OFFSET INTO STRING SPACE ...
SOS T1 ;... FOR REQUEST NUMBER ...
IMULI T1,^D50 ;... CURRENTLY BEING PROCESSED
ADDI T1,OPSTRG
MOVE T2,[POINT 7,(T1)] ;MAKE A BYTE POINTER TO THE DESTINATION
MOVE T3,[POINT 7,ATMBUF] ;POINT TO THE ATOM BUFFER WITH THE STRING
SETZM Q1 ;INITIALIZE COUNTER
DO.
ILDB T4,T3 ;GET A BYTE FROM THE INPUT STRING
IDPB T4,T2 ;STORE IT IN THE DESTINATION AREA
JUMPE T4,ENDLP. ;IF NULL, DONE
AOS Q1 ;COUNT THIS ONE
CAIE Q1,^D50*5-1 ;TOO MANY IN THIS STRING?
IFSKP. ;YES
ERR(
%ENQTST: Warning - input string longer than 250 characters - truncating)
EXIT.
ENDIF.
LOOP. ;DO ANOTHER CHARACTER
ENDDO.
HRROS T1 ;NOW MAKE A POINTER TO DESTINATION AREA
MOVEM T1,LKSTUC ;SAVE THE INPUT
SKIPE Q1 ;IF NO STRING WAS INPUT ...
IFSKP. ;... PRINT A WARNING MESSAGE
ERR(
%ENQTST: Warning - string is of zero length)
ENDIF.
JRST ENQTST ;DONE
SUBTTL Command Processing -- Set a Request Parameter -- Mask Block
MASK: NOISE (to) ;PARSE NOISE
CRLF
MOVEI Q1,1 ;WORD OFFSET COUNTER
MOVE Q2,OPNUM ;OFFSET INTO MASK SPACE ...
SOS Q2 ;... FOR REQUEST NUMBER ...
IMULI Q2,^D16 ;... CURRENTLY BEING PROCESSED
ADDI Q2,OPMASK
MOVEM Q2,Q3 ;SAVE ADDRESS FOR LATER
AOS Q2 ;SKIP PAST HEADER
DO.
TMSG <Mask Block word >
MOVX T1,.PRIOU ;PRIMARY OUTPUT
MOVE T2,Q1 ;NUMBER TO PRINT
MOVEI T3,^D10 ;DECIMAL
NOUT ;PRINT THE NUMBER TO USE FOR FILE
ERJMP FJERR ;ERROR
TMSG <:>
MOVX T1,.PRIIN ;PRIMARY INPUT
MOVEI T3,^D8 ;OCTAL INPUT
NIN ;GET THE NUMBER
ERJMP ENDLP. ;ERROR - ASSUME END OF INPUT
MOVEM T2,(Q2) ;PUT IN MASK AREA
AOS Q1 ;STEP TO NEXT WORD
AOS Q2 ;STEP TO NEXT MASK AREA
CAIG Q1,^D15 ;MORE TO DO?
LOOP. ;YES
ENDDO.
MOVEM Q1,(Q3) ;PUT IN THE COUNT
MOVEM Q3,LKMASK ;SAVE THE INPUT
JRST ENQTST ;DONE
SUBTTL Command Processing -- Do the ENQ
DOENQ: NOISE (using the current request set) ;PARSE NOISE
MOVEI T1,CMDSBK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. .CMSWI,,SWIENQ,,/IMMEDIATE,[FLDDB. .CMCFM]]
COMND ;PARSE SWITCH OR CR
ERJMP FJERR ;FATAL JSYS ERROR
TXNE T1,CM%NOP ;SUCCESSFUL PARSE?
JRST COMERR ;NO, REPORT ERROR
MOVEM T2,Q1 ;SAVE SWITCH ENTERED
TXNE T1,CM%EOC ;WAS IF CONFIRMED?
IFSKP. ;NO
CONFIRM ;CONFIRM THE COMMAND
ENDIF.
SKIPL ENQFLG ;HAS A BEGIN BEEN ISSUED?
IFSKP. ;YES! ERROR.
ERR(
?ENQTST: A BEGIN/ADJUST has been issued and is still in progress
%ENQTST: End it with an END before issuing an ENQ)
JRST ENQTST ;RESTART
ENDIF.
HRRZ T1,(Q1) ;GET THE FUNCTION CODE
MOVEI T2,OPABLK ;GET ADDRESS OF BLOCK
ENQ ;DO THE FUNCTION
ERJMP JERR ;NON-FATAL ERROR
JRST ENQTST ;DONE
SUBTTL Command Processing -- Do the ENQ -- Switch Table
SWIENQ: SEQLEN,,SEQLEN
T (BLOCK,.ENQBL) ;BLOCK
T (IMMEDIATE,.ENQAA) ;IMMEDIATE
T (MODIFY,.ENQMA) ;MODIFY
T (PSI,.ENQSI) ;PSI
SEQLEN==.-SWIENQ-1 ;LENGTH OF PARAMETER LIST
SUBTTL Command Processing -- Do the DEQ
DODEQ: NOISE (using the current request set) ;PARSE NOISE
MOVEI T1,CMDSBK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. .CMSWI,,SWIDEQ,,/SPECIFIED,[FLDDB. .CMCFM]]
COMND ;PARSE SWITCH OR CR
ERJMP FJERR ;FATAL JSYS ERROR
TXNE T1,CM%NOP ;SUCCESSFUL PARSE?
JRST COMERR ;NO, REPORT ERROR
MOVEM T2,Q1 ;SAVE SWITCH ENTERED
TXNE T1,CM%EOC ;WAS IF CONFIRMED?
IFSKP. ;NO
CONFIRM ;CONFIRM THE COMMAND
ENDIF.
SKIPL ENQFLG ;HAS A BEGIN BEEN ISSUED?
IFSKP. ;YES! ERROR.
ERR(
?ENQTST: A BEGIN/ADJUST has been issued and is still in progress
%ENQTST: End it with an END before issuing a DEQ)
JRST ENQTST ;RESTART
ENDIF.
HRRZ T1,(Q1) ;GET THE FUNCTION CODE
MOVEI T2,OPABLK ;GET ADDRESS OF BLOCK
CAIN T1,.DEQID ;IS THIS A SPECIFIED DEQ?
MOVE T2,LKREQ ;YES, GET REQUEST ID
DEQ ;DO THE FUNCTION
ERJMP JERR ;NON-FATAL ERROR
JRST ENQTST ;DONE
SUBTTL Command Processing -- Do the DEQ -- Switch Table
SWIDEQ: SDQLEN,,SDQLEN
T (ALL,.DEQDA) ;ALL
T (ID,.DEQID) ;REQUEST-ID
T (SPECIFIED,.DEQDR) ;SPECIFIED
SDQLEN==.-SWIDEQ-1 ;LENGTH OF PARAMETER LIST
SUBTTL Command Processing -- Do the ENQC
DOENQC: NOISE (using the current request set) ;PARSE NOISE
MOVEI T1,CMDSBK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. .CMSWI,,SWIEQC,,/STATUS,[FLDDB. .CMCFM]]
COMND ;PARSE SWITCH OR CR
ERJMP FJERR ;FATAL JSYS ERROR
TXNE T1,CM%NOP ;SUCCESSFUL PARSE?
JRST COMERR ;NO, REPORT ERROR
MOVEM T2,Q1 ;SAVE SWITCH ENTERED
TXNE T1,CM%EOC ;WAS IF CONFIRMED?
IFSKP. ;NO
CONFIRM ;CONFIRM THE COMMAND
ENDIF.
SKIPL ENQFLG ;HAS A BEGIN BEEN ISSUED?
IFSKP. ;YES! ERROR.
ERR(
?ENQTST: A BEGIN/ADJUST has been issued and is still in progress
%ENQTST: End it with an END before issuing an ENQC)
JRST ENQTST ;RESTART
ENDIF.
HRRZ Q1,(Q1) ;GET THE FUNCTION CODE
MOVEI T2,OPABLK ;GET ADDRESS OF BLOCK
CAIE Q1,.ENQCS ;IS THIS A STATUS REQUEST?
IFSKP. ;YES
SETZM OPIBLK ;ZERO FIRST WORD OF ARGBLOCK
MOVE T1,[OPIBLK,,OPIBLK+1]
BLT T1,OPIBLK+OPISIZ-1 ;CLEAR THE ENTIRE ARGBLOCK
MOVEI T3,OPIBLK ;GET ADDRESS OF STATUS BLOCK
ELSE. ;NO, MUST BE DUMP
SETZM OPDBLK+1 ;ZERO FIRST WORD OF ARGBLOCK (PAST LENGTH)
MOVE T1,[OPDBLK+1,,OPDBLK+2]
BLT T1,OPDBLK+OPDSIZ ;CLEAR THE ENTIRE ARGBLOCK
MOVEI T2,OPDBLK ;GET ADDRESS OF DUMP BLOCK
ENDIF.
MOVE T1,Q1 ;POSITION FUNCTION CODE
ENQC ;DO THE FUNCTION
ERJMP JERR ;NON-FATAL ERROR
CAIE T1,.ENQCS ;WAS THIS A STATUS CALL?
IFSKP. ;YES, DO STATUS
TMSG <
Status Data for Specified Requests:
> ;PRINT HEADER
MOVE Q1,OPNUM ;GET NUMBER OF REQUESTS
MOVEI Q2,OPIBLK ;GET ADDRESS OF STATUS DATA
DO.
JUMPE Q1,ENQTST ;DONE WHEN ZERO
TMSG <----------------------------------------------------
>
MOVE Q3,(Q2) ;GET FLAGS WORD
TXNN Q3,EN%QCX ;IS LOCK EXCLUSIVE
IFSKP. ;YES
TMSG < This lock is exclusive
> ;[2][1]
ELSE.
TMSG < This lock is shared
> ;[2][1]
ENDIF.
TXNN Q3,EN%QCO ;DOES THIS PROCESS OWN LOCK?
IFSKP. ;YES
TMSG < This process owns the lock
>
ENDIF.
TXNN Q3,EN%QCQ ;IS PROCESS IN QUEUE WAITING
IFSKP. ;YES
TMSG < This process is queued for the lock
>
ENDIF.
TXNN Q3,EN%QCB ;IS PROCESS WAITING FOR EXCLUSIVE ACCESS?
IFSKP. ;YES
TMSG < This process is queued for exclusive access
>
ENDIF.
TMSG < Level number: >
LOAD T2,EN%LVL,(Q2) ;GET THE LEVEL NUMBER
MOVX T1,.PRIOU ;PRIMARY OUTPUT
MOVEI T3,^D10 ;DECIMAL
NOUT ;PRINT THE NUMBER
ERJMP FJERR ;ERROR
CRLF
TMSG < Owning job number: >
LOAD T2,EN%JOB,(Q2) ;GET THE JOB NUMBER
CAIE T2,-1 ;IS IT UNOWNED?
IFSKP. ;YES
TMSG <UNOWNED>
ELSE. ;NO
MOVX T1,.PRIOU ;PRIMARY OUTPUT
MOVEI T3,^D10 ;DECIMAL
NOUT ;PRINT THE NUMBER
ERJMP FJERR ;ERROR
ENDIF.
CRLF
TMSG < Time stamp: >
AOS Q2 ;STEP TO NEXT WORD
MOVE T2,(Q2) ;GET THE TIME STAMP
MOVX T1,.PRIOU ;PRIMARY OUTPUT
MOVEI T3,^D8 ;OCTAL
NOUT ;PRINT THE NUMBER
ERJMP FJERR ;ERROR
CRLF
TMSG < Number of locking processes: >
AOS Q2 ;STEP TO NEXT WORD
HLRZ T2,(Q2) ;GET THE NUMBER
MOVX T1,.PRIOU ;PRIMARY OUTPUT
MOVEI T3,^D10 ;DECIMAL
NOUT ;PRINT THE NUMBER
ERJMP FJERR ;ERROR
CRLF
TMSG < Request ID: >
HRRZ T2,(Q2) ;GET THE NUMBER
MOVX T1,.PRIOU ;PRIMARY OUTPUT
MOVEI T3,^D10 ;DECIMAL
NOUT ;PRINT THE NUMBER
ERJMP FJERR ;ERROR
CRLF
SOS Q1 ;ONE LESS TO DO
AOS Q2 ;MOVE TO NEXT STATUS WORD (FLAGS)
TMSG <----------------------------------------------------
>
LOOP. ;DO THE NEXT ONE
ENDDO.
ENDIF.
TMSG <
Dump of Entire ENQ Database:
>
MOVEI Q1,OPDBLK+1 ;GET ADDRESS OF DUMP DATA (PAST LENGTH WORD)
DO.
MOVE Q2,(Q1) ;GET THE FIRST WORD
MOVEM Q2,Q3 ;SAVE IT FOR LATER
CAMN Q2,[-1] ;END OF THE DUMP?
JRST ENQTST ;YES DONE
TMSG <--------------------------------------------------------------
>
TXNN Q2,EN%QCL ;IS THIS A LOCK?
IFSKP. ;YES
TMSG <*** LOCK-BLOCK ***
>
TXNN Q2,EN%QCC ;[3][1] Is this a cluster-wide lock?
IFSKP. ;[1] Yes
TMSG < This is a cluster-wide lock
> ;[3][1]
ENDIF. ;[1]
TXNN Q2,EN%QCN ;[1] Is voting required?
IFSKP. ;[1] No
TMSG < No voting is required for this lock
> ;[1]
ENDIF. ;[1]
TXNN Q2,EN%QCS ;[1] Does this lock need scheduling?
IFSKP. ;[1] Yes
TMSG < This lock needs scheduling
> ;[1]
ENDIF. ;[1]
ELSE. ;NO
TMSG <*** Q-BLOCK ***
>
TXNN Q2,EN%QCC ;[1] Is this a cluster-wide request?
IFSKP. ;[1] Yes
TMSG < This is a cluster-wide request
> ;[1]
ENDIF. ;[1]
TXNN Q2,EN%QCX ;[1] IS LOCK EXCLUSIVE
IFSKP. ;[1] YES
TMSG < This request is exclusive
> ;[1]
ELSE.
TMSG < This request is shared
> ;[1]
ENDIF.
ENDIF.
TXNN Q2,EN%QCO ;DOES THIS PROCESS OWN LOCK?
IFSKP. ;YES
TMSG < This process owns the lock
>
ENDIF.
TXNN Q2,EN%QCB ;IS PROCESS WAITING FOR EXCLUSIVE ACCESS?
IFSKP. ;YES
TMSG < This process is queued for exclusive access
>
ENDIF.
TMSG < Level number (LB) or PSI channel (QB): >
HLRZ T2,Q2 ;GET THE FIRST WORD
TRZ T2,777000 ;CLEAR OUT THE POSSIBLE FLAGS
MOVX T1,.PRIOU ;PRIMARY OUTPUT
MOVEI T3,^D10 ;DECIMAL
NOUT ;PRINT THE NUMBER
ERJMP FJERR ;ERROR
CRLF
TMSG < Object type (LB) or Creator job number (QB): >
HRRZ T2,Q2 ;GET THE TYPE
MOVX T1,.PRIOU ;PRIMARY OUTPUT
MOVEI T3,^D8 ;OCTAL
NOUT ;PRINT THE NUMBER
ERJMP FJERR ;ERROR
CRLF
AOS Q1 ;STEP TO NEXT WORD
MOVE Q2,(Q1) ;GET NEXT WORD
TMSG < Pool total (LB) or Group Number or Number Requested (QB): >
HLRZ T2,Q2 ;GET THE NUMBER
MOVX T1,.PRIOU ;PRIMARY OUTPUT
MOVEI T3,^D10 ;DECIMAL
NOUT ;PRINT THE NUMBER
ERJMP FJERR ;ERROR
CRLF
TMSG < Resources left (LB) or Request ID (QB): >
HRRZ T2,Q2 ;GET THE NUMBER
MOVX T1,.PRIOU ;PRIMARY OUTPUT
MOVEI T3,^D10 ;DECIMAL
NOUT ;PRINT THE NUMBER
ERJMP FJERR ;ERROR
CRLF
AOS Q1 ;STEP TO NEXT WORD
TXNE Q3,EN%QCL ;IS THIS A LOCK?
IFSKP. ;NO - QUIT
TMSG <--------------------------------------------------------------
>
LOOP. ;DO THE REST OF THE BLOCK
ENDIF.
MOVE Q2,(Q1) ;GET THE NEXT WORD
TMSG < Time stamp (LB): >
MOVE T2,Q2 ;GET THE NUMBER
MOVX T1,.PRIOU ;PRIMARY OUTPUT
MOVEI T3,^D8 ;OCTAL
NOUT ;PRINT THE NUMBER
ERJMP FJERR ;ERROR
CRLF
AOS Q1 ;STEP TO NEXT WORD
TMSG < User code or String (LB): >
MOVE T1,-.ENQDC(Q1) ;[1] Get flags word
TXNE T1,EN%QCT ;[1] Is this a user code?
IFSKP. ;YES
HLRZ T2,(Q1) ;GET THE LEFT HALF WORD
MOVX T1,.PRIOU ;PRIMARY OUTPUT
MOVEI T3,^D8 ;DECIMAL
NOUT ;PRINT THE NUMBER
ERJMP FJERR ;ERROR
TMSG <,,>
HRRZ T2,(Q1) ;GET THE RIGHT HALF WORD
MOVX T1,.PRIOU ;PRIMARY OUTPUT
MOVEI T3,^D8 ;DECIMAL
NOUT ;PRINT THE NUMBER
ERJMP FJERR ;ERROR
CRLF
AOS Q1 ;STEP TO NEXT WORD
TMSG <--------------------------------------------------------------
>
LOOP. ;DO THE REST OF THE BLOCK
ENDIF.
HRRO T1,Q1 ;GET THE LOCATION OF THE STRING
PSOUT ;PRINT IT
ERJMP FJERR ;ERROR
HRRM T1,Q1 ;STEP TO THE NEXT WORD ...
AOS Q1 ;... USING THE UPDATED BYTE POINTER + 1
CRLF
TMSG <--------------------------------------------------------------
>
LOOP. ;DO THE REST OF THE BLOCK
ENDDO.
SUBTTL Command Processing -- Do the ENQC -- Switch Table
SWIEQC: SQCLEN,,SQCLEN
T (DUMP,.ENQCD) ;DUMP
T (STATUS,.ENQCS) ;STATUS
SQCLEN==.-SWIEQC-1 ;LENGTH OF PARAMETER LIST
SUBTTL Interrupt Processing
GOPS00: BLOCK.
SAVEAC <T1,T2,T3,Q1> ;SAVE ALL USED ACS
SETZ Q1, ;[2] Indicate the channel
CALL PRTPSI ;PRINT THE MESSAGE
ENDBK.
DEBRK ;DONE
GOPS01: BLOCK.
SAVEAC <T1,T2,T3,Q1> ;SAVE ALL USED ACS
MOVEI Q1,^D1 ;INDICATE THE CHANNEL
CALL PRTPSI ;PRINT THE MESSAGE
ENDBK.
DEBRK ;DONE
GOPS02: BLOCK.
SAVEAC <T1,T2,T3,Q1> ;SAVE ALL USED ACS
MOVEI Q1,^D2 ;INDICATE THE CHANNEL
CALL PRTPSI ;PRINT THE MESSAGE
ENDBK.
DEBRK ;DONE
GOPS03: BLOCK.
SAVEAC <T1,T2,T3,Q1> ;SAVE ALL USED ACS
MOVEI Q1,^D3 ;INDICATE THE CHANNEL
CALL PRTPSI ;PRINT THE MESSAGE
ENDBK.
DEBRK ;DONE
GOPS04: BLOCK.
SAVEAC <T1,T2,T3,Q1> ;SAVE ALL USED ACS
MOVEI Q1,^D4 ;INDICATE THE CHANNEL
CALL PRTPSI ;PRINT THE MESSAGE
ENDBK.
DEBRK ;DONE
GOPS05: BLOCK.
SAVEAC <T1,T2,T3,Q1> ;SAVE ALL USED ACS
MOVEI Q1,^D5 ;INDICATE THE CHANNEL
CALL PRTPSI ;PRINT THE MESSAGE
ENDBK.
DEBRK ;DONE
GOPS23: BLOCK.
SAVEAC <T1,T2,T3,Q1> ;SAVE ALL USED ACS
MOVEI Q1,^D23 ;INDICATE THE CHANNEL
CALL PRTPSI ;PRINT THE MESSAGE
ENDBK.
DEBRK ;DONE
GOPS24: BLOCK.
SAVEAC <T1,T2,T3,Q1> ;SAVE ALL USED ACS
MOVEI Q1,^D24 ;INDICATE THE CHANNEL
CALL PRTPSI ;PRINT THE MESSAGE
ENDBK.
DEBRK ;DONE
GOPS25: BLOCK.
SAVEAC <T1,T2,T3,Q1> ;SAVE ALL USED ACS
MOVEI Q1,^D25 ;INDICATE THE CHANNEL
CALL PRTPSI ;PRINT THE MESSAGE
ENDBK.
DEBRK ;DONE
GOPS26: BLOCK.
SAVEAC <T1,T2,T3,Q1> ;SAVE ALL USED ACS
MOVEI Q1,^D26 ;INDICATE THE CHANNEL
CALL PRTPSI ;PRINT THE MESSAGE
ENDBK.
DEBRK ;DONE
GOPS27: BLOCK.
SAVEAC <T1,T2,T3,Q1> ;SAVE ALL USED ACS
MOVEI Q1,^D27 ;INDICATE THE CHANNEL
CALL PRTPSI ;PRINT THE MESSAGE
ENDBK.
DEBRK ;DONE
GOPS28: BLOCK.
SAVEAC <T1,T2,T3,Q1> ;SAVE ALL USED ACS
MOVEI Q1,^D28 ;INDICATE THE CHANNEL
CALL PRTPSI ;PRINT THE MESSAGE
ENDBK.
DEBRK ;DONE
GOPS29: BLOCK.
SAVEAC <T1,T2,T3,Q1> ;SAVE ALL USED ACS
MOVEI Q1,^D29 ;INDICATE THE CHANNEL
CALL PRTPSI ;PRINT THE MESSAGE
ENDBK.
DEBRK ;DONE
GOPS30: BLOCK.
SAVEAC <T1,T2,T3,Q1> ;SAVE ALL USED ACS
MOVEI Q1,^D30 ;INDICATE THE CHANNEL
CALL PRTPSI ;PRINT THE MESSAGE
ENDBK.
DEBRK ;DONE
GOPS31: BLOCK.
SAVEAC <T1,T2,T3,Q1> ;SAVE ALL USED ACS
MOVEI Q1,^D31 ;INDICATE THE CHANNEL
CALL PRTPSI ;PRINT THE MESSAGE
ENDBK.
DEBRK ;DONE
GOPS32: BLOCK.
SAVEAC <T1,T2,T3,Q1> ;SAVE ALL USED ACS
MOVEI Q1,^D32 ;INDICATE THE CHANNEL
CALL PRTPSI ;PRINT THE MESSAGE
ENDBK.
DEBRK ;DONE
GOPS33: BLOCK.
SAVEAC <T1,T2,T3,Q1> ;SAVE ALL USED ACS
MOVEI Q1,^D33 ;INDICATE THE CHANNEL
CALL PRTPSI ;PRINT THE MESSAGE
ENDBK.
DEBRK ;DONE
GOPS34: BLOCK.
SAVEAC <T1,T2,T3,Q1> ;SAVE ALL USED ACS
MOVEI Q1,^D34 ;INDICATE THE CHANNEL
CALL PRTPSI ;PRINT THE MESSAGE
ENDBK.
DEBRK ;DONE
GOPS35: BLOCK.
SAVEAC <T1,T2,T3,Q1> ;SAVE ALL USED ACS
MOVEI Q1,^D35 ;INDICATE THE CHANNEL
CALL PRTPSI ;PRINT THE MESSAGE
ENDBK.
DEBRK ;DONE
PRTPSI: TMSG <
%ENQTST: *** Got a PSI on channel >
MOVX T1,.PRIOU ;PRIMARY OUTPUT
MOVE T2,Q1 ;NUMBER TO PRINT
MOVEI T3,^D10 ;DECIMAL
NOUT ;PRINT THE NUMBER TO USE FOR FILE
ERJMP FJERR ;ERROR
TMSG < ***
>
RET ;DONE
END <3,,ENTVEC>