Trailing-Edge
-
PDP-10 Archives
-
BB-5372C-BM
-
sources/ip20.mac
There are 2 other files named ip20.mac in the archive. Click here to see a list.
TITLE IP20 - INTERPROGRAM COMMUNICATION ROUTINES FOR COBOL
; RICHARD H. PALM
; VERSION 1(1) NOVEMBER, DECEMBER 1976
; VERSION 1(3) JULY 76
;
; THE PURPOSE OF THESE ROUTINES IS TO PROVIDE A CONVENIENT MEANS BY
; WHICH COBOL PROGRAMS RUNNING ON THE DECSYSTEM-20 CAN EXCHANGE
; INFORMATION.
;
; THE ROUTINES CONTAINED HEREIN ARE:
; I. IPCRID - CREATE AN IDENTIFIER FOR THIS PROGRAM
; II. IPDLID - DELETE AN IDENTIFIER FOR THIS PROGRAM
; III. IPCRDX - CREATE AN INDEX FOR ANOTHER PROGRAM
; IV. IPDLDX - DELETE AN INDEX FOR ANOTHER PROGRAM
; V. IPSEND - SEND INFORMATION TO ANOTHER PROGRAM
; VI. IPRECV - RECEIVE INFORMATION FROM ANOTHER PROGRAM
; VII. IPWAIT - WAIT FOR AN EVENT TO OCCUR
; VIII. IPRUNI - TRANSFER CONTROL TO AN INFERIOR PROGRAM
;
COMMENT ^
EDIT HISTORY
============
2 PUT IN THE EDITS NECESSARY FOR WORKING WITH COBOL V12
MEMORY MANAGEMENT SCHEME. IP20 HAS BEEN PROGRAMMED TO
ONLY GET PAGES AND NOT TO PUT THEM BACK.
IN ORDER TO GET AROUND THE PROBLEM OF IP20 NEEDING SOME
MEMORY FOR THE ARGUMENT BLOCK USED IN THE CALL TO THE
MEMORY MANGAGEMENT ROUTINES, BEFORE IT HAS ACQUIRED ANY
LOW SEGMENT MEMORY; SOME WORDS IN THE .JBDAT AREA (
SPECIFICALLY .JBDDT+1 THRU .JBDDT+4 ARE TEMPORARILY
USED (AND RESTORED). THIS SHOULD NOT CAUSE ANY PROBLEMS.
3 PASS ON THE CAPABILITIES OF THE CURRENT PROCESS TO A CREATED
PROCESS.
^
;** THESE ROUTINES ARE WRITTEN TO WORK WITH THE COMPATIBILITY PACKAGE. **
;** ALL CODE WHICH IS COMPLETELY DEPENDENT UPON THE COMPATIBILITY **
;** PACKAGE IS INDICATED BY A COMMENT WHICH BEGINS WITH THE TWO **
;** CHARACTERS ;+. **
IF1,<PRINTX IPCF-20 VERSION 1(3)>
; REVISION HISTORY
SUBTTL SYMBOLS FOR CONDITIONAL ASSEMBLY AND TUNING
;
; THE DEFAULT VALUES FOR THE CONDITIONAL ASSEMBLY AND TUNING
; SYMBOLS ARE GIVEN HERE. THESE DEFAULTS CAN BE OVERRIDDEN BY
; DEFINING THE SYMBOL BEFORE THIS FILE IS ASSEMBLED. THIS
; FUNCTION MAY EASILY BE PERFORMED THROUGH THE USE OF A
; PARAMETER FILE.
;
; SYMBOLS WHICH CONTROL CONDITIONAL ASSEMBLY
IFNDEF FTPROD,<FTPROD==0> ;IF = 0, THIS IS A NONPRODUCTION
;VERSION. ASSEMBLE CODE TO PERFORM
;SPECIAL PARAMETER CHECKS (DEFAULT).
;ANY NONZERO VALUE WILL PRODUCE A
;PRODUCTION VERSION WITHOUT SPECIAL
;CHECKS.
IFNDEF FTLOW,<FTLOW==0> ;IF = 0, GENERATE THE ROUTINES TO BE LOADED
;INTO THE LOW SEGMENT (DEFAULT). ANY NONZERO
;VALUE WILL CAUSE THE ROUTINES TO BE ASSEMBLED
;AND LOADED INTO THE HIGH SEGMENT.
IFNDEF FTIEMG,<FTIEMG==0> ;IF = 0, PRINT ERROR MESSAGES ON CONTROLLING
;TERMINAL WHEN FATAL INTERNAL ERROR CONDITIONS
;ARE DETECTED (DEFAULT). THE DEFAULT STATUS OF
;THIS SWITCH SHOULD NORMALLY BE USED SINCE IT IS
;ALMOST IMPOSSIBLE TO DETERMINE WHAT HAPPENED,
;IF THE INTERNAL ERROR MESSAGES ARE NOT PRINTED.
;THIS SWITCH DOES NOT AFFECT THE HANDLING
;OF FATAL INTERNAL ERROR CONDITIONS IN ANY WAY
;EXCEPT TO DISABLE OR ENABLE THE PRINTING OF
;THE ERROR MESSAGE.
IFNDEF FTWT10,<FTWT10==0> ;IF = 0, THE IPWAIT ROUTINE WILL FUNCTION
;AS DESCRIBED IN THE DECSYSTEM-20
;DOCUMENTATION (DEFAULT). IF NOT = 0,
;THE IPWAIT ROUTINE WILL FUNCTION IN A
;MANNER WHICH IS COMPATIBLE WITH THE
;DECSYSTEM-10 SPECIFICATION.
; SYMBOLS WHICH MAY BE USED TO TUNE THE ROUTINES
IFNDEF IRQLTH,<IRQLTH=^D100> ;LENGTH OF THE IPCF INTERNAL RECEIVE QUEUE.
;ALSO, LENGTH OF RECEIVE MEMORY MANAGEMENT PAGE
; TABLE.
;THE MINIMUM VALUE OF THIS PARAMETER SHOULD BE
;THE MAXIMUM IPCF RECEIVE QUOTA ASSIGNED TO
;ANY ACCOUNT WHICH WILL BE USING THESE
;ROUTINES PLUS ONE.
IFNDEF IFRPLM,<IFRPLM=^D60000*3> ;MAX TIME LIMIT TO WAIT FOR <SYSTEM>INFO
;REPLY IN MILLISECONDS. THIS VALUE IS
;USED (ROUTINE INFWTR) WHEN A REPLY MUST BE
;RECEIVED BEFORE THESE ROUTINES CAN CONTINUE.
IFNDEF IFCKLM,<IFCKLM=^D1000*5> ;MAX TIME LIMIT TO WAIT FOR <SYSTEM>INFO
;REPLY IN MILLISECONDS. THIS VALUE IS
;USED (ROUTINE INFCKR) WHEN THESE ROUTINES
;MAY RECEIVE A REPLY FROM <SYSTEM>INFO AND
;WISH TO CHECK FOR THAT REPLY.
IFNDEF IDXMAX,<IDXMAX=^D50> ;THE MAXIMUM NUMBER OF EXTERNAL PROGRAM
;INDEXES WHICH MAY BE SIMULTANEOUSLY
;ASSIGNED
IFNDEF RTRYCT,<RTRYCT==5> ;TOTAL NUMBER OF TRIES OF AN IPCF SEND ON SOME
;RECOVERABLE ERRORS
IFNDEF RTRYWT,<RTRYWT=^D48> ;THE AMOUNT OF TIME TO WAIT (MILLISECONDS)
;BETWEEN RETIRES OF AN IPCF SEND ON
;RECOVERABLE ERRORS. THIS REPRESENTS 3
;CLOCK TICKS (IN THE U.S.). THIS VALUE WAS
;EMPIRICALLY DERIVED ON A HEAVILY LOADED
;SYSTEM. THE FOLLOWING PERFORMANCE WAS
;OBSERVED FOR A SEND QUOTA OF 2:
;65.0% WILL BE SENT AFTER 1 TRY
;95.0% WILL BE SENT AFTER 2 TIRES
;99.4% WILL BE SENT AFTER 3 TRIES
;99.9% WILL BE SENT AFTER 4 TRIES
;THE PROGRAMS USED ARE LISTED IN THE USER'S
;GUIDE.
IFNDEF R4CBL,<R4CBL==^D200> ;THE NUMBER OF PAGES OF THE LOWEST
;PORTION OF THE ADDRESS SPACE WHICH IS
;RESERVED FOR THE USE OF THE COBOL
;PROGRAM (I.E. PAGES 0 THROUGH R4CBL-1
;ARE RESERVED).
SUBTTL REGISTER DEFINITIONS
F=0 ;CONTAINS ROUTINE STATUS INDICATORS
;LH FLAGS LOCAL TO SOME ROUTINE
; CLEARED ON EXIT TO COBOL
F$RTS= 1B12 ;=1 IPCF DATA PACKET WAS RETURNED TO SENDER (IPRECV)
F$PGIO=1B13 ;=1 ASSIGNED PAGE MUST BE IN ADDR SPACE (IMMIN&IMMOUT)
F$SXBT=1B14 ;=1 COBOL MESSAGE ITEM FOR INFO IS SIXBIT (CPY2AZ)
F$WTTY=1B15 ;=1 TTY INPUT DETECTED IN WAIT LOOP (MWAIT)
F$WIPC=1B16 ;=1 IPCF PACKET DETECTED IN WAIT LOOP (MWAIT)
F$WTIM=1B17 ;=1 TIME INTERVAL EXPIRED IN WAIT LOOP (MWAIT)
;RH FLAGS GLOBAL TO ALL ROUTINES
; PRESERVED ACROSS COBOL CALLS
F$MPNV=1B34 ;=1 MY PID NOT VALID. IPCRID HAS ASSIGNED A
; PID, BUT THE ASSOCIATED NAME HAS NOT BEEN
; VALIDATED BY <SYSTEM>INFO
F$RMVR=1B35 ;=1 REGISTER R CONTAINS THE ADDRESS OF A RECEIVE
; DATA PAGE WHICH IS TO BE REMOVED FROM THE
; ADDRESS SPACE
T1=1 ;TEMPORARY REGISTER. MAY BE DESTROYED
T2=2 ; BY ANY ROUTINE.
T3=3 ; ...
T4=4 ; ...
I=5 ;BASE REGISTER FOR THE IMPURE DATA AREA
S=6 ;BASE REG FOR THE IPCF SEND DATA PAGE
R=7 ;BASE REG FOR THE IPCF RECEIVE DATA PAGE
P1=10 ;PERMANENT REGISTER. MAY NOT BE USED UNLESS
P2=11 ; ITS VALUE IS SAVED AND RESTORED
P3=12 ; ...
I1=13 ;REGISTER TO BE USED AT INTERRUPT LEVEL ONLY
MAXREG=13 ;MAXIMUM REGISTER SAVED BY THE ROUTINES
L=16 ;LINK REG - ADDR OF COBOL ARGUMENT LIST
P=17 ;STACK POINTER
IFN T1-1,<PRINTX TEMPORARY REGISTERS (T1-T4) MUST BE REGISTERS 1-4>
IFN FTLOW,< ;IF HIGH SEGMENT VERSION DESIRED,
TWOSEG ;TELL THE ASSEMBLER AND LINKER
RELOC 400000> ;DEFINE THE HIGH SEGMENT ORIGIN
SUBTTL MISCELLANEOUS SYMBOL DEFINITIONS
;
; THESE SYMBOLS SHOULD ONLY BE CHANGED IF IT IS COMPLETELY UNDERSTOOD
; WHAT THEY REPRESENT.
;
SEARCH MONSYM,MACSYM ;DEFINE DECSYSTEM-20 STANDARD SYMBOLS
PGLGTH=^D512 ;THE LENGTH OF ONE PAGE (IN WORDS)
PG2ADR==^D9 ;SHIFT CONST TO CONVERT PAGE NMB TO ADDR
ADR2PG=^D-9 ;SHIFT CONST TO CONVERT ADDR TO PAGE NMB
HGHPG=377 ;THE HIGHEST PAGE NUMBER OF THE ADDRESS
;SPACE WHICH WILL BE CONSIDERED FOR USE
;AS DYNAMICALLY ASSIGNED WORK AREAS.
LOWPG=R4CBL ;THE LOWEST PAGE NUMBER OF THE ADDRESS
;SPACE WHICH WILL BE CONSIDERED FOR USE
;AS DYNAMICALLY ASSIGNED WORK AREAS.
WTITTY==1B35 ;MWAIT INPUT - WAIT FOR TTY INPUT
WTIIPC==1B34 ;MWAIT INPUT - WAIT FOR IPCF RECEIVE PACKET
WTOTTY==1 ;MWAIT OUTPUT - TTY INPUT AVAILABLE
WTOIPC==2 ;MWAIT OUTPUT - IPCF MESSAGE RECEIVED
WTOTIM==3 ;MWAIT OUTPUT - TIME HAS EXPIRED
TP$CMP==2 ;COBOL PARAMETER LIST COMPUTATIONAL ITEM
TP$DSP==15 ;COBOL PARAMETER LIST DISPLAY ITEM
TP$D6==1 ;DISPLAY ITEM TYPE DISPLAY-6
TP$D7==2 ;DISPLAY ITEM TYPE DISPLAY-7
TP$DNM=1B7 ;DISPLAY ITEM NUMERIC INDICATOR FLAG
D6BYSZ==6 ;DISPLAY-6 BYTE SIZE
D7BYSZ==7 ;DISPLAY-7 BYTE SIZE
ABYTWD==5 ;NUMBER OF ASCII BYTES PER WORD
SBYTWD==6 ;NUMBER OF SIXBIT BYTES PER WORD
IPKHDL==4 ;LENGTH OF IPCF PACKET HEADER BLOCK
IFMGMX=^D29 ;MAXIMUM LENGTH OF <SYSTEM>INFO PROGRAM ID
INUSFL=1B0 ;=1 IRQ PAGE TABLE ENTRY IS IN USE
INSPFL=1B1 ;=1 IRQ PAGE TABLE ENTRY IS PART OF ADDR SPACE
IDXLTH==IDXMAX+1 ;LENGTH OF THE PROGRAM INDEX TABLE
IDXLOW==1 ;LOWEST LEGAL PROGRAM INDEX
IDXHGH==IDXMAX ;HIGHEST LEGAL PROGRAM INDEX
IPLTHO=^D510 ;OFFSET OF LENGTH FIELD IN IPCF DATA PAGE
IPSPDO=IPLTHO+1 ;OFFSET OF SENDER'S PID IN IPCF DATA PAGE
IPMGMX=IPLTHO ;MAX LENGTH OF IPCF INFO IN WORDS
IAMGMX=IPMGMX*ABYTWD ;MAX LENGTH OF IPCF INFO IN ASCII BYTES
ISMGMX=IPMGMX*SBYTWD ;MAX LENGTH OF IPCF INFO IN SIXBIT BYTES
CMNFST=^D13 ;MINIMUM LENGTH (BYTES) TO COPY FAST MODE
MNSMPK==^D8 ;MINIMUM SHORT PACKET LENGTH REQUIRED BY ME
MTLBKL==5 ;LENGTH OF ARGUMENT BLOCK FOR THE
; MUTIL JSYS. MAY BE EXTENDED IF
; NEW FUNCTION REQUIRES A LONGER BLOCK.
SILVL==2 ;SOFTWARE INTERRUPT ROUTINES PRIORITY LEVEL
SITTYC==4 ;SOFTWARE INTERRUPT CHANNEL FOR TTY TYPE-IN
SIIPCC==5 ;SOFTWARE INTERRUPT CHANNEL FOR IPCF PID
FSMXBY=^D7+^D41+^D39+^D40+^D7+^D2+^D8+^D8 ;MAX LENGTH OF FILE SPEC (BYTES)
FSMXWD=<FSMXBY+1+<ABYTWD-1>>/ABYTWD ;MAX LENGTH OF ASCIZ FILE SPEC (WORDS)
SUBTTL MACRO DEFINITIONS
SALL ;SUPPRESS ALL MACRO EXPANSIONS
;
; THE ENTRY MACRO (ENTR)
; THIS MACRO SHOULD BE USED TO DEFINE AN ENTRY POINT WHICH
; MAY BE REFERENCED BY A COBOL PROGRAM.
; ARGUMENTS:
; FIRST - THE NAME OF THE ROUTINE (4 CHARACTERS OR LESS). THE ROUTINE
; ENTRY POINTS ARE GENERATED BY CONCATENATING THE APPROPRIATE
; CHARACTERS TO THIS NAME.
; SECOND - THE NUMBER OF PARAMETERS REQUIRED
; THIRD - THE PARAMETER WHICH IS THE ERROR CODE. THE PARAMETERS ARE
; NUMBERED FROM ONE TO N WHERE N IS THE VALUE OF THE SECOND
; PARAMETER.
;
; THIS MACRO USES REGISTERS P1,T1, AND T2.
;
DEFINE ENTR (%%EPT$,%%PRM$,%%ERP$)
< XLIST
ENTRY IP'%%EPT$
IP'%%EPT$::
IFG %%ERP$-%%PRM$,<PRINTX ?ENTR MACRO ERROR-ERROR PARAMETER NOT LEGAL>
PUSH P,P1 ;;SAVE A PERMANENT REGISTER FOR OUR USE
MOVEI P1,%%ERP$-1(L) ;;DEFINE ERROR PARAM ADDR IN PARAM LIST
CALL INITI ;;INIT IMPURE AREA AND SAVE REGISTERS
IFE FTPROD,<;;IF NONPRODUCTION VERSION, CHECK NUMBER OF PARAMETERS
MOVEI T1,%%PRM$ ;;NUMBER OF PARAMETERS REQUIRED
MOVE T2,[SIXBIT/IP'%%EPT$/] ;;THE NAME OF THE ROUTINE
CALL CKPSZ ;;IF RETURNS, THEY ARE ALL THERE
> ;;END OF NONPRODUCTION VERSION CONDITIONAL ASSEMBLY
CALL INITRT ;;INITIALIZE THE ROUTINE
LIST
> ;;END OF ENTR MACRO DEFINITION
;
; MACRO TO GENERATE A USER ERROR ROUTINE
; ARGUMENT:
; FIRST - THE DECIMAL ERROR NUMBER WHICH IS TO BE RETURNED TO THE USER
;
DEFINE USERRM (%%ENM$)
< XLIST
MOVEI T1,^D'%%ENM$ ;;GET THE USER ERROR CODE
JRST ERRRET ;;RETURN THE ERROR CODE AND EXIT
LIST> ;;END OF USERRM MACRO DEFINITION
;
; MACRO TO GENERATE ERROR ROUTINES FOR INTERNAL CONSISTENCY CHECKS.
; ARGUMENTS:
; FIRST - THE INTERNAL CONSISTENCY CHECK CODE
;
DEFINE XCKERR (%%CDE$)
< XLIST
MOVX T2,SIXBIT/%%CDE$/ ;;GET THE SPECIFIC CHECK CODE
JRST INER5A ;;DISPLAY CODE, ERROR MSG, & RETURN
LIST
>;;END OF XCKERR MACRO DEFINITION
SUBTTL IPCRID - CREATE AN IDENTIFIER FOR THIS PROGRAM
;
; IPCRID - CREATE AN IDENTIFIER FOR THIS PROGRAM
; THE PURPOSE OF THIS ROUTINE IS TO MAKE AN IDENTIFICATION FOR THIS PROGRAM
; KNOWN TO THE INTERPROGRAM COMMUNICATION FACILITY. THIS ACTION IS
; NECESSARY SO THAT OTHER PROGRAMS MAY COMMUNICATE WITH THIS ONE THROUGH
; THE INTERPROGRAM COMMUNICATION FACILITY.
; CALL:
; ENTER MACRO IPCRID USING PGM-ID, ERROR-CODE.
; PGM-ID CONTAINS THE IDENTIFIER BY WHICH THIS PROGRAM IS TO BE KNOWN
; RETURN:
; ERROR-CODE CONTAINS AN INDICATION OF SUCCESS OR FAILURE OF THE ROUTINE
; DESTROYS: T1,T2,T3.
;
ENTR (CRID,2,2) ;DEFINE THE ENTRY POINT
; MAY ONLY HAVE ONE ID AT ANY TIME - CHECK IT OUT
SKIPN MYPID(I) ;ALREADY HAVE A PROGRAM IDENTIFIER ?
JRST CRID1 ;NO. OK TO CREATE ONE
TXZN F,F$MPNV ;YES. IS IT VALID ?
JRST USER24 ;YES. ONLY ONE PID AT A TIME
MOVE T2,MYPID(I) ;NO. GET THE INVALID PID
SETZM MYPID(I) ;WE NO LONGER HAVE A PID
MOVEI T1,.MUDES ;DESTROY THE PID
CALL DOMTL1 ;MAKE ONE ATTEMPT AT IT
; VALIDITY CHECK THE MESSAGE ARGUMENT
CRID1: MOVE T1,(L) ;GET PGM-ID ARGUMENT LIST ENTRY
CALL CKDSP ;IF RETURNS, IT IS LEGAL DISPLAY ITEM
MOVE P1,(L) ;GET PGM-ID ARGUMENT LIST ENTRY
CALL INFCPY ;SETUP THE <SYSTEM>INFO MESSAGE DATA
MOVEM T1,P1 ;SAVE THE MESSAGE DATA LENGTH
; CREATE A PID AND CHECK ITS QUOTAS
MOVEI T1,.MUCRE ;FUNCTION IS CREATE A PROCESS ID (PID)
MOVX T2,IP%NOA+.FHSLF ;PID IS FOR THIS PROCESS ONLY
CALL DOMTL1 ;CREATE THE PID
MOVE T2,MTLBLK+2(I) ;GET THE CREATED PID
MOVEM T2,MYPID(I) ;IT IS OUR PID
TXO F,F$MPNV ;BUT IS NOT COMPLETELY VALID YET
MOVEI T1,.MUFSQ ;DETERMINE SEND AND RECEIVE QUOTAS
CALL DOMTL1 ;PERFORM THE FUNCTION
HRRZ T1,MTLBLK+2(I) ;ISOLATE THE QUOTAS
JUMPE T1,INER20 ;WARN USER IF THEY ARE ZERO
; TELL <SYSTEM>INFO OUR NAME AND PID
MOVE T1,P1 ;GET LENGTH OF INFO MESSAGE (WORDS)
MOVEI P2,.IPCII ;FUNCTION IS ASSOCIATE NAME AND PID
CALL INFSND ;SEND OUT THE REQUEST
CALL INFWTR ;WAIT FOR <SYSTEM>INFO REPLY
TXZ F,F$MPNV ;PID IS VALID NOW
JRST XIT ;SUCCESS, RETURN TO CALLER
SUBTTL IPDLID - DELETE AN IDENTIFIER FOR THIS PROGRAM
;
; IPDLID - DELETE AN IDENTIFIER FOR THIS PROGRAM
; THE PURPOSE OF THIS ROUTINE IS TO DELETE AN IDENTIFICATION
; BY WHICH THIS PROGRAM IS KNOWN TO THE INTERPROGRAM COMMUNICATION
; FACILITY. REMOVING AN IDENTIFICATION FOR THIS PROGRAM IMPLIES THAT OTHER
; PROGRAMS WHICH MAY HAVE BEEN COMMUNICATING WITH THIS PROGRAM USING THAT
; IDENTIFIER, WILL NO LONGER BE ABLE TO DO SO.
; CALL:
; ENTER MACRO IPDLID USING PGM-ID, ERROR-CODE.
; PGM-ID CONTAINS THE IDENTIFIER BY WHICH THIS PROGRAM IS KNOWN
; RETURN:
; ERROR-CODE CONTAINS AN INDICATION OF SUCCESS OR FAILURE OF THE ROUTINE
; DESTROYS: T1.
;
ENTR (DLID,2,2) ;DEFINE THE ENTRY POINT
SKIPE MYPID(I) ;A PROGRAM IDENTIFIER ASSIGNED FOR ME
TXNE F,F$MPNV ; AND IT IS VALID ?
JRST USER23 ;NO. CAN'T DELETE IT-USER ERROR
; FIND THE PID ASSOCIATED WITH THE NAME SPECIFIED
MOVE P1,(L) ;GET PGM-ID ARGUMENT LIST ENTRY
MOVEI P2,.IPCIW ;FUNCTION IS FIND PID FOR PGM-ID
CALL CMINFO ;ASK <SYSTEM>INFO TO DO IT FOR US
MOVE P1,.IPCI1(R) ;GET PID VALUE FOR THAT ID
; IF THAT PID DOES NOT BELONG TO ME, IT IS AN ERROR
CAME P1,MYPID(I) ;TRYING TO REMOVE MY ID ?
JRST USER17 ;NO. ERROR. MUST BE SOMEONE ELSE'S ID
; PID BELONGS TO ME. TELL THE SYSTEM TO FORGET ABOUT IT
MOVEI T1,.MUDES ;THE FUNCTION IS DESTROY A PID
MOVE T2,MYPID(I) ;MY PID IS THE ONE TO DESTROY
CALL DOMTL1 ;ASK MONITOR TO DELETE IT. MONITOR
; INFORMS <SYSTEM>INFO THAT THE PID
; IS NO LONGER VALID.
SETZM MYPID(I) ;WE NO LONGER HAVE A PROGRAM IDENTIFIER
JRST XIT ;SUCCESS, RETURN TO CALLER
SUBTTL IPCRDX - CREATE AN INDEX FOR ANOTHER PROGRAM
;
; IPCRDX - CREATE AN INDEX FOR ANOTHER PROGRAM
; THE PURPOSE OF THIS ROUTINE IS TO ASSOCIATE AN INDEX WITH THE PROGRAM
; IDENTIFIER OF ANOTHER PROGRAM IN THE INTERPROGRAM COMMUNICATION SYSTEM.
; THE INDEX IS USED BY THIS PROGRAM AS A PARAMETER TO THE REMAINDER OF
; THE INTERPROGRAM COMMUNICATION ROUTINES TO UNIQUELY REFER TO THAT PROGRAM.
; CALL:
; ENTER MACRO IPCRDX USING PGM-ID, PGM-INDEX, ERROR-CODE.
; PGM-ID CONTAINS THE IDENTIFIER BY WHICH ANOTHER PROGRAM IS KNOWN
; RETURN:
; ERROR-CODE CONTAINS AN INDICATION OF SUCCESS OR FAILURE OF THE ROUTINE.
; PGM-INDEX; IF THE ROUTINE WAS SUCCESSFUL, CONTAINS THE INDEX ASSOCIATED
; WITH THE PGM-ID.
; DESTROYS: T1.
;
ENTR (CRDX,3,3) ;DEFINE THE ENTRY POINT
CALL IDXFAV ;ANY MORE INDEXES AVAILABLE ?
JUMPE T1,USER6 ;NO. TELL USER CAN'T CREATE INDEX
SKIPE MYPID(I) ;A PROGRAM IDENTIFIER ASSIGNED FOR ME
TXNE F,F$MPNV ; AND IT IS VALID ?
JRST USER23 ;NO. CAN'T COMMUNICATE WITH <SYSTEM>INFO
MOVE P1,(L) ;YES. GET PGM-ID ARGUMENT LIST ENTRY
MOVEI P2,.IPCIW ;FUNCTION IS FIND PID FOR PGM-ID
CALL CMINFO ;ASK <SYSTEM>INFO TO DO IT FOR US
MOVE T1,.IPCI1(R) ;GET PID WHICH <SYSTEM>INFO ASSIGNED
CALL IDXFDX ;INDEX ALREADY ASSIGNED FOR THIS PID ?
JUMPN T1,CRDX1 ;YES. RETURN THAT VALUE
MOVE T1,.IPCI1(R) ;NO. GET ASSIGNED PID AGAIN
CALL IDXASN ;ASSIGN AN INDEX TO THAT PID
JUMPE T1,USER6 ;NO INDEX AVAILABLE. TELL USER
CRDX1: MOVEM T1,@1(L) ;RETURN INDEX VALUE TO COBOL
JRST XIT ;SUCCESS, RETURN TO CALLER
SUBTTL IPDLDX - DELETE AN INDEX FOR ANOTHER PROGRAM
;
; IPDLDX - DELETE AN INDEX FOR ANOTHER PROGRAM
; THE PURPOSE OF THIS ROUTINE IS TO BREAK THE ASSOCIATION BETWEEN AN
; INDEX VALUE AND A PROGRAM IDENTIFIER SO THAT THE INDEX VALUE MAY BE
; ASSIGNED TO ANOTHER PROGRAM IDENTIFIER. IT IS NOT NECESSARY TO RELEASE
; ALL INDEXES AT THE TERMINATION OF A PROGRAM.
; CALL:
; ENTER MACRO IPDLDX USING PGM-INDEX, ERROR-CODE.
; PGM-INDEX CONTAINS THE INDEX VALUE WHICH IS TO BE FREED
; RETURN:
; ERROR-CODE CONTAINS AN INDICATION OF SUCCESS OR FAILURE OF THE ROUTINE.
; DESTROYS: T1.
;
ENTR (DLDX,2,2) ;DEFINE THE ENTRY POINT
MOVE T1,@(L) ;GET THE INDEX VALUE SPECIFIED
CAIL T1,IDXLOW ;INDEX OUT-OF-RANGE; TOO LOW
CAILE T1,IDXHGH ; OR TOO HIGH
JRST USER7 ;YES. RETURN ERROR CODE TO USER
CALL IDXFRE ;BREAK THE INDEX-PID ASSOCIATION
JRST XIT ;SUCCESS, RETURN TO CALLER
SUBTTL IPSEND - SEND INFORMATION TO ANOTHER PROGRAM
;
; IPSEND - SEND INFORMATION TO ANOTHER PROGRAM
; THE PURPOSE OF THIS ROUTINE IS TO SEND INFORMATION TO ANOTHER PROGRAM
; WHOSE IDENTITY IS KNOWN TO THIS PROGRAM.
; CALL:
; ENTER MACRO IPSEND USING MESSAGE, PGM-INDEX, ERROR-CODE.
; MESSAGE CONTAINS THE INFORMATION WHICH IS TO BE SENT.
; PGM-INDEX CONTAINS THE INDEX OF THE PROGRAM WHICH IS TO RECEIVE THE
; INFORMATION.
; RETURN:
; ERROR-CODE CONTAINS AN INDICATION OF SUCCESS OR FAILURE OF THE ROUTINE.
; DESTROYS: T1,T2,T3,T4.
;
ENTR (SEND,3,3) ;DEFINE THE ENTRY POINT
SKIPE MYPID(I) ;A PROGRAM IDENTIFIER ASSIGNED FOR ME
TXNE F,F$MPNV ; AND IT IS VALID ?
JRST USER23 ;NO. CAN'T SEND A MESSAGE-USER ERROR
; CHECK SPECIFIED INDEX AND MESSAGE PARAMETERS FOR VALIDITY
MOVE T1,@1(L) ;GET SPECIFIED PROGRAM INDEX
CAIL T1,IDXLOW ;IS IT WITHIN THE VALID RANGE ?
CAILE T1,IDXHGH ; ...
JRST USER7 ;NO. RETURN ERROR TO USER
CALL IDXFPD ;YES. HAS IT BEEN ASSIGNED A PID ?
JUMPE T1,USER7 ;NO. RETURN ERROR TO USER
PUSH P,T1 ;SAVE RECEIVER'S PID IN SAFE PLACE
MOVE T1,(L) ;GET MESSAGE ARGUMENT LIST ENTRY
CALL CKDSP ;RETURN USER ERROR IF NOT DISPLAY-6 OR -7
JUMPLE T1,XIT ;SUCCESS RETURN IF MSG LENGTH < OR = 0
; DETERMINE BYTE LENGTH AND SIZE OF DATA TO BE SENT
MOVE P1,T1 ;PUT LENGTH IN BYTES IN SAFE PLACE
MOVE P2,T2 ;PUT BYTE SIZE IN SAFE PLACE ALSO
MOVEI T1,ISMGMX ;DETERMINE MAXIMUM MESSAGE LENGTH
CAIE T2,D6BYSZ ; IN BYTES FROM THE
MOVEI T1,IAMGMX ; BYTE SIZE
CAMLE P1,T1 ;SPECIFIED LENGTH WITHIN THE LIMIT ?
MOVE P1,T1 ;NO. TRUNCATE TO MAXIMUM ALLOWED
; MOVE USER'S DATA INTO THE IPCF DATA PACKET AND ADD INTERNAL INFORMATION
MOVE T2,P2 ;BUILD ILDB BYTE PTR TO DESTINATION BY
LSH T2,^D35-^D11 ; POSITIONING BYTE SIZE
TLO T2,440000 ; SETTING POSITION OF FIRST BYTE
HRR T2,S ; AND INCLUDING DATA PACKET ADDRESS
MOVE T1,@(L) ;GET ILDB BYTE PTR TO SOURCE
CALL DTACPY ;COPY USER DATA INTO SEND DATA PAGE
HRL P1,P2 ;SETUP DATA DESCRIPTOR (BYTE SIZE,,BYTE LENGTH)
MOVEM P1,IPLTHO(S) ;AND PUT IT AT END OF DATA PAGE
; SEND THE INFORMATION
MOVEI T1,PGLGTH ;ONE PAGE OF DATA TO BE SENT
POP P,T2 ;PLACE RECEIVER'S PID FOR SEND ROUTINE
CALL SENDIT ;SEND THE DATA
JRST XIT ;SUCCESS, RETURN TO CALLER
SUBTTL IPRECV - RECEIVE INFORMATION FROM ANOTHER PROGRAM
;
; IPRECV - RECEIVE INFORMATION FROM ANOTHER PROGRAM
; THE PURPOSE OF THIS ROUTINE IS TO ALLOW A PROGRAM TO RECEIVE
; INFORMATION WHICH HAS BEEN SENT TO IT BY ANOTHER PROGRAM.
; CALL:
; ENTER MACRO IPRECV USING MESSAGE, PGM-INDEX, ERROR-CODE.
; RETURN:
; ERROR-CODE CONTAINS AN INDICATION OF SUCCESS OR FAILURE OF THE ROUTINE.
; IF THE ERROR-CODE INDICATES SUCCESS:
; MESSAGE CONTAINS THE INFORMATION WHICH WAS SENT.
; PGM-INDEX CONTAINS THE INDEX OF THE PROGRAM WHICH SENT THE INFORMATION.
; DESTROYS: T1,T2,T3,T4.
;
ENTR (RECV,3,3) ;DEFINE THE ENTRY POINT
SKIPE MYPID(I) ;A PROGRAM IDENTIFIER ASSIGNED FOR ME
TXNE F,F$MPNV ; AND IT IS VALID ?
JRST USER23 ;NO. CAN'T RECEIVE A MESSAGE-USER ERROR
; CHECK VALIDITY OF AND GET CHARACTERISTICS OF THE MESSAGE PARAMETER
MOVE T1,(L) ;GET MESSAGE ARGUMENT LIST ENTRY
CALL CKDSP ;RETURN USER ERROR IF NOT DISPLAY-6 OR -7
JUMPLE T1,XIT ;SUCCESS RETURN IF MSG LENGTH < OR = 0
MOVE P1,T1 ;SAVE BYTE LENGTH OF MESSAGE ITEM
MOVE P2,T2 ;SAVE BYTE SIZE OF MESSAGE ITEM
; CHECK INTERNAL AND MONITOR RECEIVE QUEUES TO FIND A MESSAGE
JRST .+3 ;ENTER AT CORRECT POINT FROM ABOVE
RECV1: AOS ERIMSG(I) ;COUNT ERRONEOUS IPCF MESSAGES
CALL IMMRVR ;REMOVE RECEIVE DATA PAGE FROM ADDRESS SPACE
CALL IRQRMV ;ENTRY IN INTERNAL RECEIVE QUEUE ?
JUMPN T1,RECV2 ;YES. GO PROCESS IT
CALL MRQRMV ;NO. ENTRY IN MONITOR RECEIVE QUEUE ?
JUMPE T1,USER8 ;NO. TELL USER NOTHING THERE
; PERFORM A VALIDITY CHECK ON THE RECEIVED IPCF MESSAGE
; THIS SECTION MUST BE ENTERED WITH THE FOLLOWING SETUP:
; T3 - CONTAINS THE RIGHT HALF OF THE IPCF PACKET HEADER FLAG WORD
; IN ITS RIGHT HALF
; T4 - CONTAINS THE SENDER'S PID
; R - CONTAINS THE ADDRESS OF THE IPCF DATA PACKET
RECV2: LDB T1,[POINT 3,T3,32] ;GET SYSTEM AND SENDER'S CODE
JUMPN T1,RECV1 ;IF CAME FROM <SYSTEM>, IGNORE IT
TXNN T3,IP%CFV ;IS DATA A LONG PACKET ?
JRST RECV1 ;NO. IGNORE IT
LDB T1,[POINT 6,T3,29] ;ERROR SPECIFIED IN FLAG WORD
JUMPG T1,INFERR ;YES. GO PROCESS IT
HLRZ T1,IPLTHO(R) ;GET BYTE SIZE FROM RECEIVED DATA
CAIE T1,D6BYSZ ;IS IT THE BYTE SIZE OF A DISPLAY-6
CAIN T1,D7BYSZ ; OR DISPLAY-7 DATA ITEM ?
SKIPA ;YES. OK TO USE IT
JRST USER10 ;NO. DATA CAME FROM INCOMPATIBLE SENDER
MOVEI T2,ISMGMX ;FIND MAXIMUM MESSAGE LENGTH
CAIE T1,D6BYSZ ; IN BYTES FROM BYTE SIZE
MOVEI T2,IAMGMX ; ...
HRRZ T1,IPLTHO(R) ;GET BYTE LENGTH FROM RECEIVED DATA
CAILE T1,0 ;IF BYTE LENGTH IS OUT-OF-RANGE; TOO LOW
CAMLE T1,T2 ; OR TOO HIGH
JRST USER10 ;DATA CAME FROM INCOMPATIBLE SENDER
LDB T1,[POINT 3,T3,35] ;GET RETURNED TO SENDER FLAG
CAIE T1,.IPCFN ;THIS DATA PACKET BEEN RETURNED TO US ?
JRST RECV3 ;NO. CONTINUE NORMAL PROCESSING
TXO F,F$RTS ;YES. REMEMBER THAT FOR LATER
JRST RECV5 ;PROCESS AS NORMAL MSG WITHOUT ASSIGNING INDEX
; CONVERT THE SENDER'S PID INTO AN INDEX
RECV3: MOVEM T4,P3 ;SAVE SENDER'S PID ACROSS CALL
MOVE T1,T4 ;GET THE SENDER'S PID
CALL IDXFDX ;HAVE WE ASSIGNED AN INDEX FOR IT ?
JUMPN T1,RECV4 ;YES. RETURN INDEX TO USER
MOVE T1,P3 ;NO. GET SENDER'S PID AGAIN
CALL IDXASN ;ASSIGN AN INDEX FOR IT
JUMPE T1,USER6 ;NO MORE INDEXES. RETURN ERROR TO USER
RECV4: MOVEM T1,@1(L) ;RETURN INDEX VALUE TO COBOL
; DETERMINE LENGTH OF DATA TO BE COPIED TO USER'S AREA
RECV5: HRRZ T3,IPLTHO(R) ;GET RECEIVED DATA LENGTH BYTES
HLRZ T2,IPLTHO(R) ;GET RECEIVED BYTE SIZE
CAMN T2,P2 ;ASKED FOR & RECEIVED BYTE SIZE EQUAL ?
JRST RECV6 ;YES. GET SHORTER LENGTH AND PROCEED
IMULI T3,(T2) ;CALCULATE LENGTH OF RECEIVED DATA IN BITS
MOVE T2,P1 ;CALCULATE LENGTH OF ASKED FOR DATA
IMULI T2,(P2) ; IN BITS
MOVE T1,T2 ;DETERMINE SHORTER OF THE ASKED FOR
CAMLE T2,T3 ; AND RECEIVED BIT LENGTHS
MOVE T1,T3 ; ...
IDIV T3,P2 ;CALC RECV BYTE LTH IN TERMS OF ASKED FOR
; BYTE SIZE FOR ERROR CODE DETERMINATION
IDIV T1,P2 ;CONVERT SHORTER (TO BE COPIED) BIT LENGTH TO
MOVE T4,T1 ; ASKED FOR (DESTINATION) BYTE LENGTH
JRST RECV7 ;PROCEED TO CHECK LENGTHS AND COPY DATA
RECV6: MOVE T4,T3 ;SET TO BE COPIED BYTE LENGTH (T4)
CAMLE T3,P1 ; TO THE SHORTER OF THE ASKED FOR AND
MOVE T4,P1 ; RECEIVED AREAS
; SET ERROR CODE IF ANY UNUSUAL CONDITIONS EXIST
RECV7: MOVEI P2,XIT ;SET ERROR CODE INDICATOR TO NO ERROR
CAMGE T4,P1 ;IS MOVED DATA SHORTER THAN MESSAGE AREA ?
MOVEI P2,USER1 ;YES. SET ERROR CODE TO RETURN THAT
CAMLE T3,P1 ;IS RECEIVED DATA LONGER THAN MESSAGE AREA ?
MOVEI P2,USER2 ;YES. SET ERROR CODE TO RETURN THAT
TXZE F,F$RTS ;MESSAGE GET RETURNED TO SENDER ?
MOVEI P2,USER9 ;YES. THIS ERROR MORE IMPORTANT THAN OTHER TWO
; COPY DATA TO USER'S AREA
MOVE T2,@(L) ;GET ILDB POINTER TO DESTINATION (USER AREA)
MOVE T1,T2 ;BUILD ILDB BYTE POINTER TO SOURCE BY
TLZ T1,770077 ; USING DESTINATION BYTE SIZE
TLO T1,440000 ; SETTING POSITION OF FIRST BYTE
HRR T1,R ; AND INCLUDING DATA PACKET ADDRESS
MOVE P1,T4 ;SETUP LENGTH TO BE COPIED
CALL DTACPY ;COPY RECEIVED DATA TO USER'S AREA
; TAKE SUCCESS OR ERROR EXIT AS APPROPRIATE
JRST (P2) ;EXIT SOMEHOW
SUBTTL IPWAIT - WAIT FOR AN EVENT TO OCCUR
;
; IPWAIT - SUSPEND PROGRAM EXECUTION UNTIL THE FIRST ONE OF THE
; SPECIFIED EVENTS OCCURS.
; THE EVENTS WHICH MAY CAUSE THE PROGRAM TO BE RESUMED ARE:
; 1. THERE IS AN IPCF MESSAGE AVAILABLE.
; 2. THERE IS AT LEAST ONE CHARACTER AVAILABLE FROM THE
; CONTROLLING TERMINAL.
; 3. THE SPECIFIED WAIT TIME HAS EXPIRED.
; ANY ONE OR A COMBINATION OF THESE EVENTS MAY BE SPECIFIED AS
; RESUMPTION CONDITIONS. THE FIRST ONE OF THE SPECIFIED EVENTS WHICH
; OCCURS CAUSES THIS ROUTINE TO RETURN CONTROL TO THE CALLER.
; CALL:
; ENTER MACRO IPWAIT USING FUNCTION-CODE, RESUMPTION-CONDITIONS,
; ERROR-CODE.
; FUNCTION-CODE - CONTAINS THE MAXIMUM WAIT INTERVAL OR ZERO
; INDICATING NO WAIT INTERVAL
; RESUMPTION-CONDITIONS - CONTAINS AN INDICATION OF WHICH EVENT(S)
; ARE TO BE WAITED FOR.
; RETURN:
; FUNCTION-CODE - SPECIFIES THE EVENT WHICH CAUSED RESUMPTION OF
; EXECUTION.
; ERROR-CODE - CONTAINS AN INDICATION OF SUCCESS OR
; FAILURE OF THE ROUTINE
; DESTROYS: T1,T2.
;
IFE FTWT10,<;CODE TO CONFORM TO DECSYSTEM-20 SPECIFICATION
ENTR (WAIT,3,3) ;DEFINE THE ENTRY POINT
MOVE P1,@1(L) ;GET USER SPECIFIED WAKEUP CONDITIONS
>;END OF CONDITIONAL FOR DECSYSTEM-20 SPECIFICATION
IFN FTWT10,<;CODE TO CONFORM TO DECSYSTEM-10 SPECIFICATION
ENTR (WAIT,2,2) ;DEFINE THE ENTRY POINT
MOVEI P1,WTITTY+WTIIPC ;ALWAYS WAIT FOR EITHER EVENT
>;END OF CONDITIONAL FOR DECSYSTEM-10 SPECIFICATION
MOVE T1,@(L) ;GET SPECIFIED SUSPENSION INTERVAL
CALL MWAIT ;WAIT FOR AN EVENT TO OCCUR
JRST USER22 ;PASS ALONG ILLEGAL PARAMETERS ERROR TO USER
MOVEM T1,@(L) ;RETURN EVENT CODE TO CALLER
JRST XIT ;RETURN TO CALLER
SUBTTL IPRUNI - TRANSFER CONTROL TO AN INFERIOR PROGRAM
;
; IPRUNI - TRANSFER CONTROL TO AN INFERIOR PROGRAM
; THE PURPOSE OF THIS ROUTINE IS TO ALLOW THE CURRENT PROGRAM
; TO BEGIN THE EXECUTION OF ANOTHER PROGRAM IN AN INFERIOR
; PROCESS, AND SUSPEND ITS OWN EXECUTION UNTIL THE OTHER PROGRAM
; HAS TERMINATED.
; CALL:
; ENTER MACRO IPRUNI USING PROGRAM-NAME, ERROR-CODE.
; PROGRAM-NAME - CONTAINS THE FILE SPECIFICATION OF
; THE PROGRAM WHICH IS TO BE RUN.
; RETURN:
; ERROR-CODE - CONTAINS AN INDICATION OF SUCCESS OR FAILURE
; OF THE ROUTINE.
; DESTROYS: T1,T2,T3,T4.
;
;SPECIAL DEFINITION TO AVOID CONFLICT WITH DBMS
;
OPDEF GETIT [104000,,200] ;DONNOT USE 'GET'.
ENTR (RUNI,2,2) ;DEFINE THE ENTRY POINT
MOVE T1,(L) ;GET FILE SPEC ARGUMENT LIST ENTRY
CALL CKDSP ;IF RETURNS, IT IS LEGAL DISPLAY ITEM
JUMPLE T1,USER5 ;USER ERROR IF LENGTH < OR = ZERO
CAILE T1,FSMXBY ;FILE SPEC LONGER THAN ALLOWED ?
MOVEI T1,FSMXBY ;YES. TRUNCATE TO MAX LENGTH
MOVE P1,(L) ;GET FILE SPEC ARGUMENT LIST ENTRY
MOVEI T3,FSBUF(I) ;PLACE TO BUILD ASCIZ FILE SPEC
CALL CPY2AZ ;MAKE FILE SPEC INTO ASCIZ STRING
SKIPE RNIPRH(I) ;INFERIOR PROCESS FROM PREVIOUS CALL ?
CALL RNIKPR ;YES. DESTROY IT
SKIPE RNIJFN(I) ;JFN STILL ASSIGNED FROM PREVIOUS CALL ?
CALL RNIRJF ;YES. RELEASE IT
MOVEI T1,GTJFNB ;ADDRESS OF ARGUMENT BLOCK
HRROI T2,FSBUF(I) ;POINTER TO FILE SPEC STRING
GTJFN ;ASK MONITOR TO ASSIGN A JFN
CALL JSYSER ;PROCESS ALL ERROR RETURNS
HRRZM T1,RNIJFN(I) ;SAVE THE ASSIGNED JFN
TXO T1,<CR%CAP> ;[3]PASS ON THE CAPABILITIES
CFORK ;CREATE INFERIOR WITH ITS OWN ADDRESS SPACE
CALL JSYSER ;PROCESS ALL ERRORS
HRRZM T1,RNIPRH(I) ;SAVE INFERIORS PROCESS HANDLE
MOVS T1,T1 ;SETUP PROCESS HANDLE AND JFN TO MAP
HRR T1,RNIJFN(I) ; THE PROGRAM INTO THE INFERIOR PROCESS
GETIT ; DO IT
ERCAL JSYSER ;PROCESS ALL ERRORS
MOVE T1,RNIPRH(I) ;START THE PROGRAM IN THE INFERIOR
SETZM T2 ; PROCESS AT ITS PRIMARY START
SFRKV ; ADDRESS
ERCAL JSYSER ;PROCESS ALL ERRORS
WFORK ;WAIT FOR THIS INFERIOR TO TERMINATE
ERCAL JSYSER ;PROCESS ALL ERRORS
CALL RNIKPR ;DESTROY THE INFERIOR PROCESS
JRST XIT ;ALL FINISHED. RETURN TO CALLER
; ROUTINE TO RELEASE THE JFN ASSIGNED TO FILE CONTAINING PROGRAM TO BE RUN
RNIRJF: MOVE T1,RNIJFN(I) ;GET THE JFN
SETZM RNIJFN(I) ;JFN NO LONGER VALID
RLJFN ;RELEASE IT
CALL JSYSER ;PROCESS ALL ERRORS
RET ;ALL FINISHED. RETURN TO CALLER
; ROUTINE TO KILL THE INFERIOR PROCESS IN WHICH THE PROGRAM WAS RUN.
; WISH THERE WAS ANOTHER WAY WITH LESS OVERHEAD TO RESET A PROCESS,
; BUT SINCE THERE ISN'T -- DO IT !!
RNIKPR: MOVE T1,RNIPRH(I) ;GET THE PROCESS HANDLE
SETZM RNIPRH(I) ;PROCESS HANDLE NO LONGER VALID
SETZM RNIJFN(I) ;NEITHER IS JFN ASSOCIATED WITH IT
KFORK ;DESTROY THE PROCESS
ERCAL JSYSER ;PROCESS ALL ERRORS
RET ;ALL FINISHED. RETURN TO CALLER
SUBTTL MWAIT - WAIT FOR ONE OF MULTIPLE EVENTS
;
; MWAIT - WAIT FOR ONE OF MULTIPLE EVENTS
; THIS ROUTINE CHECKS FOR THE OCCURENCE OF THREE EVENTS: AN IPCF
; MESSAGE IN THIS PROCESS'S RECEIVE QUEUE, SOME INPUT IS AVAILABLE
; FROM THE CONTROLLING TERMINAL, AND THE SPECIFIED WAIT TIME HAS EXPIRED.
; ANY ONE OR A COMBINATION OF THESE EVENTS MAY BE SPECIFIED AS
; RESUMPTION CONDITIONS. IF ANY ONE OF THE SPECIFIED EVENTS HAS
; ALREADY OCCURRED WHEN THE ROUTINE IS CALLED, AN IMMEDIATE RETURN IS
; TAKEN. OTHERWISE, THE ROUTINE RETURNS WHEN THE FIRST ONE OF THE
; SPECIFIED EVENTS OCCURS. IF MORE THAN ONE OF THE SPECIFIED EVENTS
; HAS OCCURED, THE EVENT WHICH IS CHECKED FOR FIRST WILL BE THE EVENT
; WHICH WILL BE CONSIDERED TO HAVE COMPLETED THE ROUTINE.
; THE EVENTS ARE CHECKED FOR IN THE ORDER SPECIFIED BY THE ENTRIES IN
; THE TABLE WTPRTB. REFER TO THE WTCHK ROUTINE FOR MORE INFORMATION ON
; CONTROLLING THE ORDER OF CHECKING FOR EVENTS.
; CALL:
; CALL MWAIT
; T1 - CONTAINS THE MAXIMUM TIME TO WAIT IN MILLISECONDS. IF THIS
; VALUE IS ZERO, THIS ROUTINE WILL WAIT INDEFINITELY FOR ONE
; OF THE OTHER TWO CONDITIONS.
; P1 - FLAGS WHICH INDICATE WHICH IF ANY OF THE OTHER TWO CONDITIONS
; TO WAIT FOR:
; WTITTY - (=1) WAIT FOR AT LEAST ONE CHARACTER OF TERMINAL INPUT
; WTIIPC - (=2) WAIT FOR IPCF RECEIVE PACKET
; WTITTY+WTIIPC - (=3) WAIT FOR THE FIRST OCCURRENCE OF
; EITHER EVENT.
; RETURN:
; +1 - ERROR. INVALID PARAMETERS OR COMBINATION OF PARAMETERS.
; DOES NOT RETURN ON OTHER FATAL ERRORS.
; +2 - THE ROUTINE WAS COMPLETED SUCCESSFULLY.
; T1 - CONTAINS AN INDICATION OF WHICH EVENT CAUSED THE WAIT TO
; BE SATISFIED
; WTOTTY - (=1) SOME TERMINAL INPUT IS AVAILABLE
; WTOIPC - (=2) AN IPCF MESSAGE IS AVAILABLE
; WTOTIM - (=3) SPECIFIED TIME INTERVAL HAS EXPIRED
; DESTROYS: T1,T2.
;
MWAIT: JUMPL T1,RETURN ;NEGATIVE WAIT TIME IS ILLEGAL
SKIPN T1 ;ERROR IF SUSPENSION INTERVAL IS ZERO AND
JUMPE P1,RETURN ; THE RESUMPTION CONDITIONS ARE ZERO.
MOVE T2,MYPID(I) ;GET MY CURRENT PROCESS ID
TXNE P1,WTIIPC ;ERROR IF IPCF IS RESUMPTION CONDITION AND
JUMPE T2,RETURN ; WE DON'T HAVE A PROCESS ID
MOVEM T1,P2 ;SAVE THE WAIT INTERVAL
TXZ F,F$WTTY+F$WIPC+F$WTIM ;NO EVENTS DETECTED IN WAIT LOOP
SETZM WTINT(I) ;DON'T WANT TO CHECK FOR TIMEOUT NOW
CALL WTCHK ;HAVE ANY EVENTS ALREADY HAPPENED ?
JUMPN T1,SKPRET ;YES. RETURN THE EVENT CODE
MOVEM P2,WTINT(I) ;SETUP WAIT INTERVAL IN CORRECT PLACE
CALL WTLOOP ;WAIT FOR AN EVENT TO OCCUR
CALL WTCHK ;CHECK EVENTS IN PRIORITY ORDER
JUMPN T1,SKPRET ;RETURN APPROPRIATE EVENT CODE
JRST INER17 ;FATAL ERROR IF NO EVENT FOUND
;
; WTLOOP - WAITS FOR THE FIRST ONE OF THE SPECIFIED EVENTS TO OCCUR
; CALL:
; CALL WTLOOP
; WTINT(I) - CONTAINS THE WAIT INTERVAL IN MILLISECONDS
; P1 - CONTAINS THE OTHER RESUMPTION CONDITION FLAGS
; RETURN:
; +1 - ALWAYS
; F - CONTAINS ONE OF THE EVENT DETECTED IN WAIT LOOP FLAGS (F$WTTY,
; F$WIPC, OR F$WTIM) INDICATING WHICH EVENT CAUSED THE ROUTINE
; TO EXIT.
; DESTROYS: T1,T2.
;
WTLOOP:
CALL WTLPI ;INITIALIZE THE WAIT LOOP
WTLOP1:
MOVE T1,[377777777777] ;START WITH ALMOST INFINITE WAIT TIME
SKIPN WTINT(I) ;A WAIT INTERVAL BEEN SPECIFIED ?
JRST WTLOP2 ;NO. CHECK TERMINAL CONDITION
TIME ;YES. GET CURRENT UPTIME
SUB T1,WTENDT(I) ;CALCULATE NEGATIVE OF MAX TIME TO WAIT
JUMPGE T1,[TXO F,F$WTIM ;TIME INTERVAL HAS BEEN EXCEEDED
JRST WTLOPX] ;COMPLETE THE WAIT LOOP
MOVM T1,T1 ;GET POSITIVE MAX TIME TO WAIT
WTLOP2:
TXNE F,F$WTTY ;ANY TTY INPUT AVAILABLE ?
JRST WTLOPX ;YES. COMPLETE THE WAIT LOOP
WTLOP3:
TXNE F,F$WIPC ;IPCF PACKET RECEIVED ?
JRST WTLOPX ;YES. COMPLETE THE WAIT LOOP
SETOM WTSIFL(I) ;NO. SET FLAG THAT WE ARE WAITING
DISMS ;WAIT FOR APPROPRIATE TIME INTERVAL
JFCL ;SO CONTINUE PC IS DIFFERENT THAN WAITING PC
WTLOPC: SETZM WTSIFL(I) ;CLEAR WE ARE WAITING FOR INTERRUPT FLAG
JRST WTLOP1 ;CHECK FOR WHY WE WOKEUP
; EVENT WE WERE WAITING FOR HAS OCCURRED, EXIT FROM THE WAIT LOOP
WTLOPX: CALL WTLPT ;TERMINATE WAIT LOOP GRACEFULLY
RET ;RETURN TO CALLER WITH EVENT FLAG IN F
;
; WTLPI - ROUTINE TO INITIALIZE THE WAIT LOOP
;
WTLPI: SKIPN WTINT(I) ;FINITE TIME INTERVAL SPECIFIED ?
JRST WTLPI1 ;NO.
TIME ;YES. GET CURRENT TIME
ADD T1,WTINT(I) ;CALCULATE END OF TIME INTERVAL
MOVEM T1,WTENDT(I) ;SAVE END TIME FOR WAIT LOOP
WTLPI1: TXNN P1,WTIIPC+WTITTY ;IPCF OR TERMINAL A RESUMPTION CONDITION ?
JRST WTLPI4 ;NO.
SKIPE WTSITA(I) ;YES. DONE ONCE-ONLY INITIALIZATION ALREADY ?
JRST WTLPI2 ;YES. DON'T DO IT AGAIN
MOVEI T1,.FHSLF ;+NO. GET ADDRESS OF PA1050 SI TABLES
RIR ;+ FOR THIS PROCESS
ERCAL JSYSER ;+PROCESS ERROR RETURNS
JUMPE T2,INER18 ;+ERROR IF SI TABLES NOT SETUP
MOVEM T2,WTSITA(I) ;+SAVE ADDRESS OF SI TABLES
SKIPE SIIPCC(T2) ;+IPCF CHANNEL ALREADY BEING USED ?
JRST INER18 ;+YES. FATAL ERROR
SKIPE SITTYC(T2) ;+TERMINAL CHANNEL ALREADY BEING USED ?
JRST INER18 ;+YES. FATAL ERROR
MOVE T1,[SILVL,,SIIPC] ;GET IPCF LEVEL AND ROUTINE ADDRESS
MOVEM T1,SIIPCC(T2) ;SETUP THE CHANNEL TABLE ENTRY
MOVE T1,[SILVL,,SITTY] ;GET TERMINAL LEVEL AND ROUTINE ADDRESS
MOVEM T1,SITTYC(T2) ;SETUP THE CHANNEL TABLE ENTRY
HLRZ T2,T2 ;GET ADDRESS OF SI LEVEL TABLE
MOVE T1,SILVL-1(T2) ;GET ADDRESS OF SI PC LOCATION
MOVEM T1,WTSIPC(I) ;SAVE IT FOR INTERRUPT ROUTINE
WTLPI2: TXNN P1,WTIIPC ;IPCF PACKET A RESUMPTION CONDITION ?
JRST WTLPI3 ;NO.
CALL SIAIPC ;YES. ASSIGN MY PID TO SI CHANNEL
MOVEI T1,.FHSLF ;ENABLE THE IPCF SOFTWARE INTERRUPT
MOVX T2,1B<SIIPCC> ; CHANNEL FOR THIS PROCESS
AIC ; DO IT
ERCAL JSYSER ;PROCESS ALL ERROR RETURNS
CALL IPQRY ;A PACKET ARRIVED SINCE WE CHECKED LAST ?
SKIPE T1 ;NO. JUST KEEP TRUCKIN
TXO F,F$WIPC ;YES. MAKE WAIT LOOP COMPLETE IMMEDIATELY
WTLPI3: TXNN P1,WTITTY ;TERMINAL INPUT A RESUMPTION CONDITION ?
JRST WTLPI4 ;NO.
MOVE T1,[.TICTI,,SITTYC] ;YES. ASSIGN TYPE-IN TO INTERRUPT
ATI ; CHANNEL TO GET NOTIFIED OF FIRST CHAR.
ERCAL JSYSER ;PROCESS ALL MONITOR CALL ERRORS
MOVEI T1,.FHSLF ;ACTIVATE THE TERMINAL TYPE-IN
MOVX T2,1B<SITTYC> ; SOFTWARE INTERRUPT CHANNEL FOR
AIC ; THIS PROCESS
ERCAL JSYSER ;PROCESS ALL ERROR RETURNS
MOVEI T1,.PRIIN ;IF ANY CHARS IN TERMINAL BUFFER NOW,
SIBE ; INTERRUPT WILL NEVER HAPPEN.
TXO F,F$WTTY ;ONE THERE-MAKE WAIT LOOP COMPLETE NOW
WTLPI4:
RET ;WAIT LOOP INITIALIZATION COMPLETE
;
; WTLPT - ROUTINE TO CLOSE THE WAIT LOOP PROCESSING
;
WTLPT: TXNN P1,WTIIPC ;IPCF PACKET A RESUMPTION CONDITION ?
JRST WTLPT1 ;NO.
MOVEI T1,.FHSLF ;YES. DISABLE THE IPCF SOFTWARE INTERRUPT
MOVX T2,1B<SIIPCC> ; CHANNEL FOR THIS PROCESS
DIC ; DO IT
ERCAL JSYSER ;PROCESS ALL JSYS ERRORS
CALL SIRIPC ;REMOVE MY PID FROM SI CHANNEL
WTLPT1: TXNN P1,WTITTY ;TERMINAL INPUT A RESUMPTION CONDITION ?
JRST WTLPT2 ;NO.
MOVEI T1,.FHSLF ;YES. DEACTIVATE THE TERMINAL TYPE-IN
MOVX T2,1B<SITTYC> ; SOFTWARE INTERRUPT CHANNEL FOR
DIC ; THIS PROCESS
ERCAL JSYSER ;PROCESS ALL ERROR RETURNS
MOVEI T1,.TICTI ;DEASSIGN TERMINAL CODE FROM THE
DTI ; SOFTWARE INTERRUPT CHANNEL
ERCAL JSYSER ;PROCESS ALL ERROR RETURNS
WTLPT2:
RET ;ALL FINISHED. RETURN TO CALLER
;
; SIAIPC - ASSIGN THIS PROCESS'S PID TO A SOFTWARE INTERRUPT CHANNEL
; SIRIPC - REMOVE THIS PROCESS'S PID FROM THE SOFTWARE INTERRUPT CHANNEL
; CALL:
; CALL SIAIPC OR
; CALL SIRIPC
; RETURN:
; +1 ALWAYS
; DOES NOT RETURN ON FATAL ERRORS
; DESTROYS: T1,T2.
;
SIAIPC: SKIPA T1,[EXP SIIPCC] ;GET THE CHANNEL NUMBER TO BE ASSIGNED
SIRIPC: SETOM T1 ;INDICATE REMOVING PID FROM SI CHANNEL
MOVEM T1,MTLBLK+2(I) ;SETUP ASSIGN OR REMOVE
MOVE T1,MYPID(I) ;GET MY PID
MOVEM T1,MTLBLK+1(I) ;IT IS THE ONE TO BE CHANGED
MOVEI T1,.MUPIC ;JSYS FUNCTION IS ASSIGN/DEASSIGN PID
MOVEM T1,MTLBLK(I) ;PUT FUNCTION CODE IN JSYS ARGUMENT BLOCK
MOVEI T1,3 ;LENGTH OF ARGUMENT BLOCK
MOVEI T2,MTLBLK(I) ;ADDRESS OF ARGUMENT BLOCK
MUTIL ;PERFORM THE ASSIGN/DEASSIGN FUNCTION
CALL JSYSER ;PROCESS ALL ERRORS
RET ;FUNCTION PERFORMED SUCCESSFULLY. RETURN
;
; SITTY - INTERRUPT LEVEL ROUTINE WHICH SIGNALS THAT TERMINAL INPUT
; IS AVAILABLE.
; SIIPC - INTERRUPT LEVEL ROUTINE WHICH SIGNALS THAT AN IPCF PACKET
; HAS BEEN RECEIVED.
;
SITTY: TXOA F,F$WTTY ;INDICATE TERMINAL INPUT IS AVAILABLE
SIIPC: TXO F,F$WIPC ;INDICATE THAT IPCF PACKET IS HERE
SKIPN WTSIFL(I) ;PROCESS WAITING FOR SOMETHING TO HAPPEN ?
JRST SIIPC1 ;NO. JUST EXIT
MOVEI I1,WTLOPC ;YES. GET ADDRESS TO CONTINUE PROCESS
MOVEM I1,@WTSIPC(I) ;CONTINUE PROCESS IMMEDIATELY
SIIPC1: DEBRK ;DISMISS THIS INTERRUPT
ERCAL JSYSER ;ONLY GET ERRORS IF NOT AT INTERRUPT LEVEL
;
; WTCHK - CHECK ALL EVENTS WHICH MAY HAVE CAUSED THE PROGRAM TO WAKE UP.
; THE EVENTS ARE CHECKED FOR IN THE ORDER OF THE ENTRIES IN THE TABLE
; WTPRTB. THIS ROUTINE RETURNS THE CODE OF THE FIRST EVENT WHICH IT
; FINDS HAS OCCURED.
; NOTE THAT THE CODE CORRESPONDING TO AN EVENT WILL ALWAYS BE THE SAME.
; IT IS COMPLETELY INDEPENDENT OF THE ORDER IN WHICH THE EVENTS ARE
; CHECKED FOR.
; ALL ROUTINES WHICH THIS ROUTINE CALLS ARE CALLED WITH CALL ----.
; THEY SHOULD RETURN IN THE FOLLOWING MANNER:
; +1 IF THE CONDITION DID NOT OCCUR
; +2 IF THE CONDITION DID OCCUR WITH CONDITION CODE IN REGISTER T1
; CALL:
; CALL WTCHK
; WTINT(I) - CONTAINS THE WAIT INTERVAL
; P1 - CONTAINS THE OTHER RESUMPTION CONDITION FLAGS
; F - CONTAINS THE EVENT DETECTED IN WAIT LOOP FLAGS
; RETURN:
; +1 - ALWAYS
; T1 CONTAINS THE CODE OF THE EVENT WHICH HAS OCCURED.
; IF NO EVENT OCCURED, T1 IS RETURNED WITH A ZERO VALUE.
; DESTROYS: T1,T2.
;
WTCHK: PUSH P,P2 ;MAKE PERMANENT REGISTER AVAILABLE TO US
HRLZI P2,-WTPRLH ;SETUP TABLE POINTER & LOOP COUNTER
WTCHK1: XCT WTPRTB(P2) ;CHECK ONE EVENT
SKIPA ;IT DID NOT OCCUR. CONTINUE
JRST WTCHK2 ;IT DID OCCUR, EXIT WITH CORRECT CODE
AOBJN P2,WTCHK1 ;CHECK ALL EVENTS
SETZM T1 ;NO EVENTS OCCURED, INDICATE THIS
WTCHK2: POP P,P2 ;RESTORE PERMANENT REGISTER
RET ;RETURN TO CALLER
;
; THIS TABLE DETERMINES THE ORDER IN WHICH THE POSSIBLE EVENTS ARE
; CHECKED FOR. IT IS SCANNED FROM TOP TO BOTTOM.
;
WTPRTB: CALL WTTERM ;CONTROLLING TERMINAL INPUT READY
CALL WTIPCF ;IPCF MESSAGE AVAILABLE
CALL WTTIME ;TIME LIMIT EXPIRED
WTPRLH==.-WTPRTB ;CALCULATE THE LENGTH OF THE TABLE
;
; THE EVENT CHECKING ROUTINES
;
;
; WTTERM - CHECK IF CONTROLLING TERMINAL INPUT AVAILABLE
;
WTTERM: TXNN P1,WTITTY ;TTY INPUT A RESUMPTION CONDITION?
RET ;NO. CONDITION DID NOT OCCUR
TXNE F,F$WTTY ;TTY INPUT DETECTED IN WAIT LOOP ?
JRST WTTRM1 ;YES. RETURN APPROPRIATE CODE
MOVEI T1,.PRIIN ;CHECK PRIMARY INPUT BUFFER
SIBE ;IS IT EMPTY ?
JRST WTTRM1 ;NO. CONDITION DID OCCUR
RET ;YES. CONDITION DID NOT OCCUR
WTTRM1: MOVEI T1,WTOTTY ;YES. SETUP THE RETURN CODE
JRST SKPRET ;TAKE THE SKIP RETURN
;
; WTIPCF - CHECK IF IPCF MESSAGE AVAILABLE
;
WTIPCF: TXNN P1,WTIIPC ;IPCF PACKET A RESUMPTION CONDITION ?
RET ;NO. CONDITION DID NOT OCCUR
TXNE F,F$WIPC ;IPCF PACKET DETECTED IN WAIT LOOP ?
JRST WTIPC1 ;YES. RETURN APPROPRIATE CODE
CALL IRQQRY ;EXAMINE INTERNAL RECEIVE QUEUE
JUMPN T1,WTIPC1 ;AN ENTRY THERE. CONDITION DID OCCUR
CALL IPQRY ;EXAMINE IPCF MONITOR RECEIVE QUEUE
JUMPE T1,RETURN ;NO ENTRY. CONDITION DID NOT OCCUR
WTIPC1: MOVEI T1,WTOIPC ;ENTRY, SETUP RETURN CODE
JRST SKPRET ;TAKE THE SKIP RETURN
;
; WTTIME - CHECK IF TIME INTERVAL HAS EXPIRED
;
WTTIME: SKIPN WTINT(I) ;TIME EXPIRED A RESUMPTION CONDITION ?
RET ;NO. RETURN CONDITION DID NOT OCCUR
TXNE F,F$WTIM ;TIME EXPIRED DETECTED BY WAIT LOOP ?
JRST WTTIM1 ;YES. RETURN APPROPRIATE CODE
TIME ;NO. GET CURRENT UPTIME VALUE
CAMGE T1,WTENDT(I) ;PASSED END OF WAIT INTERVAL ?
RET ;NO. RETURN CONDITION DID NOT OCCUR
WTTIM1: MOVEI T1,WTOTIM ;YES. RETURN CODE TIME LIMIT EXCEEDED
SKPRET: AOS (P) ;SETUP SKIP RETURN
RETURN: RET ;RETURN CONDITION OCCURED
SUBTTL COMMUNICATE WITH <SYSTEM>INFO
;
; CMINFO - COMMUNICATE WITH <SYSTEM>INFO
; THIS ROUTINE PERFORMS ONE COMMUNICATION SEQUENCE WITH THE CENTRAL
; INTERPROGRAM COMMUNICATION FACILITY CONTROLLER <SYSTEM>INFO. THE
; COMMUNICTION SEQUENCE CONSISTS OF SENDING A MESSAGE TO <SYSTEM>INFO,
; AND WAITING FOR, AND RECEIVING A REPLY. THIS ROUTINE IS USED BY
; IPDLID, AND IPCRDX.
; THE FUNCTIONS PERFORMED ARE:
; 1. CHECK THE MESSAGE ITEM FOR LEGALITY (IT MUST BE DISPLAY).
; 2. COPY THE MESSAGE ITEM INTO THE <SYSTEM>INFO MESSAGE, CONVERTING ITS
; DATA TYPE IF NECESSARY.
; 3. SETUP AND SEND THE MESSAGE TO <SYSTEM>INFO.
; 4. WAIT FOR A REPLY. IF ANY DATA MESSAGES ARE RECEIVED FROM OTHER SOURCES
; WHILE WAITING FOR THE <SYSTEM>INFO REPLY, THEY ARE ENTERED INTO THE
; INTERNAL RECEIVE QUEUE FOR LATER PROCESSING. IF ANY <SYSTEM>
; INFO ERRORS ARE DETECTED, THE APPROPRIATE ERROR RETURN IS
; TAKEN.
; CALL:
; CALL CMINFO
; P1 - CONTAINS THE COBOL ARGUMENT LIST ENTRY OF THE MESSAGE ITEM
; P2 - CONTAINS THE <SYSTEM>INFO FUNCTION CODE
; RETURN:
; +1 - ALWAYS
; R - CONTAINS THE ADDRESS OF THE DATA PACKET RETURNED BY
; <SYSTEM>INFO.
; DOES NOT RETURN IF ERRORS ARE DETECTED.
; DESTROYS: T1,T2,T3.
;
CMINFO:
MOVE T1,P1 ;SETUP TO CHECK LEGALITY OF MESSAGE
CALL CKDSP ;IF RETURNS, MESSAGE IS LEGAL TYPE
CALL INFCPY ;SETUP MESSAGE ITEM AS INFO FUNCTION ARGUMENT
CALL INFSND ;COMPLETE & SEND <SYSTEM>INFO MESSAGE
CALL INFWTR ;WAIT FOR <SYSTEM>INFO REPLY
RET ;GOT IT. RETURN TO CALLER
SUBTTL INTERNAL RECEIVE QUEUE MANIPULATION
;
; THE INTERNAL RECEIVE QUEUE (IRQ) IS NECESSARY TO ALLOW THESE ROUTINES
; TO COMMUNICATE WITH <SYSTEM>INFO WITHOUT LOSING ANY NORMAL PACKETS OF
; DATA. THE ONLY CONDITION IN WHICH AN ENTRY IS MADE IN THE INTERNAL
; RECEIVE QUEUE IS THAT THESE ROUTINES ARE WAITING FOR AN IPCF MESSAGE
; FROM <SYSTEM>INFO AND ANOTHER NORMAL PACKET OF DATA ARRIVES FIRST. SINCE
; THE MONITOR IPCF RECEIVE QUEUE IS FIRST-IN FIRST-OUT (FIFO), THAT NORMAL
; DATA PACKET MUST BE RECEIVED FROM THE MONITOR BEFORE THE REPLY FROM
; <SYSTEM>INFO CAN BE RECEIVED.
; ONCE WE HAVE RECEIVED THE DATA PACKET, WE HAVE TWO CHOICES: THROW IT AWAY,
; OR SAVE IT SOMEWHERE. SINCE THE FIRST CHOICE IS NOT AN ELEGANT WAY TO
; HANDLE THE SITUATION, THE INTERNAL RECEIVE QUEUE WAS INVENTED TO ALLOW THE
; SECOND APPROACH TO THE SOLUTION.
; THE INTERNAL RECEIVE QUEUE IS ALSO FIFO. ENTRIES IN THE INTERNAL RECEIVE
; QUEUE WILL BE PROCESSED BEFORE ENTRIES FROM THE MONITOR RECEIVE QUEUE.
; THEREFORE, FROM THE USER'S (I.E. IPRECV) POINT OF VIEW, ALL DATA MESSAGES
; ARE RECEIVED FIFO.
;
; THE ROUTINES NECESSARY TO MANIPULATE THE INTERNAL RECEIVE QUEUE ARE:
; 1. IRQENT - ENTER A PACKET IN THE QUEUE
; 2. IRQRMV - REMOVE AN ENTRY FROM THE QUEUE
; 3. IRQQRY - DETERMINE IF THERE IS AN ENTRY IN THE QUEUE
;
; THE INTERNAL RECEIVE QUEUE (IRQQUE OF LENGTH IRQLTH) IS A SEQUENTIAL LIST
; OF ENTRIES. EACH ENTRY IS ONE WORD LONG. THERE ARE TWO POINTERS TO THE
; INTERNAL RECEIVE QUEUE: THE NEXT ENTRY AVAILABLE FOR STORAGE (IRQPUT),
; AND THE NEXT ENTRY AVAILABLE TO BE REMOVED (IRQGET). THE NEXT ENTRY
; AVAILABLE FOR STORAGE ALWAYS POINTS TO THE NEXT FREE ENTRY AND IS
; UPDATED AFTER AN ENTRY IS PLACED IN THE QUEUE. THE NEXT ENTRY TO BE
; REMOVED POINTS TO THE NEXT ENTRY WHICH WILL BE REMOVED FROM THE QUEUE AND
; IS UPDATED AFTER AN ENTRY IS REMOVED FROM THE QUEUE. THEREFORE, THE
; QUEUE IS EMPTY IF THE NEXT ENTRY TO BE REMOVED IS ALSO THE NEXT ENTRY
; AVAILABLE (I.E. IT IS NOT IN USE). BOTH OF THESE POINTERS ARE INCREMENTED
; MODULO THE LENGTH OF THE TABLE.
;
; THE FOLLOWING IS A DESCRIPTION OF THE INFORMATION WHICH IS PROCESSED BY
; THESE ROUTINES AND THE DETAILS OF WHERE IT IS STORED:
; IRQ ENTRY:
; BITS 0-17: RIGHT HALF OF THE IPCF PACKET HEADER FLAG WORD
; BITS 18-35: ADDRESS OF THE IPCF DATA PACKET
; DATA PACKET:
; WORD IPSPDO CONTAINS THE SENDER'S PROCESS IDENTIFIER (PID)
;
;
; IRQENT - ENTER A DATA PACKET IN THE INTERNAL RECEIVE QUEUE
;
; THIS ROUTINE SHOULD NEVER FAIL BECAUSE OF A LACK OF SPACE IN THE QUEUE.
; THE LENGTH OF THE QUEUE AND THE PAGE TABLE MAINTAINED BY THE MEMORY
; MANAGEMENT ROUTINES ARE THE SAME. IF AN ENTRY IS AVAILABLE IN THE
; PAGE TABLE, ONE SHOULD ALSO BE AVAILABLE IN THE QUEUE. THE PAGE
; IS ALWAYS REQUESTED FROM THE MEMORY MANAGEMENT ROUTINES FIRST,
; THEREFORE THOSE ROUTINES WILL SUPPLY THE SPACE EXHAUSTED ERROR CONDITION.
; CALL:
; CALL IRQENT
; R - CONTAINS THE ADDRESS OF THE IPCF DATA PAGE TO BE ENTERED IN THE Q.
; THE CORRESPONDING IPCF PACKET HEADER MUST BE AT IPKHDR(I).
; RETURN:
; +1 - ALWAYS
; R - PRESERVED
; IPCF PACKET HEADER - PRESERVED
; DESTROYS: T1,T2.
;
IRQENT: MOVE T2,R ;BUILD QUEUE ENTRY FROM DATA PACKET
HRL T2,IPKHDR+.IPCFL(I) ; ADDRESS AND PACKET FLAGS
MOVE T1,IRQPUT(I) ;GET LOCATION TO PUT ENTRY IN QUEUE
MOVEM T2,(T1) ;PLACE THE ENTRY IN THE QUEUE
CALL IRQIPT ;INCREMENT QUEUE POINTER TO NEXT ENTRY
MOVEM T1,IRQPUT(I) ;AND SAVE IT FOR NEXT TIME
MOVE T1,R ;GET IPCF DATA PACKET ADDRESS AS A
LSH T1,ADR2PG ; PAGE NUMBER
CALL IMMUSE ;MARK THAT PAGE AS IN USE
MOVE T1,IPKHDR+.IPCFS(I) ;GET SENDER'S PID
MOVEM T1,IPSPDO(R) ;PLACE IT IN THE DATA PACKET
TXZ F,F$RMVR ;DON'T REMOVE PAGE IN R FROM ADDRESS SPACE
RET ;ALL FINISHED. RETURN TO CALLER
;
; IRQRMV - REMOVE AN ENTRY FROM THE INTERNAL RECEIVE QUEUE
; THIS ROUTINE AND MRQRMV MUST PROVIDE AN IDENTICAL INTERFACE TO THE
; OUTSIDE WORLD.
; CALL:
; CALL IRQRMV
; RETURN:
; +1 - ALWAYS
; T1 - CONTAINS ZERO IF THERE IS NO ENTRY IN THE INTERNAL QUEUE OR
; CONTAINS NONZERO IF AN ENTRY WAS FOUND
; IF AN ENTRY WAS FOUND:
; T3 - CONTAINS THE RIGHT HALF OF THE IPCF PACKET HEADER FLAG WORD
; IN ITS RIGHT HALF
; T4 - CONTAINS THE SENDER'S PID
; R - CONTAINS THE ADDRESS OF THE IPCF DATA PACKET
; DESTROYS: T1,T3,T4,R.
;
IRQRMV: CALL IRQQRY ;ARE THERE ANY ENTRIES IN THE QUEUE ?
JUMPE T1,RETURN ;NO. PASS ON STATUS TO CALLER
MOVE T1,IRQGET(I) ;GET LOCATION OF ENTRY TO BE REMOVED
MOVE R,T1 ;SAVE IT FOR OUR USE
CALL IRQIPT ;INCREMENT QUEUE POINTER TO NEXT ENTRY
MOVEM T1,IRQGET(I) ;SAVE IT FOR THE NEXT CALLER
HRRZ T1,(R) ;GET ADDRESS OF PACKET DATA
LSH T1,ADR2PG ;GET CORRESPONDING PAGE NUMBER
CALL IMMFRE ;FREE THAT PAGE FOR REUSE
HLRZ T3,(R) ;GET PACKET HEADER FLAGS
HRRZ R,(R) ;GET ADDRESS OF PACKET DATA
MOVE T4,IPSPDO(R) ;GET SENDER'S PID
SETOM T1 ;SET ENTRY WAS FOUND RETURN CODE
TXO F,F$RMVR ;PAGE IN R TO BE REMOVED FROM ADDRESS SPACE
RET ;RETURN TO CALLER
;
; IRQQRY - DETERMINE IF THERE IS AN ENTRY IN THE INTERNAL RECEIVE QUEUE
; CALL:
; CALL IRQQRY
; RETURN:
; +1 - ALWAYS
; T1 - CONTAINS NONZERO IF THERE IS AT LEAST ONE ENTRY OR
; CONTAINS ZERO IF THERE ARE NO ENTRIES
; DESTROYS: T1.
;
IRQQRY: MOVE T1,IRQPUT(I) ;GET NEXT FREE ENTRY POINTER
CAMN T1,IRQGET(I) ;EQUAL TO NEXT ENTRY TO BE REMOVED ?
JRST RETT10 ;YES. NO ENTRIES IN THE QUEUE
RET ;NO. THERE MUST BE AN ENTRY THERE
;
; IRQIPT - INCREMENT AN INTERNAL RECEIVE QUEUE POINTER TO THE NEXT ENTRY
; CALL:
; CALL IRQIPT
; T1 - CONTAINS THE IRQ POINTER TO THE CURRENT ENTRY
; RETURN:
; +1 - ALWAYS
; T1 - CONTAINS THE IRQ POINTER TO THE NEXT SEQUENTIAL ENTRY
; DESTROYS: T1.
;
IRQIPT: AOS T1 ;POINT TO NEXT WORD IN ADDRESS SPACE
CAILE T1,IRQQUE+IRQLTH-1(I) ;PAST END OF IRQ ?
MOVEI T1,IRQQUE(I) ;YES. START AT BEGINNING AGAIN
RET ;EXIT WITH UPDATED POINTER
SUBTTL IPCF RECEIVE MEMORY MANAGEMENT ROUTINES
;
; THESE ROUTINES PERFORM THE MEMORY MANAGEMENT FUNCTIONS WHICH ARE NECESSARY
; FOR THE IPCF RECEIVE ROUTINES TO FUNCTION EFFICIENTLY AND CORRECTLY. EACH
; IPCF DATA PACKET WHICH IS RECEIVED (SHORT OR LONG) IS PLACED IN A PAGE OF
; VIRTUAL MEMORY. THE FUNCTIONS WHICH THESE ROUTINES PERFORM TO CONTROL THOSE
; PAGES ARE:
; 1. FIND THE FIRST AVAILABLE PAGE AND MAKE IT PART OF THE ADDRESS SPACE.
; THIS FUNCTION IS REQUIRED IN ORDER TO RECEIVE SHORT PACKETS.
; 2. FIND THE FIRST AVAILABLE PAGE AND DELETE IT FROM THE ADDRESS SPACE. THIS
; FUNCTION IS REQUIRED IN ORDER TO RECEIVE LONG PACKETS (PAGES).
; 3. CHANGE A PAGE'S STATUS FROM FREE TO IN USE.
; 4. CHANGE A PAGE'S STATUS FROM IN USE TO FREE.
; 5. MARK A PAGE AS BEING PART OF THE VIRTUAL ADDRESS SPACE.
; 6. REMOVE A PAGE FROM THE VIRTUAL ADDRESS SPACE AND INDICATE THAT STATUS
; IN THE PAGE TABLE. THIS FUNCTION IS PROVIDED SO THAT THE VIRTUAL
; ADDRESS SPACE MAY BE KEPT AS SMALL AS POSSIBLE. IT IS MEANT TO BE USED
; TO DELETE A RECEIVE DATA PAGE FROM THE ADDRESS SPACE AFTER THE DATA
; HAS BEEN REMOVED FROM IT.
;
; THE LIST OF AVAILABLE PAGES IS MAINTAINED IN A TABLE (IRQPTB OF LENGTH
; IRQLTH). EACH ENTRY IN THE TABLE IS ONE WORD LONG. THE WORD HAS THE
; FOLLOWING FORMAT:
; BIT 0: =0 IF THIS ENTRY IS FREE
; =1 IF THIS ENTRY IS IN USE
; BIT 1: =0 IF THE PAGE IS NOT IN THE ADDRESS SPACE
; =1 IF THE PAGE IS IN THE ADDRESS SPACE
; BITS 2-17: UNUSED; SHOULD ALWAYS BE ZERO
; BITS 18-35: THE PAGE NUMBER OF THE PAGE WHICH THIS ENTRY REPRESENTS.
; IF THE ENTRY (WORD) IS ALL ZERO, THEN NO PAGE NUMBER HAS BEEN ALLOCATED
; FOR THIS ENTRY. THE LIST OF AVAILABLE PAGES IS INITIALLY EMPTY (I.E. ALL
; ENTRIES ARE ZERO). ONCE A PAGE IS ASSIGNED TO A TABLE ENTRY, THAT PAGE
; NUMBER WILL ALWAYS OCCUPY THAT ENTRY.
;
; THE ALGORITHM WHICH IS USED TO CHOOSE A PAGE IS:
; 1. SEARCH THE TABLE SEQUENTIALLY FROM THE BEGINNING LOOKING FOR THE FIRST
; ENTRY WHICH IS NOT ZERO AND NOT IN USE.
; 2. IF SUCH AN ENTRY IS FOUND, RETURN ITS PAGE NUMBER.
; 3. IF NO ENTRY IS FOUND, BUT A ZERO ENTRY IS ENCOUNTERED, ALLOCATE A PAGE
; FOR THAT ENTRY, PUT ITS NUMBER IN THE ENTRY, AND RETURN THAT PAGE NUMBER.
; 4. IF THE END OF THE TABLE IS ENCOUNTERED, RETURN A FATAL ERROR TO THE USER.
;
; THIS ALGORITHM INSURES THAT THE SAME PAGES WILL BE USED IF AT ALL POSSIBLE,
; THUS KEEPING THE ADDRESS SPACE AS SMALL AS POSSIBLE, AND INCREASING LOCALITY
; AS MUCH AS POSSIBLE.
;
;
; IMMIN - FIND THE FIRST AVAILABLE PAGE AND MAKE IT PART OF THE ADDRESS SPACE
; IMMOUT - FIND THE FIRST AVAILABLE PAGE AND DELETE IT FROM THE ADDRESS SPACE
; CALL:
; CALL IMMIN OR
; CALL IMMOUT
; RETURN:
; +1 - ALWAYS
; T1 - CONTAINS THE PAGE NUMBER OR
; CONTAINS ZERO IF THE TABLE IS FULL
; DESTROYS: T2,T3.
;
IMMIN: TXOA F,F$PGIO ;PAGE MUST BE PART OF ADDRESS SPACE
IMMOUT: TXZ F,F$PGIO ;PAGE MUST NOT BE PART OF ADDRESS SPACE
CALL IMSFRE ;FIND THE FIRST ENTRY NOT IN USE
JUMPE T1,RETURN ;PASS ALONG TABLE FULL CONDITION
MOVEM T1,IMMLST(I) ;SAVE LAST ENTRY REFERENCED FOR FUTURE CALLS
SKIPE T1,(T1) ;PAGE BEEN ALLOCATED FOR THIS ENTRY ?
JRST IMMIN1 ;YES. PLACE IN OR OUT OF ADDRESS SPACE
CALL PGFND ;NO. FIND AND CREATE A PAGE FOR THIS ENTRY
JRST RETT10 ;CAN'T MAKE TABLE LONGER=>TABLE IS FULL
TXO T1,INSPFL ;REMEMBER THE PAGE IS IN ADDRESS SPACE
MOVEM T1,@IMMLST(I) ;PLACE PAGE NUMBER IN CORRECT TABLE ENTRY
IMMIN1: TXNN F,F$PGIO ;MUST PAGE BE PART OF ADDRESS SPACE ?
JRST IMMIN2 ;NO. CHECK THAT CONDITION FURTHER
TXON T1,INSPFL ;YES. IS PAGE IN ADDRESS SPACE ?
MOVEM T1,@IMMLST(I) ;NO. STORE UPDATED ENTRY - PAGE
; CREATED AUTOMATICALLY
JRST IMMIN3 ;YES. EVERYTHING IS AS IT SHOULD BE
IMMIN2: TXZN T1,INSPFL ;IS PAGE IN ADDRESS SPACE ?
JRST IMMIN3 ;NO. EVERYTHING IS AS IT SHOULD BE
MOVEM T1,@IMMLST(I) ;YES. SAVE UPDATED PAGE TABLE ENTRY
HRRZ T1,T1 ;ISOLATE PAGE NUMBER PART OF ENTRY
CALL PGDST ;DESTROY THE PAGE
IMMIN3: HRRZ T1,@IMMLST(I) ;GET PAGE NUMBER TO BE RETURNED TO USER
RET ;RETURN TO CALLER
;
; IMMUSE - CHANGE A PAGE'S STATUS FROM FREE TO IN USE
; CALL:
; CALL IMMUSE
; T1 - CONTAINS THE PAGE NUMBER WHOSE STATUS IS TO BE CHANGED
; RETURN:
; +1 - ALWAYS
; T1 - PRESERVED
; DESTROYS: T2,T3.
;
IMMUSE: CALL IMFPG ;FIND THE PAGE NUMBER IN THE TABLE
MOVE T3,(T2) ;GET THE ENTIRE ENTRY
TXOE T3,INUSFL ;MARK IT AS IN USE
JRST INER11 ;IT WAS ALREADY IN USE. FATAL ERROR
MOVEM T3,(T2) ;UPDATE TABLE ENTRY
RET ;RETURN TO CALLER
;
; IMMFRE - CHANGE A PAGE'S STATUS FROM IN USE TO FREE
; CALL:
; CALL IMMFRE
; T1 - CONTAINS THE PAGE NUMBER WHOSE STATUS IS TO BE CHANGED
; RETURN:
; +1 - ALWAYS
; T1 - PRESERVED
; DESTROYS: T2,T3.
;
IMMFRE: CALL IMFPG ;FIND THE PAGE NUMBER IN THE TABLE
MOVE T3,(T2) ;GET THE ENTIRE ENTRY
TXZN T3,INUSFL ;MARK ENTRY AS FREE
JRST INER12 ;IT WAS ALREADY FREE. FATAL ERROR
MOVEM T3,(T2) ;UPDATE TABLE ENTRY
RET ;RETURN TO CALLER
;
; IMMINR - MARK A PAGE AS BEING IN THE ADDRESS SPACE
; CALL:
; CALL IMMINR
; R - CONTAINS THE PAGE NUMBER WHICH IS NOW IN THE ADDRESS SPACE
; RETURN:
; +1 - ALWAYS
; R - PRESERVED
; DESTROYS: T1,T2,T3.
;
IMMINR: MOVE T1,R ;GET THE PAGE NUMBER TO BE CHANGED
CALL IMFPG ;FIND THAT ENTRY IN THE PAGE TABLE
MOVX T3,INSPFL ;GET LOCATION OF ADDRESS SPACE FLAG
IORM T3,(T2) ;MARK ENTRY AS PART OF ADDRESS SPACE
TXO F,F$RMVR ;REMEMBER THAT THIS PAGE MUST BE REMOVED
RET ;RETURN TO CALLER
;
; IMMRVR - REMOVE A PAGE FROM THE VIRTUAL ADDRESS SPACE
; CALL:
; CALL IMMRVR
; R - CONTAINS THE ADDRESS OF THE PAGE WHICH IS TO BE REMOVED
; RETURN:
; +1 - ALWAYS
; R - PRESERVED
; DESTROYS: T1,T2,T3.
;
IMMRVR: MOVE T1,R ;GET THE PAGE NUMBER OF THE PAGE
LSH T1,ADR2PG ; TO BE REMOVED
CALL PGDST ;REMOVE THAT PAGE OF OUR ADDRESS SPACE
TXZ F,F$RMVR ;PAGE NUMBER CONTAINED IN R HAS BEEN REMOVED
MOVE T1,R ;GET THE PAGE NUMBER OF THE PAGE
LSH T1,ADR2PG ; TO BE REMOVED
CALL IMFPG ;FIND THAT PAGE ENTRY IN PAGE TABLE
MOVX T3,INSPFL ;GET POSITION OF ADDRESS SPACE FLAG IN ENTRY
ANDCAM T3,(T2) ;MARK ENTRY AS NOT IN ADDRESS SPACE
RET ;RETURN TO CALLER
;
; IMFPG - FIND THE ENTRY IN THE RECEIVE MEMORY MANAGEMENT PAGE TABLE WHICH
; CORRESPONDS TO A PARTICULAR PAGE NUMBER.
; CALL:
; CALL IMFPG
; T1 - CONTAINS THE PAGE NUMBER WHICH IS TO BE FOUND
; RETURN:
; +1 - ALWAYS
; T1 - PRESERVED
; T2 - CONTAINS THE ADDRESS OF THE ENTRY IN THE PAGE TABLE
; ERROR - DOES NOT RETURN
; DESTROYS: T2,T3.
;
IMFPG: MOVE T2,IMMLST(I) ;GET ADDRESS OF LAST ENTRY REFERENCED
HRRZ T3,(T2) ;GET PAGE NUMBER OF LAST ENTRY REFERENCED
CAIN T1,(T3) ;IS THAT PAGE WE ARE LOOKING FOR ?
RET ;YES. GOT ALL THE INFO WE NEED
CALL IMSPG ;NO. SCAN THE TABLE FOR THE PAGE NUMBER
JUMPE T2,INER13 ;COULDN'T FIND IT. FATAL ERROR
MOVEM T2,IMMLST(I) ;UPDATE LAST ENTRY REFERENCED
RET ;RETURN APPROPRIATE INFORMATION
;
; IMSPG - SCAN THE RECEIVE MEMORY MANAGEMENT PAGE TABLE FOR THE ENTRY WHICH
; CONTAINS A PARTICULAR PAGE NUMBER. THE SCAN IS TERMINATED IF A ZERO
; ENTRY IS FOUND IN THE TABLE.
; CALL:
; CALL IMSPG
; T1 - CONTAINS THE PAGE NUMBER WHOSE ENTRY IS TO BE FOUND
; RETURN:
; +1 - ALWAYS
; T1 - PRESERVED
; T2 - CONTAINS THE ADDRESS OF THE ENTRY CORRESPONDING TO THE PAGE NUMBER
; OR CONTAINS ZERO IF THE PAGE NUMBER IS NOT IN THE TABLE
; DESTROYS: T2,T3.
;
IMSPG: MOVEI T2,IRQPTB(I) ;GET ADDRESS OF FIRST ENTRY
IMSPG1: HRRZ T3,(T2) ;GET ENTRY PAGE NUMBER
CAMN T1,T3 ;FOUND THE CORRECT ENTRY ?
RET ;YES. RETURN THE INFO
JUMPE T3,RETT20 ;EXIT IF REACHED END OF ALLOCATED ENTRIES
CAIGE T2,IRQPTB+IRQLTH-1(I) ;PAST END OF TABLE ?
AOJA T2,IMSPG1 ;NO. KEEP LOOKING
RETT20: SETZM T2 ;YES. INFORM USER COULD NOT FIND ENTRY
RET ; BY RETURNING T2 = 0.
;
; IMSFRE - SCAN THE RECEIVE MEMORY MANAGEMENT PAGE TABLE FOR THE FIRST ENTRY
; WHICH IS NOT IN USE.
; CALL:
; CALL IMSFRE
; RETURN:
; +1 - ALWAYS
; T1 - CONTAINS THE ADDRESS OF THE TABLE ENTRY OR
; CONTAINS ZERO IF THE TABLE IS FULL
; DESTROYS: T1.
;
IMSFRE: MOVEI T1,IRQPTB(I) ;GET ADDRESS OF THE FIRST ENTRY
IMSFR1: SKIPL (T1) ;IS ENTRY IN USE ?
RET ;NO. RETURN ENTRY ADDRESS TO USER
CAIGE T1,IRQPTB+IRQLTH-1(I) ;YES. PAST END OF THE TABLE ?
AOJA T1,IMSFR1 ;NO. CHECK NEXT ENTRY
RETT10: SETZM T1 ;YES. TELL THE CALLER BY RETURNING
RET ; T1 = 0.
SUBTTL PROGRAM INDEX MANIPULATION ROUTINES
;
; THE PROGRAM INDEX IS A VALUE BY WHICH A COBOL PROGRAM REFERS TO ANOTHER
; COBOL PROGRAM. THE PROGRAM INDEXES ARE ASSIGNED BY THESE ROUTINES AT
; THE REQUEST OF THE COBOL PROGRAM. EACH PROGRAM INDEX IS ASSOCIATED
; WITH A UNIQUE PROCESS ID (PID) IN THE IPCF SYSTEM. THE PROGRAM INDEX IS
; CONVERTED TO A PID BY THESE ROUTINES FOR THEIR COMMUNICATION FUNCTIONS.
;
; THE PROGRAM INDEX ROUTINES REQUIRED ARE:
; 1. IDXFAV - FIND THE FIRST AVAILABLE PROGRAM INDEX
; 2. IDXASN - ASSIGN A PROGRAM INDEX TO A PID
; 3. IDXFPD - FIND THE PID ASSOCIATED WITH A SPECIFIC PROGRAM INDEX
; 4. IDXFDX - FIND THE PROGRAM INDEX ASSOCIATED WITH A SPECIFIC PID
; 5. IDXFRE - BREAK THE ASSOCIATION BETWEEN A PROGRAM INDEX AND A PID
;
; THE FORMAT OF THE PROGRAM INDEX TABLE (IDXTBL OF LENGTH IDXLTH) IS A
; SEQUENTIAL GROUP OF WORDS. EACH TABLE ENTRY IS ONE WORD LONG. THE
; POSITION OF THAT ENTRY IN THE TABLE DEFINES THE INDEX VALUE WHICH
; CORRESPONDS TO IT. THE CONTENTS OF THE ENTRY ARE: ZERO IF THAT INDEX
; IS NOT ASSIGNED, OR THE PID VALUE WHICH CORRESPONDS TO THAT INDEX
; (POSITION) IN THE TABLE.
;
; NOTE THAT THIS METHOD OF MAINTAINING INDEX VALUES DEPENDS UPON THE
; FACT THAT A PROGRAM CAN NEVER BE ASSIGNED A PID OF ZERO (0). THAT PID
; VALUE IS NORMALLY RESERVED FOR <SYSTEM>INFO, SO NO PROBLEMS SHOULD ARISE.
;
; THE PROGRAM INDEX TABLE IS ALWAYS SCANNED FROM THE BEGINNING. THIS ACTION
; IMPLIES THAT THE PROGRAM INDEX WITH THE LOWEST VALUE WILL ALWAYS BE
; ASSIGNED FIRST.
;
;
; IDXFAV - FIND THE FIRST AVAILABLE PROGRAM INDEX
; CALL:
; CALL IDXFAV
; RETURN:
; +1 - ALWAYS
; T1 - CONTAINS THE VALUE OF THE LOWEST PROGRAM INDEX AVAILABLE OR
; CONTAINS ZERO IF THERE IS NO PROGRAM INDEX AVAILABLE
; DESTROYS: T1,T2.
;
IDXFAV: MOVEI T1,0 ;AN UNASSIGNED ENTRY HAS A ZERO VALUE
CALL IDXFND ;FIND FIRST ZERO ENTRY ADDRESS
JUMPE T1,RETURN ;NO INDEX AVAIL. PASS ON INDICATOR
SUBI T1,IDXTBL(I) ;CONVERT ADDRESS TO INDEX
RET ;RETURN IT TO CALLER
;
; IDXASN - ASSIGN A PROGRAM INDEX TO A PID
; CALL:
; CALL IDXASN
; T1 - CONTAINS THE PID WHICH IS TO BE ASSIGNED A PROGRAM INDEX
; RETURN:
; +1 - ALWAYS
; T1 - CONTAINS THE INDEX VALUE ASSIGNED OR
; CONTAINS ZERO IF THERE IS NO FREE INDEX TO BE ASSIGNED
; DESTROYS: T1,T2.
;
IDXASN: JUMPE T1,INER14 ;PID VALUE OF ZERO IS FATAL
PUSH P,T1 ;PUT PID VALUE IN SAFE PLACE
MOVEI T1,0 ;A ZERO VALUE IS UNASSIGNED
CALL IDXFND ;GO FIND FIRST ONE
JUMPE T1,RETJK1 ;NONE AVAILABLE. TELL CALLER
POP P,(T1) ;ASSIGN INDEX BY PUTTING PID IN ENTRY
SUBI T1,IDXTBL(I) ;CONVERT ADDRESS TO INDEX
RET ;RETURN IT TO CALLER
RETJK1: POP P,(P) ;JUNK ONE STACK ENTRY BEFORE RETURNING
RET ;RETURN TO CALLER
;
; IDXFPD - FIND THE PID ASSOCIATED WITH A SPECIFIC PROGRAM INDEX
; CALL:
; CALL IDXFPD
; T1 - CONTAINS THE INDEX VALUE WHICH IS TO BE CONVERTED INTO A PID
; RETURN:
; +1 - ALWAYS
; T1 - CONTAINS THE PID OR
; CONTAINS ZERO IF THERE IS NO PID FOR THAT INDEX
; DESTROYS: T1.
;
IDXFPD: CAIL T1,IDXLOW ;IS SPECIFIED INDEX VALUE WITHIN
CAILE T1,IDXHGH ; LEGAL RANGE ?
JRST INER15 ;NO. FATAL CROSS CHECK
ADDI T1,IDXTBL(I) ;YES. CONVERT INDEX TO ADDRESS
MOVE T1,(T1) ;TABLE ENTRY VALUE IS THE RETURN CODE
RET ;RETURN IT TO CALLER
;
; IDXFDX - FIND THE PROGRAM INDEX ASSOCIATED WITH A SPECIFIC PID
; CALL:
; CALL IDXFDX
; T1 - CONTAINS THE PID VALUE FOR WHICH THE INDEX IS TO BE DETERMINED
; RETURN:
; +1 - ALWAYS
; T1 - CONTAINS THE INDEX VALUE OR
; CONTAINS ZERO IF THE PID IS NOT ASSIGNED AN INDEX
; DESTROYS: T1,T2.
;
IDXFDX: CALL IDXFND ;FIND THE TABLE ENTRY CONTAINING THE PID
SKIPE T1 ;ENTRY NOT THERE. PASS ON T1=0
SUBI T1,IDXTBL(I) ;CONVERT ADDRESS TO INDEX
RET ;RETURN VALUE TO CALLER
;
; IDXFRE - BREAK THE ASSOCIATION BETWEEN A PROGRAM INDEX AND A PID
; CALL:
; CALL IDXFRE
; T1 - CONTAINS THE INDEX VALUE
; RETURN:
; +1 - ALWAYS
; DESTROYS: T1.
;
IDXFRE: CAIL T1,IDXLOW ;IS SPECIFIED INDEX VALUE WITHIN
CAILE T1,IDXHGH ; LEGAL RANGE ?
JRST INER15 ;NO. FATAL CROSS CHECK
ADDI T1,IDXTBL(I) ;YES. CONVERT INDEX TO ADDRESS
SETZM (T1) ;ZERO VALUE MEANS ENTRY IS FREE
RET ;RETURN TO CALLER
;
; IDXFND - FIND THE PROGRAM INDEX TABLE ENTRY WHICH CONTAINS A SPECIFIC VALUE
; THE SCAN ALWAYS BEGINS AT THE BEGINNING (INDEX 1) OF THE TABLE.
; CALL:
; CALL IDXFND
; T1 - CONTAINS THE TABLE VALUE TO BE SCANNED FOR
; RETURN:
; +1 - ALWAYS
; T1 - CONTAINS THE ADDRESS OF FIRST TABLE ENTRY CONTAINING THE VALUE OR
; CONTAINS ZERO IF THE ENTRY COULD NOT BE FOUND
; DESTROYS: T1,T2.
;
IDXFND: MOVE T2,T1 ;SAVE VALUE TO BE LOCATED
MOVEI T1,IDXTBL+1(I) ;START AT BEG OF TABLE. INDEX 0 NOT USED
IDXFN1: CAMN T2,(T1) ;FOUND A MATCHING TABLE ENTRY ?
RET ;YES. RETURN ITS ADDRESS
CAIGE T1,IDXTBL+IDXLTH-1(I) ;NO. PAST END OF TABLE ?
AOJA T1,IDXFN1 ;NO. CHECK NEXT ENTRY
JRST RETT10 ;YES. RETURN T1=0 TO INDICATE THAT
SUBTTL DATA CHECKING AND MANIPULATION ROUTINES
;
; CKDSP - CHECK FOR A LEGAL COBOL DISPLAY PARAMETER
; THE COBOL PARAMETER IS LEGAL IF IT IS DISPLAY-6 OR DISPLAY-7.
; CALL:
; CALL CKDSP
; T1 - CONTAINS THE COBOL ARGUMENT LIST ENTRY
; RETURN:
; +1 - ALWAYS
; T1 - CONTAINS THE LENGTH OF THE ITEM IN BYTES
; T2 - CONTAINS THE BYTE SIZE
; DESTROYS: T1,T2,T3.
;
CKDSP: LDB T2,[POINT 4,T1,12] ;GET COBOL ARGUMENT LIST ENTRY TYPE
CAIE T2,TP$DSP ;IS IT DISPLAY ?
JRST USER3 ;NO. TELL THE CALLER ILLEGAL PARAMETER TYPE
MOVEI T1,@T1 ;GET 18-BIT COBOL PARAMETER BLOCK ADDRESS
REPEAT 0,<;;THESE BITS NOT SET FOR SUBSCRIPTED ITEMS (COBOL V10)
LDB T2,[POINT 4,1(T1),4] ;GET COBOL DISPLAY ARGUMENT TYPE
CAIE T2,TP$D6 ;ITEM DISPLAY-6 ?
CAIN T2,TP$D7 ;NO. THEN MUST BE DISPLAY-7
SKIPA ;YES. LEGAL SO FAR
JRST USER3 ;NO. TELL THE CALLER ILLEGAL PARAMETER TYPE
>;;END OF REPEAT 0 FOR SUBSCRIPTED ITEMS
LDB T2,[POINT 6,(T1),11] ;GET BYTE PTR BYTE SIZE FOR DOUBLE CHECK
CAIE T2,D6BYSZ ;ITEM DISPLAY-6 ?
CAIN T2,D7BYSZ ;NO. THEN MUST BE DISPLAY-7
SKIPA ;YES. ITEM IS REALLY DISPLAY-6 OR DISPLAY-7
JRST USER3 ;NO. TELL THE CALLER
MOVX T3,TP$DNM ;GET NUMERIC ITEM FLAG
TDNE T3,1(T1) ;IS DISPLAY ITEM NUMERIC ?
SKIPA T3,[POINT 5,1(T1),35] ;YES. LENGTH IS BITS 31-35
MOVE T3,[POINT 24,1(T1),35] ;NO. LENGTH IS BITS 12-35
LDB T1,T3 ;GET THE ITEM LENGTH IN BYTES
RET ;RETURN TO CALLER
;
; INFCPY - SETUP PROGRAM NAME TYPE MESSAGE FOR <SYSTEM>INFO
; THIS ROUTINE COPIES A USER PROGRAM IDENTIFIER PARAMETER INTO THE IPCF
; SEND DATA PAGE AS A FUNCTION ARGUMENT FOR A REQUEST TO <SYSTEM>INFO.
; CALL:
; CALL INFCPY
; P1 - CONTAINS THE COBOL ARGUMENT LIST ENTRY OF THE MESSAGE ITEM
; T1 - CONTAINS THE LENGTH (BYTES) OF THAT ITEM
; T2 - CONTAINS THE BYTE SIZE OF THE MESSAGE ITEM
; RETURN:
; +1 - ALWAYS
; T1 - CONTAINS THE LENGTH IN WORDS OF THE FUNCTION ARGUMENT
; DESTROYS: T1,T2,T3,T4.
;
INFCPY: JUMPLE T1,USER5 ;RETURN ERROR (5), IF LENGTH < OR = ZERO
CAILE T1,IFMGMX ;MESSAGE LONGER THAN ALLOWED ?
MOVEI T1,IFMGMX ;YES. USE FIRST PORTION ONLY
MOVEI T3,.IPCI2(S) ;PUT THE STRING IN THE DATA PACKET
CALL CPY2AZ ;COPY THE MESSAGE TO AN ASCIZ STRING
RET ;LENGTH OF STRING IN WORDS IS IN T1
;
; CPY2AZ - COPY A SIXBIT OR ASCII COBOL ITEM TO AN ASCIZ STRING
; CALL:
; CALL CPY2AZ
; P1 - CONTAINS THE COBOL ARGUMENT LIST ENTRY OF THE SOURCE ITEM
; T1 - CONTAINS THE LENGTH (BYTES) OF THAT ITEM
; T2 - CONTAINS THE BYTE SIZE OF THE SOURCE ITEM
; T3 - CONTAINS THE ADDRESS OF THE BEGINNING OF THE DESTINATION STRING
; RETURN:
; +1 - ALWAYS
; T1 - CONTAINS THE LENGTH IN WORDS OF THE ASCIZ STRING
; DESTROYS: T1,T2,T3,T4.
;
CPY2AZ: TXO F,F$SXBT ;ASSUME MESSAGE ITEM IS SIXBIT
CAIE T2,D6BYSZ ;IS IT ?
TXZ F,F$SXBT ;NO. THEN MUST BE ASCII
MOVEM T1,T4 ;SAVE BYTE LENGTH FOR MOVE
ADDI T1,ABYTWD ;CALCULATE LENGTH OF OUTPUT STRING
IDIVI T1,ABYTWD ; IN WORDS ACCOUNTING FOR LAST ZERO BYTE
PUSH P,T1 ;SAVE WORD LENGTH TO BE RETURNED
ADDI T1,-1(T3) ;CALCULATE LAST WORD OF STRING ADDRESS
HRLZI T2,(T3) ;CLEAR THE OUTPUT STRING AREA SO
HRRI T2,1(T3) ; THE RESULTING ASCII STRING WILL
SETZM (T3) ; BE IN ASCIZ FORMAT.
BLT T2,(T1) ; ...
HRLI T3,(POINT 7,0) ;BUILD DESTINATION BYTE POINTER
MOVE T2,@P1 ;GET SOURCE ITEM BYTE POINTER
CPY2A1: ILDB T1,T2 ;COPY SOURCE ITEM INTO DESTINATION
TXNE F,F$SXBT ; STRING CONVERTING FROM
ADDI T1,40 ; SIXBIT TO ASCII IF NECESSARY
IDPB T1,T3 ; ...
SOJG T4,CPY2A1 ; ...
POP P,T1 ;SETUP LENGTH IN WORDS FOR CALLER
RET ;ALL FINISHED. RETURN TO USER
;
; DTACPY - COPY BYTE DATA FROM ONE LOCATION TO ANOTHER
; THIS ROUTINE COPIES DATA WHICH IS DEFINED BY TWO BYTE POINTERS AND A
; LENGTH FROM ONE POSITION TO ANOTHER. THE NORMAL MODE OF COPYING IS TO
; GET A BYTE USING THE SOURCE BYTE POINTER AND PUT IT USING THE DESTINATION
; BYTE POINTER UNTIL THE COUNT EXPIRES.
; THIS ROUTINE MAKES AN ATTEMPT TO USE A MUCH FASTER MODE WHICH MOVES AS
; MANY FULL WORDS AS POSSIBLE WITH ONE INSTRUCTION (BLT). THIS FASTER MODE
; MAY BE USED IF; THE BYTE SIZE OF THE TWO POINTERS IS THE SAME, AND THE
; SOURCE AND DESTINATION BOTH BEGIN ON A WORD BOUNDARY. NOTE THAT FOR THE
; MAJORITY OF EXPECTED DATA, THESE CONDITIONS WILL BOTH BE TRUE.
; CALL:
; CALL DTACPY
; T1 - CONTAINS AN ILDB BYTE POINTER TO THE SOURCE
; T2 - CONTAINS AN ILDB BYTE POINTER TO THE DESTINATION
; P1 - CONTAINS THE BYTE COUNT
; RETURN:
; +1 - ALWAYS
; P1 - PRESERVED
; DESTROYS: T1,T2,T3,T4.
;
DTACPY: JUMPLE P1,RETURN ;ALL FINISHED IF LENGTH < OR = 0
LDB T3,[POINT 6,T1,11] ;GET SOURCE BYTE SIZE
LDB T4,[POINT 6,T2,11] ;GET DESTINATION BYTE SIZE
CAME T3,T4 ;ARE THEY THE SAME ?
JRST INER16 ;NO. FATAL CROSS CHECK
CAIGE P1,CMNFST ;LENGTH LONG ENOUGH TO ATTEMPT FAST MODE ?
JRST DTCPY2 ;NO. GO THE STRAIGHTFORWARD ROUTE
; CHECK TO DETERMINE IF FAST MODE IS POSSIBLE
PUSH P,P2 ;SAVE PERMANENT REGISTER FOR OUR USE
HLRZ T4,T1 ;ISOLATE SOURCE BYTE POSITION AND
ANDI T4,777700 ; SIZE
HLRZ P2,T2 ;ISOLATE DESTINATION BYTE POSITION AND
ANDI P2,777700 ; SIZE
CAME T4,P2 ;FIRST BYTE POSITIONS THE SAME ?
JRST DTCPY1 ;NO. USE NORMAL MODE
LSH P2,^D23-^D35 ;YES. ISOLATE FIRST BYTE POSITION
CAIE P2,44 ;WORD ALIGNED ?
JRST DTCPY1 ;NO. USE NORMAL MODE
; PERFORM FAST MODE COPY
PUSH P,P1 ;SAVE ANOTHER PERMANENT REGISTER FOR US
MOVEI P2,SBYTWD ;FIND NUMBER OF BYTES PER WORD
CAIE T3,D6BYSZ ; FROM BYTE SIZE
MOVEI P2,ABYTWD ; ...
IDIV P1,P2 ;GET FULL WORD LENGTH AND REMAINING BYTES
MOVEI T1,@T1 ;GET 18 BIT SOURCE ADDRESS
MOVEI T2,@T2 ;GET 18 BIT DESTINATION ADDRESS
; DTACPY CONTINUES
MOVE T3,T2 ;SETUP BLOCK MOVE POINTER WITH
HRL T3,T1 ; BEGINNING ADDRESSES
ADD T2,P1 ;CALCULATE END OF BLOCK MOVE +1
BLT T3,-1(T2) ;BLOCK MOVE ALL FULL WORDS
ADD T1,P1 ;CALCULATE SOURCE POSITION OF EXTRA BYTES
MOVE T3,P2 ;SAVE REMAINING BYTE COUNT
POP P,P1 ;RESTORE PERMANENT REGISTERS
POP P,P2 ; ...
JUMPLE T3,RETURN ;ALL FINISHED IF NO BYTES REMAINING
HRL T1,T4 ;SETUP SOURCE AND DESTINATION BYTE POINTERS TO
HRL T2,T4 ; MOVE LAST FEW BYTES
MOVE T4,T3 ;SETUP BYTE COUNT
JRST DTCPY3 ;MOVE THE LAST FEW BYTES AND RETURN
DTCPY1: POP P,P2 ;RESTORE PERMANENT REGISTER
; HERE FOR NORMAL BYTE-BY-BYTE COPY
DTCPY2: MOVE T4,P1 ;GET LENGTH WHERE WE CAN CLOBBER IT
DTCPY3: ILDB T3,T1 ;GET A SOURCE BYTE
IDPB T3,T2 ;PUT INTO DESTINATION
SOJG T4,DTCPY3 ;LOOP FOR EACH BYTE TO COPY
RET ;ALL FINSIHED. RETURN TO CALLER
SUBTTL IPCF UTILITY ROUTINES
;
; INFSND - COMPLETE <SYSTEM>INFO MESSAGE AND SEND IT OUT
; AFTER THE <SYSTEM>INFO FUNCTION ARGUMENT IS SETUP, THIS ROUTINE IS
; CALLED TO COMPLETE THE <SYSTEM>INFO MESSAGE AND SEND IT OUT.
; CALL:
; CALL INFSND
; T1 - THE LENGTH OF THE FUNCTION ARGUMENT IN WORDS
; P2 - THE <SYSTEM>INFO FUNCTION CODE
; RETURN:
; +1 - ALWAYS
; ERROR - DOES NOT RETURN
; DESTROYS: T1,T2,T3.
;
INFSND: PUSH P,T1 ;SAVE REQUEST DATA LENGTH
MOVE T3,P2 ;GET <SYSTEM>INFO FUNCTION CODE
TIME ;USE CURRENT TIME AS CODE VALUE
HRRZM T1,INFCDE(I) ;SAVE FOR LATER CHECK ON REPLY
HRL T3,T1 ;SETUP INFO CODE,,FUNCTION WORD
MOVEM T3,.IPCI0(S) ;PUT IT IN INFO REQUEST
SETZB T2,.IPCI1(S) ;RECEIVER IS <SYSTEM>INFO (PID IS 0)
;NOONE GETS COPY OF RESPONSE
POP P,T1 ;GET DATA LENGTH BACK
ADDI T1,2 ;REQUEST LENGTH INCLUDES 2 HEADER WORDS
CALL SENDIT ;SEND OUT THE MESSAGE
RET ;RETURN TO CALLER
;
; DOMTL1 - PERFORM A MUTIL JSYS WITH ONE ARGUMENT
; CALL:
; CALL DOMTL1
; T1 - CONTAINS THE MUTIL JSYS FUNCTION CODE
; T2 - CONTAINS THE ARGUMENT
; RETURN:
; +1 ALWAYS
; DOES NOT RETURN ON FATAL ERRORS
; DESTROYS: T1,T2.
;
DOMTL1: MOVEM T1,MTLBLK(I) ;SETUP ARG BLOCK WITH FUNCTION CODE
MOVEM T2,MTLBLK+1(I) ; AND THE ARGUMENT
MOVEI T1,3 ;LENGTH OF ARGUMENT BLOCK
MOVEI T2,MTLBLK(I) ;ADDRESS OF ARGUMENT BLOCK
MUTIL ;PERFORM THE FUNCTION
CALL JSYSER ;PROCESS ALL ERROR RETURNS
RET ;SUCCESS. RETURN NORMALLY
;
; INFWTR - WAIT FOR A VALID REPLY FROM <SYSTEM>INFO
; THIS ROUTINE IS USED WHEN A REPLY MUST BE RECEIVED FROM <SYSTEM>INFO
; BEFORE THESE ROUTINES CAN CONTINUE. A TIMEOUT GENERATES A FATAL ERROR.
; CALL:
; CALL INFWTR
; RETURN:
; +1 - ALWAYS
; R - CONTAINS THE ADDRESS OF THE DATA PACKET RETURNED BY <SYSTEM>INFO.
; THE RECEIVED PACKET HEADER MAY ALSO BE FOUND AT IPKHDR(I).
; DESTROYS: T1.
;
INFWTR: MOVEI T1,IFRPLM ;TIME LIMIT TO WAIT FOR REPLY
CALL INFWT ;WAIT FOR SOMETHING TO HAPPEN
JUMPE T1,USER21 ;IF TIMEOUT, THIS IS AN ERROR
RET ;GOT VALID REPLY, RETURN TO CALLER
;
; INFCKR - CHECK FOR A REPLY FROM <SYSTEM>INFO
; THIS ROUTINE IS USED WHEN A REPLY MAY BE RECEIVED FROM <SYSTEM>INFO. IT
; WILL RETURN IF A VALID REPLY IS RECEIVED OR IF THE WAIT TIME LIMIT IS
; EXCEEDED. AN ERROR REPLY FROM <SYSTEM>INFO WILL GENERATE THE APPROPRIATE
; ERROR RETURN.
; CALL:
; CALL INFCKR
; RETURN:
; +1 - ALWAYS
; DESTROYS: T1.
;
INFCKR: MOVEI T1,IFCKLM ;TIME LIMIT TO WAIT FOR REPLY
CALL INFWT ;WAIT FOR SOMETHING TO HAPPEN
RET ;ANY RETURN IS VALID
;
; INFWT - WAIT FOR A REPLY FROM <SYSTEM>INFO OR A TIMEOUT
; THIS ROUTINE IS CALLED AFTER A REQUEST HAS BEEN SENT TO <SYSTEM>INFO
; (BY INFSND) TO WAIT FOR THE REPLY. IF ANY VALID DATA MESSAGES ARE
; RECEIVED WHILE WAITING FOR THE REPLY, THOSE MESSAGES ARE ENTERED IN
; THE INTERNAL RECEIVE QUEUE.
; THE RECEIVED DATA PACKET HAS PASSED ALL THE LEGALITY CHECKS TO INSURE THAT
; IT IS THE REPLY TO THIS SPECIFIC REQUEST.
; CALL:
; CALL INFWT
; T1 - CONTAINS THE MAXIMUM AMOUNT OF TIME (MILLISECONDS) TO WAIT FOR
; A REPLY.
; RETURN:
; +1 - ALWAYS
; T1 - CONTAINS ZERO IF NO REPLY WAS RECEIVED IN THE TIME LIMIT OR
; CONTAINS NONZERO IF A VALID REPLY WAS RECEIVED.
; IF A REPLY WAS RECEIVED:
; R - CONTAINS THE ADDRESS OF THE DATA PACKET RETURNED BY <SYSTEM>INFO.
; THE RECEIVED PACKET HEADER MAY ALSO BE FOUND AT IPKHDR(I).
; ERROR - DOES NOT RETURN
; DESTROYS: T1,T2,T3.
;
INFWT: PUSH P,P1 ;SAVE PERMANENT REGISTER FOR OUR USE
MOVEI P1,WTIIPC ;SET IT UP TO WAIT FOR IPCF PACKET
MOVEM T1,T3 ;SAVE TIME INTERVAL
TIME ;GET CURRENT SYSTEM UPTIME
ADD T1,T3 ;ADD INTERVAL TO GET MAX END TIME
MOVEM T1,IFETIM(I) ;SAVE OUR MAXIMUM END TIME
MOVE T1,T3 ;SETUP INITIAL INTERVAL FOR LOOP
JRST INFWT3 ;BEGIN THE WAIT
INFWT1: TIME ;GET CURRENT UPTIME IN MILLISECONDS
MOVE T2,IFETIM(I) ;GET OUR LATEST END TIME
SUBM T2,T1 ;CALCULATE HOW LONG TO WAIT FROM NOW
JUMPG T1,INFWT3 ;MORE TIME LEFT. GO WAIT
INFWT2: POP P,P1 ;TIME HAS RUN OUT. RESTORE PERMANENT
JRST RETT10 ; REGISTER AND TELL USER WHAT HAPPENED
INFWT3: CALL MWAIT ;WAIT FOR IPCF OR TIMEOUT
JRST INER10 ;PARAMETERS BAD. FATAL ERROR
CAIN T1,WTOIPC ;GET AN IPCF MESSAGE ?
JRST INFWT4 ;YES. GO PROCESS IT
CAIN T1,WTOTIM ;TIME LIMIT EXCEEDED ?
JRST INFWT2 ;YES. RETURN APPROPRIATE INDICATOR
JRST INER9 ;NO. FATAL CONSISTENCY CHECK
; INFWT CONTINUES
; HERE IF THERE IS AN IPCF MESSAGE TO BE PROCESSED
INFWT4: CALL RECVIT ;RECEIVE IPCF MESSAGE FROM THE MONITOR
JUMPE T1,INFWT1 ;IPCF DIDN'T HAVE ANYTHING. WAIT SOME MORE
LDB T1,[POINT 3,IPKHDR+.IPCFL(I),32] ;GET SYSTEM AND SENDER CODE
CAIE T1,.IPCCF ;SENT BY SYSTEM WIDE <SYSTEM>INFO ?
JRST INFWT5 ;NO. CHECK OUT THIS MESSAGE FURTHER
HLRZ T1,.IPCI0(R) ;YES. GET THE CODE FIELD
CAME T1,INFCDE(I) ;MATCH THE ONE WE SENT ?
JRST INFWT6 ;NO. NOT FOR US, THROW IT AWAY
POP P,P1 ;RESTORE PERMANENT REGISTER
LDB T1,[POINT 6,IPKHDR+.IPCFL(I),29] ;<SYSTEM>INFO SEND US ERROR ?
JUMPN T1,INFERR ;YES. GO PROCESS IT
JRST RETT1N ;NO. GOT VALID <SYSTEM>INFO REPLY. TELL CALLER
; HERE IF IPCF PACKET IS NOT CORRECT REPLY FROM <SYSTEM>INFO
INFWT5: MOVE T1,IPKHDR+.IPCFL(I) ;GET PACKET FLAG WORD
TXNN T1,IP%CFV ;IS DATA A LONG PACKET (PAGE) ?
JRST INFWT6 ;NO. ALL VALID DATA PACKETS ARE LONG
CALL IRQENT ;YES. PLACE IT IN THE INTERNAL RECEIVE QUEUE
JRST INFWT1 ;CONTINUE TO WAIT FOR REPLY WE WANT
; HERE TO THROW A DATA PACKET AWAY
INFWT6: AOS ERIMSG(I) ;COUNT ERRONEOUS IPCF MESSAGES
JRST INFWT1 ;CONTINUE TO WAIT FOR REPLY WE WANT
;
; MRQRMV - REMOVE AN ENTRY FROM THE MONITOR RECEIVE QUEUE
; THIS ROUTINE AND IRQRMV MUST PROVIDE AN IDENTICAL INTERFACE TO THE
; OUTSIDE WORLD.
; CALL:
; CALL MRQRMV
; RETURN:
; +1 - ALWAYS
; T1 - CONTAINS ZERO IF THERE IS NO ENTRY IN THE MONITOR QUEUE OR
; CONTAINS NONZERO IF AN ENTRY WAS FOUND.
; IF AN ENTRY WAS FOUND:
; T3 - CONTAINS THE RIGHT HALF OF THE IPCF PACKET HEADER FLAG WORD
; IN ITS RIGHT HALF
; T4 - CONTAINS THE SENDER'S PID
; R - CONTAINS THE ADDRESS OF THE IPCF DATA PACKET
; DESTROYS: T1,T3,T4.
;
MRQRMV: CALL RECVIT ;GET IPCF DATA INTO OUR ADDRESS SPACE
JUMPE T1,RETURN ;NOTHING THERE. TELL CALLER
HRRZ T3,IPKHDR+.IPCFL(I) ;GET IPCF FLAGS FROM HEADER
MOVE T4,IPKHDR+.IPCFS(I) ;GET SENDER'S PID FROM HEADER
RET ;RETURN TO CALLER
;
; INFERR - PROCESS ERROR CODES RETURNED BY <SYSTEM>INFO
; THE ERROR CODES RETURNED BY <SYSTEM>INFO FALL INTO TWO
; CLASSES: THOSE WHICH RETURN A USER ERROR CODE AND THOSE
; WHICH ARE FATAL. ALL <SYSTEM>INFO ERROR CODES WHICH RETURN
; USER ERROR CODES MUST APPEAR IN THE TABLE INFERT.
; CALL:
; JRST INFERR
; T1 - CONTAINS THE <SYSTEM>INFO ERROR CODE
; RETURN:
; DOES NOT RETURN TO CALLER, BUT DOES RETURN TO COBOL
; T1 - PRESERVED IF ERROR CODE NOT FOUND IN TABLE INFERT
; DESTROYS: T2,T3.
;
INFERR: HRLZI T3,-INFERL ;GET POINTER TO ERROR CODE TABLE
INFER1: HLRZ T2,INFERT(T3) ;GET INFO ERROR CODE FROM TABLE
CAME T2,T1 ;THE ONE WE ARE LOOKING FOR ?
AOBJN T3,INFER1 ;NO. LOOK AT NEXT ENTRY
JUMPGE T3,INER3 ;JUMP IF CAN'T FIND ENTRY IN TABLE
HRRZ T1,INFERT(T3) ;GET CORRESPONDING USER ERROR CODE
JRST ERRRET ;AND RETURN TO USER
SUBTTL RECEIVE AN IPCF MESSAGE
;
; RECVIT - SETUP FOR AND RECEIVE AN IPCF MESSAGE
; THIS ROUTINE DETERMINES IF THERE IS AN IPCF MESSAGE AVAILABLE, SETS UP
; THE IPCF PACKET HEADER TO RECEIVE IT, AND RECEIVES THE MESSAGE. THIS
; ROUTINE CAN BE USED FOR BOTH SHORT AND LONG PACKETS.
; CALL:
; CALL RECVIT
; RETURN:
; +1 - ALWAYS
; T1 - NONZERO IF THE PACKET WAS RECEIVED CORRECTLY OR
; ZERO IF THERE IS NO PACKET TO BE RECEIVED
; R - CONTAINS THE ADDRESS OF THE RECEIVED DATA PACKET
; THE RECEIVED PACKET HEADER MAY ALWAYS BE FOUND AT IPKHDR(I)
; DESTROYS: T1,T2,T3.
;
RECVIT: CALL IPQRY ;ANYTHING IN THE MONITOR IPCF RECEIVE QUEUE ?
JUMPE T1,RETURN ;NO. RETURN T1=0 TO INDICATE THAT
PUSH P,P1 ;SAVE PERMANENT REGISTER FOR OUR USE
MOVE P1,T1 ;PUT ASSOCIATIVE VARIABLE IN SAFE PLACE
TXNE P1,IP%CFV ;IS DATA PACKET A FULL PAGE ?
JRST RCVIT1 ;YES. SETUP RECEIVE DIFFERENTLY
CALL IMMIN ;GET AN AREA FOR SHORT PACKET
JUMPE T1,USER20 ;NO PAGES AVAILABLE FOR DATA
MOVE R,T1 ;SAVE DATA PAGE NUMBER FOR LATER
LSH T1,PG2ADR ;SHORT MODE REQUIRES ACTUAL ADDRESS
MOVX T2,IP%CFB ;DON'T WAIT IF NOTHING IN THE QUEUE
JRST RCVIT2 ;CONTINUE SETUP AND GET THE PACKET
RCVIT1: CALL IMMOUT ;GET A PAGE NOT IN ADDRESS SPACE
JUMPE T1,USER20 ;NO PAGES AVAILABLE FOR DATA
MOVE R,T1 ;SAVE DATA PAGE NUMBER FOR LATER
MOVX T2,IP%CFB+IP%CFV ;SET DON'T WAIT & LONG PACKET MODE
RCVIT2: MOVEM T2,IPKHDR+.IPCFL(I) ;SETUP FLAGS IN PACKET HEADER
HLL T1,P1 ;GET LENGTH ALONG WITH DATA ADDRESS
MOVEM T1,IPKHDR+.IPCFP(I) ;SETUP LENGTH,,ADDRESS OF DATA
SETZM IPKHDR+.IPCFS(I) ;CLEAR SENDER'S PID
MOVE T1,MYPID(I) ;RECEIVE MESSAGES FOR MY PID ONLY
MOVEM T1,IPKHDR+.IPCFR(I) ; ...
SETZM ASCVAR(I) ;CLEAR THIS ASSOC VAR IN CASE OF ERROR
POP P,P1 ;RESTORE PERMANENT REGISTER
MOVEI T1,IPKHDL ;SETUP THE HEADER LENGTH
MOVEI T2,IPKHDR(I) ;AND ITS ADDRESS
MRECV ;GET THE PACKET
CALL JSYSER ;ERROR. GO PROCESS IT
MOVEM T1,ASCVAR(I) ;RECV OK. SAVE NEXT Q ENTRY DESCRIPTOR
CALL IMMINR ;MARK PACKET DATA PAGE AS IN ADDRESS SPACE
LSH R,PG2ADR ;RETURN ADDRESS OF PACKET DATA
RETT1N: SETOM T1 ;T1 NONZERO MEANS RECEIVE OK
RET ;RETURN INFO TO CALLER
SUBTTL SEND AN IPCF MESSAGE
;
; SENDIT - SETUP AND SEND AN IPCF PACKET
; THIS ROUTINE COMPLETES THE IPCF PACKET HEADER AND CALLS THE MONITOR
; TO SEND THE PACKET. IT CAN BE USED FOR BOTH SHORT AND LONG PACKETS.
; CALL:
; CALL SENDIT
; T1 - CONTAINS THE LENGTH OF THE PACKET DATA
; T2 - CONTAINS THE RECEIVER'S PID
; RETURN:
; +1 - ALWAYS
; ERROR - DOES NOT RETURN
; DESTROYS: T1,T2,T3.
;
SENDIT: MOVEM T2,IPKHDR+.IPCFR(I) ;SETUP THE RECEIVER'S PID
MOVE T2,MYPID(I) ;GET OUR PID
MOVEM T2,IPKHDR+.IPCFS(I) ;PLACE IT IN REQUEST HEADER
SETZM T2 ;CLEAR IPCF FLAGS
MOVE T3,S ;GET ADDRESS OF PACKET DATA
CAIE T1,PGLGTH ;IS PACKET DATA A PAGE ?
JRST SNDIT1 ;NO. ALMOST ALL SETUP
TXO T2,IP%CFV ;YES. SET PAGE MODE FLAG
LSH T3,ADR2PG ;THE DATA ADDRESS IS A PAGE NUMBER
SNDIT1: MOVEM T2,IPKHDR+.IPCFL(I) ;PLACE FLAGS IN PACKET HEADER
HRL T3,T1 ;PUT LENGTH WITH ADDRESS
MOVEM T3,IPKHDR+.IPCFP(I) ;PUT DATA DESCRIPTOR IN HEADER
MOVEI T3,RTRYCT ;INITIALIZE THE RETRY COUNT
SNDIT2: MOVEI T1,IPKHDL ;SETUP THE HEADER LENGTH
MOVEI T2,IPKHDR(I) ;AND ITS ADDRESS
MSEND ;ATTEMPT TO SEND THE DATA
CALL SNDIT3 ;ERROR. MAYBE WE CAN HELP OUT
RET ;ALL FINISHED. RETURN TO USER
; HERE ON MSEND JSYS ERRORS. ATTEMPT TO GET MESSAGE THROUGH.
SNDIT3: SOJLE T3,JSYSER ;IF TRIED ENOUGH, RETURN ERROR TO USER
CAIE T1,IPCFX6 ;MY SEND QUOTA EXHAUSTED ?
CAIN T1,IPCFX7 ;OR RECEIVER'S QUOTA EXHAUSTED ?
JRST SNDIT4 ;YES. WAIT SOME, THEN TRY AGAIN
CAIE T1,IPCFX8 ;SYSTEM FREE SPACE EXHAUSTED ?
JRST JSYSER ;NO. CAN'T HELP. RETURN ERROR TO USER
SNDIT4: POP P,T1 ;DISCARD ERROR PC
MOVEI T1,RTRYWT ;TIME INTERVAL BETWEEN RETRIES
DISMS ;SUSPEND THAT LONG
JRST SNDIT2 ;ATTEMPT TO SEND THE MESSAGE AGAIN
SUBTTL EXAMINE MONITOR IPCF RECEIVE QUEUE
;
; IPQRY - EXAMINES MONITOR IPCF RECEIVE QUEUE
; THIS ROUTINE DETERMINES IF THERE IS A MESSAGE IN THE MONITOR'S
; RECEIVE QUEUE. AN ENTRY IS AVAILABLE IF THE ASSOCIATIVE VARIABLE
; FROM THE PREVIOUS IPCF RECEIVE IS NONZERO OR THE RESULT OF A
; QUERY OF THE IPCF RECEIVE QUEUE INDICATES AN ENTRY IS AVAILABLE.
; CALL:
; CALL IPQRY
; RETURN:
; +1 - ALWAYS
; T1 = 0, IF NO ENTRY IS PRESENT OR
; T1 = ASSOCIATIVE VARIABLE OF THE ENTRY WHICH IS AVAILABLE
; DESTROYS: T1,T2,T3.
;
IPQRY: SKIPE T1,ASCVAR(I) ;EXAMINE ASSOCIATIVE VARIABLE
RET ;RETURN IT IF THERE IS ONE
SETZM MTLBLK+1+.IPCFL(I) ;CLEAR FLAGS WORD
SETZM MTLBLK+1+.IPCFP(I) ;CLEAR LENGTH,,ADDRESS DESCRIPTOR
MOVEI T1,5 ;LENGTH OF MUTIL ARGUMENT BLOCK
MOVEI T2,MTLBLK(I) ;ADDRESS OF MUTIL ARGUMENT BLOCK
MOVEI T3,.MUQRY ;FUNCTION IS EXAMINE IPCF QUEUE
MOVEM T3,(T2) ;PUT IT IN THE ARGUMENT BLOCK
SKIPN T3,MYPID(I) ;GET NEXT ENTRY FOR MY PID
JRST INER6 ;FATAL ERROR IF WE DON'T HAVE PID NOW
MOVEM T3,1(T2) ;MY PID IS MUTIL ARGUMENT
MUTIL ;EXAMINE THE IPCF QUEUE
CALL IPQRY2 ;GO PROCESS ANY ERRORS
HLL T1,MTLBLK+1+.IPCFP(I) ;GET THE LENGTH (NOT 0 IF ENTRY THERE)
HRR T1,MTLBLK+1+.IPCFL(I) ;GET THE FLAGS (MAY BE 0 EVEN IF ENTRY)
TXNE T1,IP%CFV ;PAGE MODE FLAG SET ?
HRLI T1,PGLGTH ;YES. MAKE SURE LENGTH IS CORRECT
IPQRY1: MOVEM T1,ASCVAR(I) ;SAVE THE RESULT
RET ;RETURN THE RESULT TO CALLER
; HERE IF QUERY JSYS TAKES ERROR RETURN
IPQRY2: CAIE T1,IPCFX2 ;IS ERROR NO PACKET AVAILABLE ?
JRST JSYSER ;NO. NORMAL JSYS ERROR PROCESSING
SETZM T1 ;YES. INDICATE THAT FACT
POP P,(P) ;THROW AWAY ERROR ADDRESS
JRST IPQRY1 ;AND RETURN TO CALLER
SUBTTL PAGE MANIPULATION ROUTINES
; THESE ROUTINES MANIPULATE THE PAGES OF THESE ROUTINES WHICH ARE
; DYNAMICALLY ALLOCATED. THESE PAGES ARE ALLOCATED ON A PAGE BASIS
; BEGINNING WITH PAGE "HGHPG" OF THE ADDRESS SPACE AND WORKING
; DOWNWARD TO PAGE "LOWPG" OF THE ADDRESS SPACE. ANY PAGE OF THE
; PORTION OF THE ADDRESS SPACE BETWEEN "HGHPG" AND "LOWPG" WHICH
; EXISTS AT THE TIME IT IS CONSIDERED FOR USE, WILL NOT BE USED BY
; THESE ROUTINES.
;
; PGFND - FIND A NONEXISTANT PAGE
; THIS ROUTINE SEARCHS THE AVAILABLE PORTION OF THE ADDRESS SPACE
; FOR A PAGE WHICH DOES NOT CURRENTLY EXIST.
; CALL:
; CALL PGFND
; RETURN:
; +1 - ERROR; COULD NOT FIND A PAGE
; +2 - SUCCESS; T1 CONTAINS THE PAGE NUMBER WHICH HAS BEEN FOUND
; DESTROYS: T1,T2,T3.
;
PGFND:
;[2] CHANGES FOR RELEASE 12 OF COBOL DATA MANAGEMENT
CALL GETPAG ;GET PAGE OF MEMORY -- IF NOT AVAILABLE
JRST PGFND0 ; THEN FIND OUT WHY.
JFCL ; ELSE (PAGE IN T1).
LSH T1,ADR2PG ;CONVERT FROM AN ADDRESS TO A PAGE NUMBER.
MOVEM T1,PGLST(I) ; SAVE ADDRESS OF PAGE
JRST SKPRET ; AND MAKE SUCCESSFUL RETURN.
PGFND0: SKIPL T2 ;IF CALL IS IMPLEMENTED
JRST RETURN ; THEN THERE IS NO MEMORY
JFCL ; ELSE THIS IS COBOL V(11).
;[2]END OF COBOL V(12) PATCH
SKIPE T3,PGLST(I) ;GET LAST PAGE NMB ALLOCATED, IF ONE
JRST PGFND1 ;THERE WAS ONE, CONTINUE
HRRZ T3,.JBCST## ;NONE, GET PAGE NUMBER OF IMPURE AREA
LSH T3,ADR2PG ; SETUP BY INITRT AND PGFNDI
JUMPE T3,INER5 ;IF NONE, FATAL CONSISTENANCY CHECK
PGFND1: SOS T3 ;DECREMENT TO NEXT LOWER PAGE
CAIGE T3,LOWPG ;BEYOND OUR LOWER BOUNDARY ?
JRST RETURN ;YES. ERROR, COULD NOT FIND A PAGE
MOVE T1,T3 ;NO. GET THIS PAGE'S ACCESSABILITY
HRLI T1,.FHSLF ; IN THIS PROCESS
RPACS ; DO IT
ERCAL JSYSER ;PROCESS JSYS ERROR RETURN
TXNE T2,PA%PEX ;THIS PAGE ALREADY EXIST ?
JRST PGFND1 ;YES. DON'T USE IT
MOVE T1,T3 ;NO. SAVE PAGE NUMBER FOR CALLER
MOVEM T1,PGLST(I) ;SAVE PAGE FOR FUTURE SEQUENCING
JRST SKPRET ;SUCCESS RETURN WITH PAGE NUMBER
;
; PGFNDI - FIND A PAGE FOR THE IMPURE DATA AREA
; THIS ROUTINE IS A SPECIAL PURPOSE ROUTINE TO ALLOCATE THE
; PAGE FOR THE IMPURE DATA AREA. IT IS CALLED AT FIRST-TIME
; INITIALIZATION IN ROUTINE INITI AND SHOULD NOT BE
; CALLED AT ANY OTHER TIME.
; CALL:
; CALL PGFNDI
; RETURN:
; +1 - ERROR; COULD NOT FIND A PAGE
; +2 - SUCCESS; T1 CONTAINS THE PAGE NUMBER WHICH HAS BEEN FOUND
; DESTROYS: T1,T2,T3.
;
PGFNDI:
;[2] CHANGES FOR RELEASE 12 OF COBOL DATA MANAGEMENT
CALL GETPAG ;GET A PAGE -- IF NOT AVAILABLE
JRST PGFNI0 ; THEN FIND OUT WHY (REASON IN T2).
JFCL ; ELSE (PAGE IS IN T1).
LSH T1,ADR2PG ;CONVERT TO PAGE NUMBER.
JRST SKPRET ; AND MAKE SUCCESSFUL RETURN.
PGFNI0: SKIPL T2 ;IF CALL IS IMPLEMENTED
JRST RETURN ; THEN THERE IS NO MEMORY
JFCL ; ELSE THIS IS COBOL V(11).
;[2]END OF COBOL V(12) PATCH
MOVEI T3,HGHPG+1 ;START LOOKING AT THE HIGHEST PAGE
PGFDI1: SOS T3 ;TRY THE NEXT LOWER PAGE
CAIGE T3,LOWPG ;BEYOND OUR LOWER BOUNDARY ?
JRST RETURN ;YES. ERROR-COULD NOT FIND PAGE
MOVE T1,T3 ;GET THIS PAGE'S ACCESSABILITY IN
HRLI T1,.FHSLF ; OUR PROCESS
RPACS ; DO IT
ERJMP RETURN ;ERROR RETURN ON JSYS ERROR
TXNE T2,PA%PEX ;THIS PAGE ALREADY EXIST IN THIS PROCESS?
JRST PGFDI1 ;YES. TRY THE NEXT LOWER ONE
MOVE T1,T3 ;NO. SAVE PAGE NUMBER FOR CALLER
LSH T3,PG2ADR ;+MAKE PAGE NUMBER AN ADDRESS
IORI T3,777 ;+WE WILL USE THE WHOLE PAGE
CORE T3, ;+TELL THE COMPATIBILITY PACKAGE TO
JRST RETURN ;+ LET US USE THIS PAGE AND ALL BELOW
JRST SKPRET ;SUCCESS RETURN WITH PAGE NUMBER IN T1
;
; PGDST - REMOVE A PAGE FROM THE ADDRESS SPACE
; CALL:
; CALL PGDST
; T1 - CONTAINS THE PAGE NUMBER OF THE PAGE TO BE REMOVED
; RETURN:
; +1 - PAGE WAS REMOVED SUCCESSFULLY
; ERROR - DOES NOT RETURN ON FATAL ERRORS
; DESTROYS: T1,T2,T3.
;
PGDST: MOVE T2,T1 ;POSITION PAGE NUMBER FOR JSYS
HRLI T2,.FHSLF ;REMOVE PAGE FROM MY ADDRESS SPACE
SETOM T1 ;FUNCTION IS REMOVE PAGE
MOVEI T3,1 ;ONLY ONE PAGE TO REMOVE
PMAP ;DO IT
ERCAL JSYSER ;PROCESS JSYS ERROR RETURNS
RET ;SUCCESS RETURN
;[2] COBOL V12 DATA MANAGEMENT DATA BASE (READ ONLY)
GETPAG: ;GET A PAGE FROM THE COBOL PAGE MANAGEMENT ROUTINES
PUSH P,F ;SAVE FLAG VARIABLE.
PUSH P,L ;SAVE LINK POINTER
MOVEI L,L%FC ;GET POINTER TO ARGUMENT BLOCK.
PUSH P,IMP%ER ;SAVE THE AREA USED FOR THE CHANGED
PUSH P,IMP%ST ; ARGUMENTS
PUSH P,IMP%PT
PUSH P,IMP%SZ
MOVEI T1,1000 ;SET SIZE OF MEMORY TO 1000 WORDS (1 PAGAGE).
MOVEM T1,IMP%SZ
SETZM IMP%ER ;CLEAR OTHER VARIABLES
SETZM IMP%ST
SETZM IMP%PT
CALL FUNCT.## ;GET THE MEMORY.
MOVE T1,IMP%PT ;GET THE PAGE ADDRESS AND
MOVE T2,IMP%ST ; THE STATUS RETURNED.
POP P,IMP%SZ ;RESTORE THE ORIGINAL CONTENTS
POP P,IMP%PT ; OF THE TEMPORARY LOCATION.
POP P,IMP%ST
POP P,IMP%ER
POP P,L ;THIS IS THE LINK
POP P,F ;RESTORE FLAG VARIABLE
SKIPE T2 ;IF THERE WAS AN ERROR
JRST RETURN ; THEN GIVE NON-SKIP RETURN
JRST SKPRET ; ELSE SKIP ON RETURN
; ARGUMENT BLOCK TO THE FUNCT. CALL IN LIBOL
; FORMAT IS
;
; -CNT,,0
; LST: TYPE,,FUNCTION
; TYPE,,[ERROR]
; TYPE,,[STATUS]
; TYPE,,[ADDRESS OF CORE]
; TYPE,,[SIZE]
-4,,0
L%FC: 200,,FC.PAG ;GET PAGE ALLIGNED MEMORY
200,,IMP%ER ;ERROR CODE
200,,IMP%ST ;STATUS CODE
200,,IMP%PT ;POINTER TO AREA
200,,IMP%SZ ;SIZE TO BE GOTTEN
FC.PAG: 15 ;CODE FOR PAGE ALIGNED DATA.
.JBDDT=74
IMP%ER=.JBDDT+1
IMP%ST=.JBDDT+2
IMP%PT=.JBDDT+3
IMP%SZ=.JBDDT+4
SUBTTL INITIALIZATION AND EXIT ROUTINES
;
; INITIALIZATION ROUTINE FOR ANY ENTRY POINT CALLED BY COBOL.
; THIS ROUTINE MUST BE CALLED IMMEDIATELY AFTER ENTRY FROM COBOL.
; FUNCTIONS:
; 1. SETS UP THE IMPURE DATA AREA POINTER
; 2. SAVES ALL THE REGISTERS WHICH ARE MODIFIED IN THESE ROUTINES
;
;CALL:
; SAVE P1 ON THE TOP OF THE STACK
; SETUP P1 TO BE THE ADDRESS IN THE ARGUMENT LIST OF THE ERROR CODE
; PARAMETER. ALL OF THIS IS DONE IN THE ENTR MACRO.
; CALL INITI
; RETURN:
; +1 - INITIALIZATION SUCCESSFUL
; ERROR - DOES NOT RETURN IF JSYS ERROR DETECTED
;
INITI: PUSH P,I ;SAVE I REGISTER PASSED BY COBOL
SKIPE I,.JBCST## ;IMPURE AREA ALREADY ALLOCATED?
JRST INITI1 ;YES. ALREADY BEEN CALLED AT LEAST ONCE
PUSH P,T1 ;SAVE SOME REGISTERS WE NEED
PUSH P,T2 ; ...
PUSH P,T3 ; ...
CALL PGFNDI ;FIND AND CREATE A PAGE FOR IMPURE DATA
JRST INER1 ;ERROR. COULD NOT FIND PAGE - FATAL
LSH T1,PG2ADR ;CONVERT PAGE NUMBER TO ADDRESS
MOVE I,T1 ;SETUP THE IMPURE AREA BASE REGISTER
MOVEM T1,.JBCST## ;SAVE BASE REGISTER FOR FUTURE CALLS
HRLZ T1,T1 ;SETUP BLOCK TRANSFER POINTER TO
HRRI T1,1(I) ; IMPURE AREA
SETZM (I) ;CLEAR THE IMPURE AREA TO ALL
BLT T1,^D511(I) ; ZEROS
POP P,T3 ;RESTORE TEMPORARIES SO THEY WILL
POP P,T2 ; BE SAVED CORRECTLY
SKIPA ;ENTER SAVE REGISTERS WITH T1 ON STACK
INITI1: PUSH P,T1 ;SAVE A REGISTER FOR US TO USE
HRRZI T1,SVREGS(I) ;SETUP PTR TO SAVE REGISTERS
BLT T1,SVREGS+MAXREG(I) ;SAVE ALL OF THE REGISTERS
POP P,SVREGS+T1(I) ;SAVE PASSED VALUE OF T1
POP P,SVREGS+I(I) ;SAVE THE PASSED VALUE OF I
POP P,T1 ;GET OUR RETURN ADDRESS
POP P,SVREGS+P1(I) ;SAVE ENTRY VALUE OF P1
MOVEM P,SVP(I) ;SAVE ENTRY STACK POINTER
JRST (T1) ;FINISHED, BUT BE SURE TO CALL INITRT LATER
;
; INITIALIZATION ROUTINE FOR ANY ENTRY POINT CALLED BY COBOL.
; THIS ROUTINE MUST BE CALLED IMMEDIATELY AFTER ENTRY FROM COBOL, BUT
; AFTER THE IMPURE AREA HAS BEEN SETUP.
; FUNCTIONS:
; 1. SETS UP THE ADDRESS OF THE ERROR PARAMETER FOR THE ERROR ROUTINE
; 2. SETS UP ALL REGISTERS WHICH HAVE VALUES GLOBAL TO ALL ROUTINES
; 3. SETS UP THE POINTER TO THE IPCF SEND DATA PAGE
; 4. SETS UP THE ENTRY AND REMOVE POINTERS TO THE INTERNAL RECEIVE QUEUE
;
; CALL:
; P1 - CONTAINS THE ADDRESS OF THE ERROR CODE IN THE PARAM LIST
; CALL INITRT
; RETURN:
; +1 - INITIALIZATION SUCCESSFUL
; ERROR - DOES NOT RETURN ON FATAL ERRORS
; DESTROYS: T1,T2,T3.
;
INITRT: MOVEM P1,ERPMAD(I) ;SAVE ERROR PARAM ADDR IN ARGUMENT LIST
SETZM @(P1) ;SET ERROR CODE FOR SUCCESSFUL RETURN
MOVE F,SVF(I) ;GET CURRENT GLOBAL STATUS FLAGS
MOVE S,SVS(I) ;GET ADDR OF IPCF SEND PAGE
JUMPN S,INIRT1 ;HAVE WE FOUND A PAGE YET ?
;NO. PERFORM ALL ONE TIME INITIALIZATION
CALL PGFND ;FIND PAGE TO SEND IPCF DATA
JRST USER4 ;NO PAGE. RETURN NO MEM AVAIL TO COBOL
LSH T1,PG2ADR ;CONVERT PAGE NUMBER TO ADDRESS
MOVEM T1,SVS(I) ;SAVE IT FOR FUTURE REFERENCE
MOVE S,T1 ;PUT IT IN CORRECT REGISTER
MOVEI T1,IRQQUE(I) ;GET BEGINNING ADDRESS OF IRQ
MOVEM T1,IRQPUT(I) ;THAT IS FIRST FREE ENTRY AND
MOVEM T1,IRQGET(I) ; NEXT ENTRY TO BE REMOVED
INIRT1:
RET ;INITIALIZATION COMPLETE
;
; ERRRET - RETURN AN ERROR CODE TO THE CALLER (USUALLY COBOL)
; RETURN AN ERROR CODE TO THE CALLER OF A ROUTINE. USUALLY THE LEVEL
; WHICH WILL BE THE RECIPIENT OF THE ERROR CODE WILL BE THE COBOL
; PROGRAM WHICH ENTERED WITH AN ENTER MACRO STATEMENT.
; CALL:
; JRST ERRRET
; T1 - CONTAINS THE ERROR CODE WHICH IS TO BE RETURNED
; RETURN:
; DOES NOT RETURN
; DESTROYS: T1,T2.
;
ERRRET: MOVE T2,ERPMAD(I) ;GET ADDR OF ERROR CODE IN PARAMETER LIST
MOVEM T1,@(T2) ;PUT THE ERROR CODE WHERE COBOL CAN USE IT
; JRST XIT ;RETURN TO COBOL
;
; XIT - EXIT TO A MAJOR ROUTINE
; CALL:
; JRST XIT
; RETURN:
; NEVER RETURNS
; DESTROYS: NOTHING
;
XIT: TXZE F,F$RMVR ;RECEIVE PAGE TO BE REMOVED FROM ADDR SPACE?
CALL IMMRVR ;YES. MAKE ONE ATTEMPT TO REMOVE IT
MOVE P,SVP(I) ;RESTORE STACK TO STATUS ON ENTRY
HRRZM F,SVF(I) ;SAVE CURRENT GLOBAL STATUS FLAGS
HRLZI MAXREG,SVREGS(I);SETUP POINTER TO RESTORE REGISTERS
BLT MAXREG,MAXREG ;RESTORE ALL REGISTERS
RET ;AND RETURN TO COBOL
SUBTTL INTERNAL ERROR ROUTINES
;
; INTERNAL ERRORS ARE THOSE ERRORS WHICH ARE DETECTED BY THESE ROUTINES
; RATHER THAN ERRORS WHICH ARE DETECTED BY THE MONITOR AS A RESULT OF A
; CALL BY THESE ROUTINES.
; THE INTERNAL ERRORS FALL INTO TWO CLASSES: THOSE THAT RETURN AN ERROR
; CODE TO THE COBOL PROGRAM AND THOSE THAT ARE FATAL. THE FATAL ERRORS
; PRINT A FATAL ERROR MESSAGE CONTAINING THE INTERNAL ERROR CODE, AND
; RETURN CONTROL TO THE COBOL PROGRAM INDICATING THAT A FATAL ERROR
; OCCURRED.
; THE TWO CLASSES ARE DISTINGUISHED BY THE FIRST FOUR LETTERS OF THE
; NAME OF THE ROUTINE WHICH PROCESSES THE ERRORS. THE REMAINDER
; OF THE NAME OF THE ERROR PROCESSING ROUTINE IS MADE UP OF THE ERROR
; NUMBER. THE FOUR LETTER COMBINATIONS USED ARE:
; USER - THIS ERROR ROUTINE RETURNS AN ERROR CODE TO THE USER. THE
; ERROR CODE RETURNED IS INDICATED BY THE LAST ONE OR TWO
; NUMERICS OF THE NAME.
; INER - THIS ERROR ROUTINE PROCESSES AN INTERNAL FATAL ERROR CONDITION.
; THE INTERNAL ERROR CODE IS INDICATED BY THE LAST ONE OR TWO
; NUMERICS OF THE NAME. A MESSAGE INDICATING THE FATAL ERROR
; WHICH OCCURED WILL BE PRINTED ON THE USER TERMINAL, AND THE
; FACT THAT A FATAL ERROR OCCURED WILL BE RETURNED TO COBOL.
;
;
; INTERNAL ERRORS CLASS 1 - RETURN ERROR CODE TO COBOL CALLER.
; NOTE THAT ALL THE ERROR CODES WHICH MAY BE RETURNED TO THE
; CALLER ARE NOT PROCESSED BY THESE ROUTINES. SPECIFICALLY
; ANY ERRORS WHICH ARE THE RESULT OF MONITOR CALL (JSYS) ERRORS ARE
; HANDLED THROUGH THE JSYS ERROR MECHANISM (REFER TO ROUTINE JSYSER).
; CALL:
; JRST USER--
; RETURN:
; DOES NOT RETURN
; DESTROYS: T1
;
USER1: USERRM 1 ;RECEIVED DATA SHORTER THAN MESSAGE AREA
USER2: USERRM 2 ;RECEIVED DATA LONGER THAN MESSAGE AREA
USER3: USERRM 3 ;PARAMETER HAS ILLEGAL DATA TYPE
USER4: USERRM 4 ;NO MEMORY. VIRTUAL ADDRESS SPACE IS EXHAUSTED
USER5: USERRM 5 ;PROGRAM IDENTIFIER MUST BE AT LEAST ONE CHAR
USER6: USERRM 6 ;NO MORE INDEXES AVAILABLE TO ASSIGN TO PGMS
USER7: USERRM 7 ;ILLEGAL PROGRAM INDEX SPECIFIED BY CALLER
USER8: USERRM 8 ;NO INFORMATION AVAILABLE TO BE RECEIVED
USER9: USERRM 9 ;SENT INFORMATION HAS BEEN RETURNED
USER10: USERRM 10 ;RECEIVED INFORMATION INCORRECT FORMAT
;
; USER ERRORS 11 THROUGH 19 ARE IPCF MONITOR CALL ERRORS
;
USER17: USERRM 17 ;PROGRAM IDENTIFER DOES NOT BELONG TO THIS PGM
USER20: USERRM 20 ;INTERNAL RECEIVE QUEUE PAGE TABLE IS FULL
USER21: USERRM 21 ;WAITING TOO LONG FOR <SYSTEM>INFO
USER22: USERRM 22 ;ILLEGAL PARAMETERS PASSED TO IPWAIT
USER23: USERRM 23 ;NO IDENTIFIER FOR THIS PROGRAM CREATED
USER24: USERRM 24 ;A PROGRAM ID ALREADY EXISTS FOR THIS PROGRAM
ERRFTL=^D30 ;FATAL INTERNAL ERROR CODE. IF THE ERROR
; CODE FOR THE FATAL INTERNAL ERROR IS CHANGED,
; THIS VALUE MUST ALSO BE CHANGED.
USRFTL: USERRM 30 ;RETURN FATAL ERROR CODE TO COBOL
;
; INTERNAL ERRORS CLASS 2 - PRINT ERROR MESSAGE AND RETURN FATAL
; INTERNAL ERROR TO THE USER PROGRAM.
; CALL:
; JRST INER--
; RETURN:
; DOES NOT RETURN
; DESTROYS: T1
;
;
; THIS ERROR ROUTINE SHOULD ONLY BE CALLED FROM THE ROUTINE INITI.
; P1 CONTAINS THE ADDRESS IN THE PARAMETER LIST OF THE ERROR CODE ITEM.
;
INER1:
IFE FTIEMG,< ;PRINTING INTERNAL ERROR MESSAGES CONDITIONAL
CALL INERPR ;PRINT INTERNAL ERROR PROLOG
TMSG (<FATAL INITIALIZATION ERROR
>) ;FATAL INITIALIZATION ERROR
> ;END OF PRINTING INTERNAL ERROR MESSAGES CONDITIONAL
MOVEI T1,ERRFTL ;GET FATAL ERROR CODE
MOVEM T1,@(P1) ;PUT ERROR CODE WHERE USER CAN SEE IT
POP P,T3 ;RESTORE ALL THE THINGS INITI LEFT
POP P,T2 ; ON THE STACK
POP P,T1 ; ...
POP P,I ; ...
POP P,P1 ;THROW AWAY INTERNAL RETURN ADDRESS
POP P,P1 ;RESTORE SAVED VALUE OF P1
RET ;RETURN FATAL INTERNAL ERROR TO USER
;
; INER2 - JSYS ERROR IS FATAL INTERNAL ERROR
;
INER2:
IFE FTIEMG,<;PRINTING INTERNAL ERROR MESSAGES CONDITIONAL
CALL INERPR ;PRINT INTERNAL ERROR PROLOG
TMSG (<FATAL JSYS ERROR AT USER LOCATION >)
HRRZ T1,JSERPC(I) ;GET PC OF THE CALL
SUBI T1,2 ;GET ADDRESS OF THE JSYS
CALL PRTOCT ;PRINT AS OCTAL VALUE
TMSG (<
>) ;COMPLETE THE LINE AND BEGIN NEXT
MOVEI T1,.PRIOU ;ERROR MESSAGE TO PRIMARY OUTPUT
HRLOI T2,.FHSLF ;LAST ERROR FOR OUR PROCESS
SETZM T3 ;NO LIMIT ON MESSAGE LENGTH
ERSTR ;PRINT THE ERROR STRING FOR LAST ERROR
JRST INER7 ;FATAL, UNDEFINED ERROR NUMBER
JRST INER7 ;FATAL ERROR
TMSG (<
>) ;COMPLETE THE MESSAGE
> ;END OF PRINTING INTERNAL ERROR MESSAGE CONDITIONAL
JRST USRFTL ;RETURN FATAL ERROR TO USER
;
; INER3 - <SYSTEM>INFO ERROR IS FATAL INTERNAL ERROR
; CALL:
; JRST INER3
; T1 - CONTAINS <SYSTEM>INFO ERROR CODE
;
INER3:
IFE FTIEMG,<;PRINTING INTERNAL ERROR MESSAGES CONDITIONAL
PUSH P,T1 ;SAVE INFO ERROR CODE
CALL INERPR ;PRINT INTERNAL ERROR PROLOG
TMSG (<FATAL <SYSTEM>INFO ERROR CODE >)
POP P,T1 ;GET INFO ERROR CODE BACK
CALL PRTOCT ;PRINT AS OCTAL VALUE
TMSG (<
>) ;COMPLETE THE LINE AND BEGIN NEXT
> ;END OF PRINTING INTERNAL ERROR MESSAGE CONDITIONAL
JRST USRFTL ;RETURN FATAL ERROR TO USER
INER5: XCKERR (PGNFIP) ;NOT FIND IMPURE PAGE. PGFND COULD NOT FIND
; IMPURE PAGE NUMBER IN .JBCST
INER5A:
IFE FTIEMG,< ;PRINTING INTERNAL ERROR MESSAGES CONDITIONAL
CALL INERPR ;PRINT INTERNAL ERROR PROLOG
TMSG (<FATAL CROSS CHECK >)
CALL PRTSIX ;PRINT THE CROSS CHECK CODE
TMSG (<
>) ;INTERNAL CONSISTENANCY CHECK HAS FAILED
> ;END OF PRINTING INTERNAL ERROR MESSAGES CONDITIONAL
JRST USRFTL ;RETURN FATAL INTERNAL ERROR TO USER
INER6: XCKERR (QRYNPA) ;NO PID ASSIGNED. IPQRY WAS ASKED TO PERFORM
; A QUERY FOR OUR PID, BUT THIS PROCESS
; DOES NOT HAVE A PID ASSIGNED.
INER7: XCKERR (JSEDEP) ;ERROR DURING ERROR PROCESSING. A JSYS
; ERROR OCCURED IN THE JSYS ERROR
; PROCESSING ROUTINE.
INER8: XCKERR (JSNJEY) ;NO JSYS ERROR YET. THE JSYS ERROR
; PROCESSING ROUTINE WAS CALLED BUT NO
; JSYS ERROR HAD HAPPENED YET.
INER9: XCKERR (WTICDE) ;ILLEGAL CODE. INFWT HAS FOUND AN ILLEGAL
; WAKE-UP CODE RETURNED FROM MWAIT.
INER10: XCKERR (WTIPRM) ;ILLEGAL PARAMETER. INFWT HAS PASSED AN ILLEGAL
; PARAMETER OR COMBINATION OF PARAMETERS
; TO MWAIT.
INER11: XCKERR (IMPAIU) ;PAGE ALREADY IN USE. THE PAGE WHICH IMMUSE
; WAS TO MARK AS IN USE, WAS ALREADY IN USE.
INER12: XCKERR (IMPAF) ;PAGE ALREADY FREE. THE PAGE WHICH IMMFRE
; WAS TO MARK AS FREE WAS ALREADY FREE.
INER13: XCKERR (IMCNFP) ;COULD NOT FIND PAGE. IMFPG COULD NOT FIND
; THE PAGE NUMBER SPECIFIED. A PAGE NUMBER
; WHICH SHOULD EXIST IN THE IRQ PAGE
; TABLE DOES NOT.
INER14: XCKERR (IDXPIZ) ;PID IS ZERO. IDXASN WAS ASKED TO ASSIGN A
; PROGRAM INDEX TO A PID OF ZERO. THE PID
; VALUE ZERO IS RESERVED FOR <SYSTEM>INFO.
INER15: XCKERR (IDXIPI) ;ILLEGAL PROGRAM INDEX. ROUTINE IDXFPD OR
; IDXFRE HAVE BEEN PASSED AN INDEX VALUE WHICH
; IS OUT OF THE LEGAL RANGE FOR INDEX VALUES.
INER16: XCKERR (DCPBSD) ;BYTE SIZE DISCREPANCY. ROUTINE DTACPY DETECTED
; A DIFFERENCE IN THE BYTE SIZE OF THE SOURCE
; AND DESTINATION BYTE POINTERS PASSED TO IT.
INER17: XCKERR (WTNREF) ;NO RESUMPTION EVENT FOUND. THE
; MWAIT WAIT LOOP RETURNED BUT THE
; EVENT CHECKING ROUTINES COULD NOT
; DETERMINE THE EVENT WHICH CAUSED
; IT TO RETURN.
INER18: XCKERR (WTSINA) ;SOFTWARE INTERRUPT NOT AVAILABLE. THE
; SOFTWARE INTERRUPT SYSTEM HAS NOT BEEN
; INITIALIZED OR THE DESIRED CHANNELS ARE
; NOT AVAILABLE TO THE MWAIT ROUTINE.
INER20:
IFE FTIEMG,< ;PRINTING INTERNAL ERROR MESSAGES CONDITIONAL
CALL INERPR ;PRINT INTERNAL ERROR PROLOG
TMSG (<NO IPCF QUOTAS
>) ;IPCF SEND AND RECEIVE QUOTAS ARE ZERO
> ;END OF PRINTING INTERNAL ERROR MESSAGES CONDITIONAL
JRST USRFTL ;RETURN FATAL INTERNAL ERROR TO USER
;
; INERPR - PRINT PROLOG FOR FATAL INTERNAL ERROR MESSAGES
; CALL
; CALL INERPR
; RETURN:
; +1 - ALWAYS
; DESTROYS: T1.
;
INERPR: TMSG (<
?IPCIER >) ;INTERPROCESS COMMUNICATION ERROR
RET ;RETURN TO CALLER
SUBTTL CHECK NUMBER OF PARAMETERS PASSED
IFE FTPROD,<;IF NONPRODUCTION VERSION, CHECK NUMBER OF PARAMETERS PASSED
;
; CKPSZ - THIS ROUTINE CHECKS TO INSURE THAT THE CALLING ARGUMENT
; LIST CONTAINS AT LEAST THE NUMBER OF PARAMETERS REQUIRED BY THE
; CALLED ROUTINE.
; CALL:
; T1 - CONTAINS THE NUMBER OF PARAMETERS REQUIRED BY THE ROUTINE
; T2 - CONTAINS THE SIXBIT ROUTINE NAME WHICH HAS BEEN CALLED
; RETURN:
; +1 - IF THE ARGUMENT LIST CONTAINS AT LEAST THE NUMBER OF
; PARAMETERS REQUIRED
; ERROR - IF ANY ERRORS ARE DETECTED, AN ERROR MESSAGE IS PRINTED ON
; THE CONTROLLING TERMINAL AND THE PROGRAM WILL EXIT.
; DESTROYS: T1,T2,T3,T4.
;
CKPSZ: HLRE T3,-1(L) ;GET THE ARGUMENT LIST LENGTH AS A
MOVMS T3 ; POSITIVE FULLWORD VALUE
CAML T3,T1 ;ARE THERE ENOUGH PARAMETERS ?
RET ;YES. RETURN OK
TMSG (<
? >) ;NO. BEGIN FATAL ERROR WITH "?"
PUSH P,T3 ;SAVE ARG LIST LENGTH
CALL PRTSIX ;PRINT THE SIXBIT ROUTINE NAME
TMSG (< CALLED WITH ONLY >)
POP P,T1 ;GET NUMBER OF PASSED PARAMS BACK
CALL PRTDEC ;PRINT NUMBER OF PARAMS IN ARG LIST
TMSG (< PARAMETERS
>)
HALTF ;THIS ERROR IS REALLY FATAL-TERMINATE
JRST .-1 ;DON'T LET USER CONTINUE
> ;END OF NONPRODUCTION VERSION CONDITIONAL
SUBTTL PRINT THINGS ON THE TERMINAL
;
; PRTDEC - OUTPUT A BINARY VALUE TO THE TERMINAL AS DECIMAL
; PRTOCT - OUTPUT A BINARY VALUE TO THE TERMINAL AS OCTAL (BASE 8)
; CALL:
; CALL PRTDEC ;TO PRINT AS DECIMAL VALUE OR
; CALL PRTOCT ;TO PRINT AS OCTAL VALUE
; T1 - CONTAINS THE BINARY VALUE TO BE PRINTED
; RETURN:
; +1 - VALUE PRINTED SUCCESSFULLY
; ERROR - DOES NOT RETURN ON JSYS ERRORS
; DESTROYS: T1,T2,T3.
;
PRTDEC: SKIPA T3,[EXP ^D10] ;SET BASE TO DECIMAL
PRTOCT: MOVEI T3,^D8 ;SET BASE TO OCTAL (8)
MOVE T2,T1 ;POSITION VALUE FOR MONITOR CALL
MOVEI T1,.PRIOU ;DESTINATION DEVICE IS PRIMARY OUTPUT
NOUT ;PRINT THE VALUE WITH NO COLUMN LIMITS
HALT . ;ONLY WAY TO TELL USER SINCE CAN'T
; PRINT TO TERMINAL
RET ;SUCCESS RETURN TO CALLER
;
; PRTSIX - PRINT A SIXBIT STRING ON THE TERMINAL
; CALL:
; CALL PRTSIX
; T2 - CONTAINS THE SIXBIT STRING TO BE PRINTED
; RETURN:
; +1 - VALUE PRINTED SUCCESSFULLY
; ERROR - DOES NOT RETURN ON JSYS ERRORS
; DESTROYS: T1,T3,T4.
;
PRTSIX: MOVEI T4,6 ;MAX NO OF CHARS IN STRING
MOVE T3,[POINT 6,T2] ;BYTE POINTER TO STRING
PRTSX1: ILDB T1,T3 ;PRINT OUT THE STRING
CAIN T1,' ' ;STOP AT FIRST BLANK
RET ; ...
ADDI T1,40 ;MAKE CHAR ASCII
PBOUT ;PRINT ONE CHARACTER AT A TIME
;LET COMPATIBILITY PACKAGE HANDLE
; ERRORS, SINCE CAN'T PRINT TO TERMINAL
SOJG T4,PRTSX1 ;FOR ALL CHARS IN THE NAME
RET ;ALL PRINTED. RETURN TO CALLER
SUBTTL PROCESS TOPS-20 MONITOR CALL (JSYS) ERRORS
;
; JSYSER - PROCESS TOPS-20 MONITOR CALL ERRORS
; THIS ROUTINE PROCESSES ALL ERRORS WHICH ARE RETURNED BY
; TOPS-20 MONITOR CALLS (JSYS'S). ALL JSYS"S WHICH APPEAR
; IN THESE ROUTINES (EXCEPT THOSE GENERATED BY SYSTEM
; MACROS OR THOSE WHICH APPEAR IN ROUTINES CALLED BY THESE
; ROUTINES) ARE FOLLOWED BY A CALL TO THIS ROUTINE TO PROCESS
; ANY ERRORS WHICH MAY OCCUR.
; THIS ROUTINE DIVIDES ALL JSYS ERRORS INTO TWO CLASSES:
; THOSE THAT WILL RETURN A NON-FATAL ERROR CODE TO THE USER
; PROGRAM, AND THOSE THAT WILL RETURN A FATAL ERROR CODE TO
; THE USER PROGRAM. ANY JSYS ERROR WHICH FALLS INTO THE
; FIRST CLASS MUST HAVE AN ENTRY IN THE JSYS ERROR TABLE
; (JSERTB). ANY JSYS ERROR WHICH DOES NOT HAVE AN ENTRY IN
; THE TABLE FALLS INTO THE SECOND CLASS AND WILL BE PROCESSED
; ACCORDINGLY.
; AN ERROR RETURN FROM A JSYS IS PROCESSED AS FOLLOWS:
; 1. THIS ROUTINE IS CALLED BY A SIMULATED PUSHJ (ERCAL).
; 2. THE PC OF THE JSYS WHICH GENERATED THE ERROR IS SAVED.
; 3. THE TABLE WHICH DEFINES THE JSYS ERRORS WHICH RETURN
; NONFATAL USER ERROR CODES IS SEARCHED.
; 4. IF AN ENTRY IS FOUND IN THE TABLE, THE APPROPRIATE ERROR
; CODE IS RETURNED TO THE USER.
; 5. IF AN ENTRY IN NOT FOUND, A MESSAGE IS PRINTED INDICATING
; THE ERROR AND THE PROGRAM LOCATION AT WHICH IT OCCURED, AND
; A FATAL ERROR IS RETURNED TO THE USER PROGRAM.
; CALL:
; ERCAL JSYSER
; RETURN:
; NEVER RETURNS TO CALLER, BUT RETURNS ERROR CODE TO USER
; DESTROYS: T1,T2,T3.
;
JSYSER: POP P,JSERPC(I) ;SAVE CALLER'S PROGRAM COUNTER
MOVEI T1,.FHSLF ;GET LAST ERROR FOR THIS PROCESS
GETER ; FROM THE PROCESS STORAGE BLOCK
HRRZ T2,T2 ;ISOLATE LAST ERROR NUMBER
CAIN T2,LSTRX1 ;ANY ERRORS FOR THIS PROCESS YET?
JRST INER8 ;NONE. SHOULD NOT BE HERE
HRLZI T1,-JSERLT ;GET POINTER TO ERROR CODE TABLE
JSYER1: HLRZ T3,JSERTB(T1) ;GET JSYS ERROR CODE FROM TABLE
CAME T3,T2 ;THE ONE WE ARE LOOKING FOR ?
AOBJN T1,JSYER1 ;NO. LOOK AT THE NEXT ENTRY
JUMPGE T1,INER2 ;JUMP IF CAN'T FIND ENTRY IN TABLE
HRRZ T1,JSERTB(T1) ;GET CORRESPONDING USER ERROR CODE
JRST ERRRET ;AND RETURN TO USER
SUBTTL PURE DATA STORAGE
;
; THIS MACRO GENERATES AN ENTRY IN THE JSYS ERROR TABLE.
; EACH ENTRY IN THE TABLE IS ONE WORD LONG.
; ARGUMENTS:
; FIRST - THE JSYS ERROR CODE. DEFINES BITS 0-17 OF THE WORD.
; SECOND - THE CORRESPONDING USER ERROR CODE (DECIMAL). DEFINES BITS
; 18-35 OF THE WORD.
; SINCE IT DEFINES ONLY ONE ENTRY, THE MACRO MUST BE USED TO DEFINE
; EACH ENTRY IN THE TABLE.
; THE INTENDED USE OF THIS TABLE IS TO SEQUENTIALLY SEARCH IT FOR THE
; JSYS ERROR CODE AND EXTRACT THE CORRESPONDING ERROR CODE WHICH IS
; TO BE RETURNED TO THE USER.
;
DEFINE ERRENT (%%JS$,%%CDE$)
<XWD %%JS$,^D'%%CDE$>
; TABLE USED TO CONVERT A JSYS ERROR CODE INTO A USER ERROR CODE.
JSERTB: ERRENT (IPCFX2,08) ;NO MESSAGE FOR PID
ERRENT (IPCFX4,11) ;RECEIVER'S PID INVALID
ERRENT (IPCFX6,12) ;SEND QUOTA EXCEEDED FOR THIS JOB
ERRENT (IPCFX7,13) ;RECEIVER QUOTA EXCEEDED
ERRENT (IPCFX8,14) ;IPCF FREE SPACE EXHAUSTED
ERRENT (IPCF12,16) ;NO FREE PID'S AVAILABLE
ERRENT (IPCF13,15) ;PID QUOTA EXCEEDED FOR THIS JOB
ERRENT (FRKHX6,25) ;ALL RELATIVE PROCESS HANDLES IN USE
ERRENT (CFRKX3,25) ;INSUFFICIENT RESOURCES AVAILABLE
ERRENT (GJFX4,26) ;INVALID CHAR IN FILENAME
ERRENT (GJFX5,26) ;FIELD CANNOT BE LONGER THAN 39 CHAR
ERRENT (GJFX6,26) ;DEVICE FIELD NOT IN VALID POSITION
ERRENT (GJFX7,26) ;DIRECTORY FIELD NOT IN VALID POSITION
ERRENT (GJFX8,26) ;DIRECTORY TERMINATION DELIMETER NOT
; PRECEDED BY BEGINNING DELIMETER
ERRENT (GJFX9,26) ;MORE THAN ONE NAME FIELD NOT ALLOWED
ERRENT (GJFX10,26) ;GENERATION NUMBER IS NOT NUMERIC
ERRENT (GJFX11,26) ;MORE THAN ONE GENERATION NUMBER FIELD
ERRENT (GJFX12,26) ;MORE THAN ONE ACCOUNT FIELD
ERRENT (GJFX13,26) ;MORE THAN ONE PROTECTION FIELD
ERRENT (GJFX14,26) ;INVALID PROTECTION
ERRENT (GJFX16,27) ;NO SUCH DEVICE
ERRENT (GJFX17,27) ;NO SUCH DIRECTORY
ERRENT (GJFX18,27) ;NO SUCH FILENAME
ERRENT (GJFX19,27) ;NO SUCH FILE TYPE
ERRENT (GJFX20,27) ;NO SUCH GENERATION NUMBER
ERRENT (GJFX21,27) ;FILE WAS EXPUNGED
ERRENT (GJFX24,27) ;FILE NOT FOUND
ERRENT (GJFX28,28) ;DEVICE IS NOT ON-LINE
ERRENT (GJFX29,28) ;DEVICE NOT AVAILABLE TO THIS JOB
ERRENT (GJFX30,26) ;ACCOUNT IS NOT NUMERIC
ERRENT (GJFX31,26) ;INVALID WILD CARD DESIGNATOR
ERRENT (GJFX32,27) ;NO FILES MATCH THIS SPECIFICATION
ERRENT (GJFX33,26) ;FILENAME WAS NOT SPECIFIED
ERRENT (GJFX34,26) ;INVALID CHAR "?" IN FILE SPEC
ERRENT (GJFX35,28) ;DIRECTORY ACCESS PRIVILEGES REQUIRED
ERRENT (GJFX36,29) ;INTERNAL DIRECTORY FORMAT INVALID
ERRENT (GJFX38,27) ;FILE NOT FOUND - OUTPUT ONLY DEVICE
ERRENT (GJFX39,26) ;LOGICAL NAME LOOP DETECTED
ERRENT (GJFX40,26) ;UNDEFINED ATTRIBUTE IN FILE SPEC
ERRENT (GETX1,29) ;INVALID SAVE FILE FORMAT
ERRENT (OPNX2,27) ;FILE DOES NOT EXIST
ERRENT (OPNX3,28) ;READ ACCESS REQUIRED
ERRENT (OPNX7,28) ;DEVICE ASSIGNED TO ANOTHER JOB
ERRENT (OPNX8,28) ;DEVICE IS NOT ON-LINE
ERRENT (SFRVX1,29) ;INVALID POSITION IN ENTRY VECTOR
JSERLT=.-JSERTB ;LENGTH OF JSYS ERROR TABLE
; TABLE USED TO CONVERT A <SYSTEM>INFO ERROR CODE INTO A USER ERROR CODE
INFERT: ERRENT (72,16) ;<SYSTEM>INFO FREE SPACE EXHAUSTED
ERRENT (75,18) ;DUPLICATE NAME HAS BEEN SPECIFIED
ERRENT (76,17) ;UNKNOWN NAME HAS BEEN SPECIFIED
ERRENT (77,19) ;INVALID NAME (FORMAT) SPECIFIED
INFERL=.-INFERT ;LENGTH OF <SYSTEM>INFO ERROR TABLE
; ARGUMENT BLOCK FOR LONG FORM GTJFN
GTJFNB: GJ%OLD+GJ%ACC+0 ;NEW FILE,USE HIGHEST EXISTING GENERATION
.NULIO,,.NULIO ;NO INPUT OR OUTPUT JFN"S
0 ;DEFAULT DEVICE IS DSK
0 ;DEFAULT DIRECTORY IS CONNECTED DIRECTORY
0 ;NO DEFAULT FILENAME
POINT 7,[ASCIZ/EXE/] ;DEFAULT FILE TYPE IS EXE
0 ;PROTECTION AS SPECIFIED IN DIRECTORY
0 ;ACCOUNT AS SPECIFIED AT LOGIN
0 ;NO SPECIFIC JFN
XLIST ;PLACE LITERALS HERE
LIT
LIST
IFE FTPROD,<;;ADD SOME PATCH SPACE TO NON-PRODUCTION VERSIONS
PATCH: BLOCK 10
>;;END OF NON-PRODUCTION VERSION CONDITIONAL
SUBTTL IMPURE DATA AREA DEFINITION
;
; THE FOLLOWING DEFINITIONS DEFINE THE FORMAT OF THE IMPURE DATA
; AREA FOR THESE ROUTINES. THE IMPURE AREA IS ONE PAGE WHICH IS
; DYNAMICALLY ALLOCATED AT PROGRAM STARTUP. THIS METHOD OF
; HANDLING WRITTEN INTO LOCATIONS MAKES THESE ROUTINES COMPLETELY
; REENTRANT. THIS FURTHER IMPLIES THAT THEY MAY EASILY BE INCLUDED
; IN A SHARABLE OBJECT TIME SYSTEM SUCH AS LIBOL.
;
; ALL OF THE ENTRIES IN THE IMPURE DATA STORAGE AREA ARE DEFINED
; AS OFFSETS FROM THE BEGINNING OF THE IMPURE DATA STORAGE PAGE.
; THEREFORE ALL REFERENCES TO THE IMPURE STORAGE AREA MUST BE
; INDEXED BY THE IMPURE STORAGE AREA BASE REGISTER (REGISTER I).
;
; THE FOLLOWING MACRO DEFINES AN ENTRY IN THE IMPURE STORAGE AREA.
; ARGUMENTS:
; FIRST - THE SYMBOLIC NAME BY WHICH THE LOCATION(S) WILL BE
; REFERENCED
; SECOND - THE LENGTH OF THE DATA AREA IN WORDS. THE DEFAULT
; LENGTH IS ONE (1) WORD.
;
DEFINE IMPURE (%%NAM$,%%LTH$<1>)
< %%NAM$=%%CNT$ ;;ASSIGN THE OFFSET TO THE SYMBOL
%%CNT$=%%CNT$+%%LTH$ ;;INCREMENT OFFSET PAST ASSIGNED LOCS
> ;END OF IMPURE MACRO DEFINITION
; THE CODE IN THE FIRST PART OF THE COMMENT FIELD INDICATES:
; G - GLOBAL, THE AREA IS USED BY MORE THAN ONE ROUTINE
; ROUTINE NAME - THE AREA IS USED BY T