ASMB,R,L,C
      HED PTOPM 91740-16007 REV 1913 * (C) HEWLETT-PACKARD CO. 1979 
      NAM PTOPM,19,30 91740-16007 REV 1913 781130 
      SPC 1 
******************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  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 
      ENT PTOPM 
      EXT EXEC,$OPSY
      EXT D65SV,#REQU,#PLOG,PGMAD,#NODE 
      SPC 3 
* 
* PTOPM 
* SOURCE:91740-18007
* BINARY:91740-16007
* PGMR:  CHUCK WHELAN 
* DATE:  DEC 1976 
* 
* MODIFIED BY: LYLE WEIMAN, AUG '78 
      SPC 3 
*  THIS IS THE DS/1000 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
*  "D65SV" (EXCEPT FOR LOCAL "FINIS" REQUESTS WHICH HAVE NO REPLY). 
* 
      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
      CLB 
      LDA $OPSY 
      RAR,SLA       SKIP IF NON-DMS 
      STB MOD1      SET FOR DMS 
* 
* ISSUE GET ON I/O CLASS
GET   JSB EXEC      GET REQUEST 
      DEF *+7 
      DEF K21N
      DEF CLASS 
      DEF IRBUF 
      DEF K0
      DEF BFADR     ADDR OF REQUEST IN SAM
      DEF RQLEN     RCVD REQUEST LENGTH 
      NOP 
* 
      LDA RQLEN 
      ADA N7
      SSA           REQ LENGTH >= 7?
      JMP EROUT     NO, ERROR 
      ADA N25 
      SSA,RSS       REQ LENGTH < 32?
      JMP EROUT     NO ,ERROR 
* 
      LDA BFADR 
      LDB RQADR     SET TO MOVE REQUEST TO INTERNAL BUFFER
MOD1  JMP RQLOC     NOP HERE IF DMS 
      LDX RQLEN 
      MWF           MOVE REQUEST FROM SYSTEM MAP
      JMP *+4 
* 
RQLOC MVW RQLEN     MOVE REQUEST
* 
      CLA 
      STA $ERR+1    INITIALIZE ERROR
      STA $ENOD         FIELDS
      LDA $PCB
      STA IDSEG     SAVE POSSIBLE ID SEG ADDR 
      LDA $FUNC 
      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 
* 
*  PROCESS "POPEN"
OPENP JSB PGMAD     CONVERT PGM NAME TO ID SEG ADDR 
      DEF *+2 
      DEF $NAME 
      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 #
* 
      LDA BIT13     GET "NEW CLASS" CLASS WORD
      STA CLSAD,I   TO SET UP CALL
* 
      JSB EXEC      GET THE I O CLASS NUMBER
      DEF *+8       BY GETTING AN I-O CLASS 
      DEF K20 
      DEF K0
      DEF IRBUF 
      DEF K1
      DEF K1
      DEF K1
      DEF CLSAD,I 
      SZA           HOW WAS THE ALLOCATION ?
      JMP ERMS      BAD, ERROR EXIT 
      STA CLSAM     SET FLAG TO SAY PROGRAM MUST NOT BE DORMANT.
* CLEAR REQUEST 
      LDA CLSAD,I 
      STA *+2 
      JSB DOGET     THE PREVIOUS WRITE READ LEFT
      NOP           A DUMMY REQUEST IN THE CLASS, CLR IT. 
K0    NOP           IGNORE ABORT CONDITION
* 
SCD1  EQU *         SCHEDULE THE PROGRAM
* 
      JSB EXEC
      DEF *+4       SCHEDULE REQUESTED PROGRAM
      DEF K10N       WITHOUT WAIT & PASS IT 
      DEF $NAME       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 #REQU     RETHREADING SUBROUTINE
      DEF *+3 
      DEF CLASS     PTOPM CLASS 
CLSAD NOP           SLAVE PGM'S CLASS 
* 
      SSA,RSS       ANY RETHREADING ERRORS
      JMP GET       NO, BACK TO GET 
      CPA N10       MAXIMUM QUEUE SIZE EXCEEDED?
      JMP ER58      YES, RETURN -58 ERROR 
      JMP ER48      GIVE -48 ERROR FOR ALL 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
      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 $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
      ADB K15       ADVANCE TO STATUS 
      LDA B,I 
      AND B17         ISOLATE STATUS
      SZA           DORMANT?
      JMP REQU#     NO, RE-THREAD ON CLASS NUMBER 
      ADB K2        ADVANCE TO TIME-LIST WORD 
      LDA B,I       LOAD ID SEGMENT WORD 18 
      ALF           ROTATE TO LSB 
      SLA           IN TIME LIST? 
      JMP REQU#     YES, WE'LL ASSUME IT'LL COME OUT IN TIME. 
*     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 
      LDX NTOTL     COUNTER 
      LDB NAMAD     POINTER FOR STORING PGM NAMES 
* 
SL10  LAX P#END     GET NEXT SLAVE ID SEG ADDR
      SZA,RSS       IS THIS ENTRY FULL? 
      JMP SL20      NO
      ISZ NAMBF     BUMP COUNT OF SLAVE PGMS
      ADA K12       POINT TO NAME IN ID SEG 
      MVW K3        MOVE NAME INTO OUTPUT BUFFER
SL20  ISX           ALL ENTRIES EXAMINED? 
      JMP SL10      NO
* 
      LDA NAMLN 
      JMP REPLY+1   WRITE SLAVE LIST WITH REPLY 
      SKP 
* 
*  HANDLE SLAVE OFF REQUESTS HERE 
SOFF  LDA $PCB      ID SEG ADDR 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 $NAME 
      STA IDSEG     SAVE ID SEGMENT ADDRESS 
* 
*  ENTER HERE ON "PCLOS" OF "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 $FUNC 
      ALF,ALF       TEST BIT 7 OF FUNCTION CODE 
      SSA           IS THIS A "FINIS" REQUEST?
      JMP GET       YES, NO REPLY REQUIRED
* 
FINEX CLB 
      STB $ERR+1    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 
* NOW CLEAR ALL REQUESTS FROM THE I/O CLASS 
* (ONE AT A TIME) AND CAUSE IT TO BE RELEASED 
      LDA CLSAD,I   GET CLASS NUMBER
      IOR B1315     SET BIT 13 & 15 IN CLASS WORD 
      STA TEMP      THEN SAVE FOR CALL
      STA CLFLG     SET CLASS CLEAR FLAG NON-ZERO 
* 
NXGET JSB DOGET     GET REQUEST 
TEMP  NOP 
      JMP ABTIT     FIRST,  PGM MUST BE TERMINATED
* 
      CLB 
      CPB CLFLG     RELEASE PROCESSING COMPLETE?
      JMP FIEND     YES 
      INA,SZA       ALL PENDING REQUESTS CLEARED? 
      JMP NXGET     NO, CLEAR MORE
      STA CLFLG     SET FOR ONE MORE
      LDA TEMP
      AND CLR13     CLEAR NO DE-ALLOCATE FLAG 
      STA TEMP
      JMP NXGET 
* 
*  ABORT USER PROGRAM 
ABTIT LDB NAMA
      LDA SEGAD,I 
      ADA K12       ADDR OF NAME IN ID SEG
      MVW K3        MOVE INTO NAME FIELD
      LDA NAME+2
      AND B1774     CLEAR RHW 
      STA NAME+2
* 
      JSB EXEC      TERMINATE PROGRAM 
      DEF *+3 
      DEF K6N 
NAMA  DEF NAME
      CLB,RSS       GET OUT IF WOULD HAVE ABORTED 
      JMP NXGET     NOW RELEASE CLASS # 
* 
FIEND 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 $ERR+1    STORE ERROR WORD
      LDB #NODE 
      STB $ENOD     PASS LOCAL NODE 
* 
      JSB CLSAM     CLEAR THE CLASS BUFFER
* 
REPLY CLA 
      STA CNTR      SET LENGTH OF DATA
* 
      JSB D65SV     SEND THE REPLY
      DEF *+5 
RQADR DEF IRBUF     REQUEST BUFFER
      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
      SPC 2 
* 
*  DO A CLASS I/O DUMMY GET 
* 
DOGET NOP 
      JSB EXEC
      DEF *+5 
      DEF K21N
      DEF DOGET,I   CLASS # 
      DEF DUMMY 
      DEF K0
      RSS           SKIP IF WE COULD HAVE ABORTED 
      ISZ DOGET     ELSE RETURN TO P+2
      ISZ DOGET 
      JMP DOGET,I   RETURN
      SKP 
* 
*  CLEAR PTOPM'S CLASS BUFFER OR RETHREAD TO PLOG 
* 
CLSAM NOP 
      LDA #PLOG 
      SZA           LOGGING?
      JMP LOGIT     YES 
* 
CLAR  EQU * 
      JSB EXEC      CLASS GET (ZERO LENGTH) 
      DEF *+5 
      DEF K21 
      DEF CLAS2 
      DEF DUMMY 
      DEF K0
* 
CLSEX LDA $STRM 
      IOR BIT14     SET REPLY FLAG IN REQUEST 
      STA $STRM 
      JMP CLSAM,I   RETURN
      SPC 2 
LOGIT JSB #REQU     RETHREADING ROUTINE 
      DEF *+3 
      DEF CLASS     PTOPM'S CLASS 
      DEF #PLOG 
      SSA           ANY ERRORS? 
      JMP CLAR      YES, SIMPLY DELETE BUFFER 
      JMP CLSEX 
      SKP 
* 
*  DATA AREA
* 
BFADR NOP 
CNTR  NOP 
RQLEN NOP 
IDSEG NOP 
SEGAD NOP 
FSTAD NOP 
CLASS NOP 
CLAS2 NOP 
K1    DEC 1 
K2    DEC 2 
K3    DEC 3 
K7    DEC 7 
K15   DEC 15
K12   DEC 12
K20   DEC 20
K21   DEC 21
K6N   OCT 100006
K10N  OCT 100012
K21N  OCT 100025
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 
      DEF SOFF      CODE 6: SLAVE OFF 
      DEF SLIST     CODE 7: SLAVE LIST
BIT13 OCT 020000    BIT13 
B17   OCT 17
BIT14 OCT 040000
B1315 OCT 120000
B1774 OCT 177400
CLR13 OCT 157777
N7    DEC -7
N10   DEC -10 
N25   DEC -25 
M41   DEC -41 
M42   DEC -42 
M44   DEC -44 
M45   DEC -45 
M48   DEC -48 
M58   DEC -58 
M103  DEC -103
CLFLG NOP 
DUMMY NOP 
NAMAD DEF NAMBF+1 
NAMLN ABS NENT+NENT+NENT+1 SIZE OF "SL" BUFR
* 
*  DEFINE P TO P REQUEST BUFFER 
* 
IRBUF BSS 31
A     EQU 0 
B     EQU 1 
* 
$STRM EQU IRBUF 
$ERR  EQU IRBUF+4 
$ENOD EQU IRBUF+6 
$FUNC EQU IRBUF+7 
$PCB  EQU IRBUF+8 
$NAME EQU IRBUF+8 
* 
NAME  BSS 3 
* 
*  DEFINE SLAVE PGM LIST & VARIABLES
* 
NENT  EQU 20        SET # OF ENTRIES
A#IDS DEF P#IDS     POINT TO ID SEG ADDRS 
A#CLS DEF A#CLS     POINT TO SLAVE CLASS #S 
NTOTL ABS -NENT     -# OF ENTRIES 
* 
P#CLS BSS NENT+NENT DEFINE THE SLAVE LIST TABLE 
P#IDS EQU P#CLS+NENT
P#END EQU P#IDS+NENT
      UNL 
      ORG P#CLS 
      REP NENT+NENT INITIALIZE TABLE TO ZEROES
      NOP 
      LST 
* 
NAMBF BSS NENT+NENT+NENT+1 BUFFER FOR "SL"
* 
SIZE  EQU * 
* 
      END PTOPM 
                                                                                                                      