ASMB,R,Q,C
      HED PTOPM 91750-16151 * (C) HEWLETT-PACKARD CO. 
      NAM PTOPM,19,30 91750-16151 REV.2013 800821 ALL 
      SPC 1 
******************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  ALL RIGHTS     *
*  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
******************************************************************
      SPC 2 
      EXT EXEC,CLRQ,#OFF,#LOGR,#GETR
      EXT #SLAV,#RQUE,#PLOG,PGMAD,#NODE 
      EXT #RPB,#SCSM,#ATCH,DTACH
RQB   EQU #RPB
      SPC 3 
* 
* NAME:  PTOPM
* SOURCE:91750-18151
* RELOC: 91750-16151
* PGMR:  CHUCK WHELAN 
* DATE:  DEC 1976 
* 
* MODIFICATIONS:
*  BY GAB [790206] TO REPLACE EXTENDED INSTR'S W/ JSB'S 
*  BY JDH [790220] FOR DS REQUEST EQUATED OFFSETS.
*  BY DWT [790416] FOR PHASE ONE (NEW MESSAGE HEADER).
*  BY DWT [790531] FOR PHASE FOUR (RELOCATION OF RQB).
*  BY DWT [790608] FOR PHASE FIVE (REMOVE O/S DEPENDENCE).
*  BY JDH [791010] FOR SESSION MONITOR PRE- & POST-PROCESSING.
*  BY DMT [800812] TO FIX "SLAVE OFF" BUG.
*  BY DMT [800821] SO SLAVE IS ATTACHED TO SESSION WHEN CLONED AND
*                  FINIS DOES NOT ABORT SLAVE PROGRAM.
      SPC 3 
*  THIS IS THE DS/1000-IV VERSION OF PTOPM
* 
*  IT RECEIVES NEW REQUESTS FOR THE FOLLOWING P-TO-P FUNCTION CODES:
*     1 = POPEN 
*     2 = PREAD 
*     3 = PWRIT 
*     4 = PCONT 
*     5 = PCLOS (BIT 7= 1 IF GENERATED BY LOCAL "FINIS")
*     6 = SLAVE OFF 
*     7 = SLAVE LIST
* 
*  PTOPM MAINTAINS PARALLEL TABLES OF OPEN SLAVE PROGRAM ID SEGMENT 
*  ADDRESSES AND THEIR CORRESPONDING CLASS NUMBERS.  THESE TABLES 
*  ARE USED TO DETERMINE THE CLASS NUMBER FOR RETHREADING THE 
*  CLASS BUFFER ON "POPEN","PREAD","PWRIT", AND "PCONT" REQUESTS. 
*  "PCLOS", "SLAVE OFF" AND "SLAVE LIST" REQUESTS ARE HANDLED WITHIN
*  PTOPM WHICH DOES THE NECESSARY PROCESSING AND SENDS THE REPLY VIA
*  "#SLAV" (EXCEPT FOR LOCAL "FINIS" REQUESTS WHICH HAVE NO REPLY). 
      SKP 
* GLBLK-START 
* 
******************************************************************
*                                                                *
*     G L O B A L   B L O C K               REV 2013 791213      *
*                                                                *
*     GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY:      *
*                                                                *
*         REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST        *
*         GET,   #SLAV, RQCNV, RPCNV, GRPM,  DINIT, PTOPM        *
*         EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3        *
*         DSTIO, LUMAP, #CMGT, INCNV, OTCNV, RMTIO               *
*         RSM,   DLGON, #DISM, #DSSM, #MSSM, #SCSM, #UPSM        *
******************************************************************
* 
***!!!!! THE ORDER OF THE FIRST 8 WORDS (#STR THRU #LVL) IS      *
***!!!!!     FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES *
***!!!!!     ERROR CODES & LEVEL # ALWAYS BE IN THE SAME PLACE,  *
***!!!!!     REGARDLESS OF MESSAGE FORMAT.  THIS ALSO MAKES      *
***!!!!!     STORE-AND-FORWARD CODE MUCH SIMPLER.                *
#STR  EQU 0         STREAM WORD.
#SEQ  EQU #STR+1    SEQUENCE NUMBER.
#SRC  EQU #SEQ+1    SOURCE NODE #.
#DST  EQU #SRC+1    DEST. NODE #. 
#EC1  EQU #DST+1    REPLY ECOD1.
#EC2  EQU #EC1+1    REPLY ECOD2.
#ENO  EQU #EC2+1    NUMBER OF NODE REPORTING ERROR. 
#ECQ  EQU #ENO+1    ERROR CODE QUALIFIER (BITS 4 TO 7)
#LVL  EQU #ECQ      MESSAGE FORMAT LEVEL (BITS 0 TO 3)
* 
#MAS  EQU #LVL+1    MA "SEND" SEQ. #
#MAR  EQU #MAS+1    MA "RECV" SEQ. #
#MAC  EQU #MAR+1    MA "CANCEL" FLAGS 
#HCT  EQU #MAC+1    HOP COUNT 
#SID  EQU #HCT+1    SESSION ID WORD 
* 
#EHD  EQU #SID      LAST ITEM OF HEADER 
#MHD  EQU #EHD+1    MINIMUM HEADER SIZE 
#REQ  EQU #MHD      START OF REQUEST SPECIFIC AREA
#REP  EQU #MHD      START OF REPLY SPECIFIC AREA
* 
#MXR  EQU #MHD+24   <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>>
#LSZ  EQU 2         <<< SIZE OF LOCAL APPENDAGE AREA >>>
* 
******************************************************************
* 
* GLBLK-END 
      SKP 
* PPBLK-START 
* 
******************************************************************
*                                                                *
*      P T O P   B L O C K                 REV 2013 791119       *
*                                                                *
*      OFFSETS INTO DS/1000 PTOP MESSAGE BUFFERS, USED BY:       *
*                                                                *
*   POPEN, PTOPM, GET/ACEPT/REJCT, RQCNV, RPCNV, DINIT, REMAT    *
*   #SCSM                                                        *
******************************************************************
* 
* OFFSETS INTO PTOP REQUEST AND REPLY BUFFERS.
* 
#FCD  EQU #REP      FUNCTION CODE.
#PCB  EQU #FCD+1    PCB AREA (3 WORDS). 
#TAG  EQU #PCB+3    TAG AREA (20 WORDS).
* 
* MAXIMUM SIZE OF PTOP REQUEST/REPLY BUFFER.
* 
#PLW  EQU #MXR      M A X I M U M   S I Z E    ! ! !
* 
* PPBLK-END 
      SKP 
PTOPM LDA 1,I       IS P1=I/O CLASS 
      STA CLASS     PTOPM CLASS 
      ALR,RAR       CLEAR SAVE BUFFER BIT 
      STA CLAS2      FOR "CLSAM" ROUTINE
* 
* ISSUE GET ON I/O CLASS
* 
GET   JSB DTACH     DETACH FROM POSSIBLE
      DEF *+1         SESSION CONTROL BLOCK.
* 
      JSB #GETR 
      DEF *+4 
      DEF CLASS 
      DEF RQB 
      DEF C#PLW 
      JMP EROUT     IRRECOVERABLE ERROR 
      STA RQLEN     SAVE REQUEST LENGTH 
* 
      LDA C#FCD 
      CMA,INA 
      ADA RQLEN 
      SSA           REQ LENGTH >= MINIMUM?
      JMP EROUT     NO, ERROR 
      LDA C#PLW 
      INA 
      CMA,INA 
      ADA RQLEN 
      SSA,RSS       REQ LENGTH < MAXIMUM? 
      JMP EROUT     NO ,ERROR 
* 
      CLA 
      STA RQB+#EC2  INITIALIZE ERROR
      STA RQB+#ENO      FIELDS
      LDA RQB+#PCB
      STA IDSEG     SAVE POSSIBLE ID SEG ADDR 
      LDA RQB+#FCD
      AND K7        ISOLATE FUNCTION CODE 
      ADA CODEA     ADD ADDRESS OF PROCESS TABLES 
      JMP 0,I       AND GO DO IT
      SPC 3 
EROUT JSB CLSAM     IRRECOVERABLE ERROR, CLEAR SAM
      JMP GET         & GO BACK TO "GET"
* 
      SKP 
* 
OPENP EQU *         PROCESS "POPEN" 
* 
      LDA RQB+#SID  GET SESSION ID WORD FROM REQ. 
      AND B377      ISOLATE DEST. SESSION ID (BITS 0-7).
      STA TEMP      SAVE SESSION ID FOR CALL. 
* 
      JSB #ATCH     ATTACH TO THE SESSION CONTROL BLOCK.
      DEF *+2 
      DEF TEMP
* 
      CPA N1
      JMP RS01      ERROR: SCB NOT FOUND. 
* 
      CLA           PERFORM SESSION-MONITOR PREPROCESSING 
      JSB #SCSM       WHETHER S.M. NODE OR NOT. 
      JMP ER41      COULD NOT PERFORM REQUESTED CLONING.
* 
      JSB PGMAD     CONVERT PGM NAME TO ID SEG ADDR 
      DEF *+2 
      DEF RQB+#PCB
      SZA,RSS       WAS ID SEGMENT FOUND? 
      JMP ER41      NO
      STA IDSEG     SAVE ID SEGMENT ADDRESS 
      CCA           SET FLAG TO SAY WE WILL ALLOW PROGRAM 
      STA CLSAM       TO BE DORMANT 
* 
      JSB SERCH     THIS PGM ALREADY OPEN?
      JMP SCD1      YES, BE SURE SLAVE PROGRAM IS ALIVE.
* 
      SEZ,RSS       IS TABLE FULL?
      JMP ER42      YES, ERROR
* 
      LDB FSTAD     1ST AVAILABLE ENTRY ADDR
      STB SEGAD 
      LDA IDSEG 
      STA 1,I       SET THIS ID SEG ADDR INTO SLAVE LIST
      ADB NTOTL 
      STB CLSAD     ADDR FOR CLASS #
* 
      CLA           CLEAR CLASS WORD
      STA CLSAD,I   TO SET UP CALL
* 
      JSB CLRQ      CALL TO OBTAIN A NEW CLASS WORD 
      DEF *+4 
      DEF FUNC1     GET CLASS W/ NW, NA 
      DEF CLSAD,I   RETURNED CLASS WORD 
      DEF K0        ASSIGN NO CLASS OWNERSHIP 
      JMP ERMS      ERROR EXIT
      SZA           HOW WAS THE ALLOCATION ?
      JMP ERMS      BAD, ERROR EXIT 
      STA CLSAM     SET FLAG TO SAY PROGRAM MUST NOT BE DORMANT.
      LDA CLSAD,I 
      IOR BIT13     SET SAVE CLASS NUMBER BIT 
      STA CLSAD,I 
* 
*  SCHEDULE THE PROGRAM 
* 
SCD1  JSB EXEC
      DEF *+4       SCHEDULE REQUESTED PROGRAM
      DEF K10N       WITHOUT WAIT & PASS IT 
      DEF RQB+#PCB    IT'S I/O CLASS AS PARAMETER 
      DEF CLSAD,I      P1 
      JMP BADPG     ERROR RETURN-RTE TRIED TO ABORT US
* 
      SZA,RSS       WAS PROGRAM DORMANT?
      JMP REQU#     YES, IT'S OK. 
      LDA CLSAM     NO, IT WASN'T.  WAS THIS A NEW ENTRY TO OUT 
      SZA,RSS         TABLES? 
      JMP BADOP     YES, SO WE EXPECT PROGRAM TO BE DORMANT.
* 
*  POPEN IS OK, RETHREAD CLASS BUFFER TO SLAVE PROGRAM
* 
REQU# JSB #RQUE     RETHREADING SUBROUTINE
      DEF *+9 
      DEF K20N
      DEF B10K      ICNWD W/ Z BIT SET
      DEF K0
      DEF K0
      DEF K0
      DEF K0
CLSAD NOP           SLAVE PGM'S CLASS (TO)
      DEF CLASS     PTOPM CLASS (FROM)
      RSS           ERROR RETURN
      JMP GET       NORMAL RETURN 
* 
      CPA =ADS
      RSS 
      JMP ER48      GIVE -48 ERROR FOR ALL OTHERS 
      CPB =A08
      JMP ER58      GIVE -58 FOR DS08 
      JMP ER48      GIVE -48 FOR OTHERS 
* 
BADPG JSB FINIS     DEALLOCATE CLASS & CLEAR ENTRY
      JMP ER41      GIVE ERROR -41
* 
BADOP JSB FINIS     DEALLOCATE CLASS & CLEAR ENTRY
      JMP ER44      GIVE ERROR -44
* 
RS01  JSB FINIS     DEALLOCATE CLASS & CLEAR ENTRY. 
      DLD "RS01     GIVE ERROR "RS01".
      DST RQB+#EC1
      LDA #NODE 
      IOR BIT15 
      JMP ERRLN 
      SKP 
* 
*  ENTER HERE ON PREAD, PWRIT, OR PCONT 
* 
READP JSB SERCH     SEARCH FOR ENTRY
      RSS 
      JMP ER44      NOT FOUND, ERROR
* 
      LDA CLSAD,I   CLASS # FROM TABLE
      CPA RQB+#PCB+1  DOES IT MATCH CLASS IN PCB? 
      RSS           YES, CONTINUE 
      JMP ER103     NO, ERROR 
      SPC 2 
*                   CHECK THAT SLAVE PROGRAM IS "ALIVE" 
      LDB SEGAD,I   GET PROGRAM'S ID SEGMENT ADDRESS
      CMB,INB       MAKE IT NEGATIVE
      STB IDAD      SAVE IT TO CALL PGMAD 
      JSB PGMAD 
       DEF *+3
       DEF NAME     DUMMY NAME ARRAY
       DEF IDAD     - ID ADR
      SZB           DORMANT?
      JMP REQU#     NO, RE-THREAD ON CLASS NUMBER 
*     SLAVE PROGRAM IS DORMANT.  CLEAR OUT CLASS BUFFER 
      JSB FINIS     CLEAR OUT CLASS BUFFER
      LDB M45       ERROR -45: SLAVE PROGRAM IS DORMANT 
      JMP ERR 
* 
      SKP 
* 
*  PROCESS "SL" REQUESTS FROM REMAT 
* 
SLIST JSB CLSAM     CLEAR THE CLASS BUFFER
      CLA 
      STA NAMBF     INITIALIZE COUNT OF OPEN PGMS 
      LDA NTOTL     COUNTER 
      STA SLTMP 
      LDB NAMAD     POINTER FOR STORING PGM NAMES 
* 
SL10  STB OUTAD     SAVE B REG AS THE OUTPUT BUFFER ADDR
      LDA SLTMP     GET NEXT SLAVE ID SEG ADDR
      ADA @P#EN 
      LDA 0,I 
      SZA,RSS       IS THIS ENTRY FULL? 
      JMP SL20      NO
      ISZ NAMBF     BUMP COUNT OF SLAVE PGMS
      CMA,INA       MAKE ID SEG ADDR NEGATIVE 
      STA IDAD      SAVE IT TO CALL PGMAD 
      JSB PGMAD     FIND PGM NAME W/ -IDAD
       DEF *+3
OUTAD  NOP          RETURN PGM NAME 
       DEF IDAD 
      LDB OUTAD 
      ADB K3
SL20  ISZ SLTMP     ALL ENTRIES EXAMINED? 
      JMP SL10      NO
* 
      LDA NAMLN 
      JMP REPLY+1   WRITE SLAVE LIST WITH REPLY 
* 
SLTMP NOP 
@P#EN DEF P#END 
      SKP 
* 
*  HANDLE SLAVE OFF REQUESTS HERE 
SOFF  LDA RQB+#PCB  NAME OF PROG TO CLEAR 
      SZA           CLEAR ALL REQUEST?
      JMP FINIT     NO
* 
      JSB CLSAM     CLEAR CLASS BUFFER
      LDA NTOTL 
      STA CNTR      INITIALIZE SLAVE LIST COUNT 
      LDB A#IDS     POINT TO ID SEG ADDR LIST 
CL10  LDA 1,I       GET NEXT ENTRY
      SZA,RSS       THIS SLOT FULL? 
      JMP CL20      NO
      STB SEGAD     SAVE ADDR OF ID SEG ADDR
      ADB NTOTL 
      STB CLSAD     SAVE ADDR OF CLASS #
* 
      JSB FINIS     GO CLEAN OUT THIS ONE 
      LDB SEGAD 
* 
CL20  INB           BUMP LIST POINTER 
      ISZ CNTR      MORE? 
      JMP CL10      YES 
      JMP FINEX     NO, DONE
      SPC 2 
* 
FINIT JSB PGMAD     CONVERT NAME TO ID SEG ADDR 
      DEF *+2 
      DEF RQB+#PCB
      SZA,RSS       IF NOT IN SYSTEM, 
      JMP ER41        REPORT ERROR. 
      STA IDSEG     SAVE ID SEGMENT ADDRESS 
* 
*  ENTER HERE ON "PCLOS" OR "FINIS" REQUESTS
* 
CLOSP JSB CLSAM     CLEAR CLASS BUFFER
      JSB SERCH     IS PROGRAM IN CURRENT LIST? 
      JSB FINIS     YES, CLEAN OUT ENTRY IN CURRENT LIST
      LDA RQB+#FCD
      ALF,ALF       TEST BIT 7 OF FUNCTION CODE 
      SSA           IS THIS A "FINIS" REQUEST?
      JMP GET       YES, NO REPLY REQUIRED
* 
FINEX CLB 
      STB RQB+#EC2  NO ERROR CODE 
      JMP REPLY     SEND REPLY
* 
      SKP 
*  CLEAR ENTRY OUT OF CURRENT LIST, AND ABORT PROGRAM IF IT'S HANGING 
*  ON THE CLASS SO THE CLASS NUMBER CAN BE DEALLOCATED. 
* 
FINIS NOP 
* 
*  GET NAME OF PROGRAM
* 
      LDA SEGAD,I 
      CMA,INA       MAKE ID SEG ADDR NEGATIVE 
      STA IDAD      SAVE IT TO CALL PGMAD 
      JSB PGMAD     CALL TO FIND PROGRAM NAME 
      DEF *+3 
NAMA  DEF NAME
      DEF IDAD
* 
*  FOR "SLAVE OFF" AND "PCLOSE," ABORT THE SLAVE
* 
      LDA RQB+#FCD  IF "FINIS"
      ALF,ALF        REQUEST, 
      SSA                         
      JMP SM           KEEP SLAVE ALIVE.
* 
      JSB #OFF      TURN OFF SLAVE. 
      DEF *+2        ["EXEC(6,PROG)" FOR M/E/F, 
      DEF NAME         "OF,PROG,FL" FOR L.] 
* 
SM    LDA NAMA      PERFORM SESSION-MONITOR POSTPROCESSING
      JSB #SCSM       WHETHER S.M. NODE OR NOT. 
* 
*  FLUSH REQS & DEALOCATE CLASS # AS WELL 
* 
      JSB CLRQ
      DEF *+3 
      DEF FUNC2 
      DEF CLSAD,I 
      NOP           IGNORE ERROR
* 
      CLB 
      STB SEGAD,I   CLEAR ENTRY IN PTOPM'S LIST 
      JMP FINIS,I    & EXIT 
* 
      SKP 
* PROCESS ERRORS AND ABNORMAL CONDITIONS HERE 
* THE B REGISTER CONTAINS THE DETECTED ERROR CODE 
* RECOGNIZED ERROR CONDITIONS 
*   -41  NON-EXISTENT SLAVE PROGRAM 
*   -42  CURRENT LIST FULL-NO ROOM-RETRY
*   -44  PROGRAM NOT OPEN IN PTOPM'S TABLE
*   -45  PROGRAM IS DORMANT (PWRIT, PREAD, PCONT ONLY)
*   -48  ABORTIVE COMMUNICATIONS ERROR
*   -58  SLAVE PROGRAM IS NON-DORMANT, BUT MAXIMUM QUEUE DEPTH
*        EXCEEDED (SLAVE PROGRAM IS LAGGING BEHIND).
*   -103 BAD PCB OR BAD FUNCTION CODE 
* 
ER41  LDB M41 
      JMP ERR 
* 
ERMS  CLA 
      STA SEGAD,I   CLEAR ENTRY IN CURRENT LIST 
* 
ER42  LDB M42 
      JMP ERR 
* 
ER44  LDB M44 
      JMP ERR 
* 
ER48  LDB M48 
      JMP ERR 
ER58  LDB M58 
      JMP ERR 
* 
ER103 LDB M103      ILLEGAL PCB 
ERR   STB RQB+#EC2  STORE ERROR WORD
      LDA #NODE 
ERRLN STA RQB+#ENO  PASS LOCAL NODE 
* 
      JSB CLSAM     CLEAR THE CLASS BUFFER
* 
REPLY CLA 
      STA CNTR      SET LENGTH OF DATA
* 
      JSB #SLAV     SEND THE REPLY
      DEF *+4 
      DEF RQLEN     REQUEST LENGTH
      DEF NAMBF 
      DEF CNTR      ZERO UNLESS "SL"
      NOP 
      JMP GET 
      SKP 
* 
*  THIS SUBROUTINE SEARCHES FOR AN ENTRY IN THE SLAVE PGM LIST
* 
SERCH NOP 
      LDB A#IDS     POINTER TO ID SEG ADDRS 
      LDA NTOTL 
      STA CNTR      COUNTER 
      CLE           E SET TO 1 WHEN FREE SLOT FOUND 
SNXT  LDA 1,I       GET NEXT ID SEG ADDR
      CPA IDSEG     EQUAL TO ONE WE'RE LOOKING FOR? 
      JMP GOTIT     YES!
      SZA,RSS       THIS SLOT FREE? 
      SEZ,CCE       YES, SKIP IF 1ST FREE SLOT
      RSS 
      STB FSTAD     SAVE ADDR OF 1ST FREE SLOT
      INB 
      ISZ CNTR      MORE? 
      JMP SNXT      YES 
      ISZ SERCH     REQUESTED ID SEG NOT FOUND
      JMP SERCH,I   RETURN
* 
GOTIT STB SEGAD     SAVE ADDR OF ID SEG ENTRY 
      ADB NTOTL 
      STB CLSAD     SAVE ADDR OF ITS CLASS #
      JMP SERCH,I   RETURN
      SKP 
* 
*  CLEAR PTOPM'S CLASS BUFFER OR RETHREAD TO PLOG 
* 
CLSAM NOP 
      LDA #PLOG 
      SZA,RSS       LOGGING?
      JMP CLAR      NO, GO TO CLEAR BUFFER
      LDB CLASS 
      JSB #LOGR     YES, GO TO LOG THE BUFFER 
       JMP CLAR     LOG ERR, CLEAR BUFFER 
      JMP CLSEX     NORMAL RETURN 
* 
CLAR  EQU * 
      JSB EXEC      CLASS GET (ZERO LENGTH) 
      DEF *+5 
      DEF K21 
      DEF CLAS2 
      DEF DUMMY 
      DEF K0
* 
CLSEX LDA RQB+#STR
      IOR BIT14     SET REPLY FLAG IN REQUEST 
      STA RQB+#STR
      JMP CLSAM,I   RETURN
* 
*  DATA AREA
* 
IDAD  NOP 
CNTR  NOP 
RQLEN NOP 
IDSEG NOP 
SEGAD NOP 
FSTAD NOP 
CLASS NOP 
CLAS2 NOP 
TEMP  NOP 
"RS01 ASC 2,RS01
K0    DEC 0 
K3    DEC 3 
K7    DEC 7 
K21   DEC 21
K10N  DEF 10,I
K20N  DEF 20,I
CODEA DEF CODES,I 
CODES DEF ER103     CODE 0: ERROR 
      DEF OPENP     CODE 1: POPEN 
      DEF READP     CODE 2: PWRIT 
      DEF READP     CODE 3: PREAD 
      DEF READP     CODE 4: PCONT 
      DEF CLOSP     CODE 5: PCLOS AND FINIS 
      DEF SOFF      CODE 6: SLAVE OFF 
      DEF SLIST     CODE 7: SLAVE LIST
B377  OCT 377 
BIT13 OCT 020000    BIT13 
B10K  OCT 010000
BIT14 OCT 040000
BIT15 OCT 100000
FUNC1 OCT 140001    NO WAIT, NO ABORT, GET CLASS #
FUNC2 OCT 140002    NO WAIT, NO ABORT, DEALOCATE CLASS #
N1    DEC -1
N25   DEC -25 
M41   DEC -41 
M42   DEC -42 
M44   DEC -44 
M45   DEC -45 
M48   DEC -48 
M58   DEC -58 
M103  DEC -103
DUMMY NOP 
NAMAD DEF NAMBF+1 
NAMLN ABS NENT+NENT+NENT+1 SIZE OF "SL" BUFR
* 
*  DEFINE P TO P REQUEST BUFFER 
* 
C#FCD ABS #FCD
C#PLW ABS #PLW
A     EQU 0 
B     EQU 1 
* 
NAME  BSS 3 
* 
*  DEFINE SLAVE PGM LIST & VARIABLES
* 
NENT  EQU 20        SET # OF ENTRIES
A#IDS DEF P#IDS     POINT TO ID SEG ADDRS 
NTOTL ABS -NENT     -# OF ENTRIES 
      SPC 1 
* 
*  SLAVE LIST TABLE: 2 ARRAYS OF "NENT" WORDS. 1ST ARRAY CONTAINS 
*  I/O CLASS NUMBERS, 2ND CONTAINS ID SEGMENT ADDRESSES.
* 
P#CLS BSS NENT+NENT DEFINE THE SLAVE LIST TABLE 
P#IDS EQU P#CLS+NENT
P#END EQU P#IDS+NENT
      SPC 1 
      SUP 
      ORG P#CLS 
      REP NENT+NENT INITIALIZE TABLE TO ZEROES
      NOP 
      UNS 
* 
NAMBF BSS NENT+NENT+NENT+1 BUFFER FOR "SL"
* 
      BSS 0         SIZE OF PTOPM.
* 
      END PTOPM 
                                                                                                                                                                        