ASMB,Q,C
* 
*  **************************************************************** 
*  * (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.        * 
*  **************************************************************** 
* 
      HED PLOG--DS/1000 REQUEST/REPLY BUFFER LOGGING PROGRAM
      NAM PLOG,19,30 91750-16147 REV 2013 801013  ALL 
* 
* NAME:    PLOG 
* 
* RELOC:   91750-16147
* 
* SOURCE:  91750-18147
* 
* PRGR:    C. JONAS 
* 
* MOD BY:  DWT   AUG 1978 
*          CWJ   801013  ENFORCE NON CLONABILITY! 
* 
      SUP 
* 
*  THIS PROGRAM IS A SYSTEM DIAGNOSTIC TOOL WHICH PRODUCES A BINARY LOG 
*  OF REQUEST AND REPLY BUFFERS PASSED TO THE NODE OF A DISTRIBUTED SYSTEM
*  IN WHICH PLOG IS RUNNING.
* 
*  SCHEDULING SEQUENCE: 
* 
*      *RU,PLOG[,CONSOLE LU[,LOG NAMR[,DATA FLAG[,# OF BUFFERS[,DEBUG]]]]]
* 
*    WHERE: 
*      CONSOLE LU   = (INTERACTIVE) LU # FOR ERROR AND MESSAGE LOGGING. 
*                   = -1 IF THE PROGRAM IS SCHEDULED TO CLEAN UP. 
*                   DEFAULT IS THE SCHEDULING TERMINAL. 
*      LOG NAMR     = LU, IF A TAPE-LIKE DEVICE (MAG. TAPE, CTU, ECT.)
*                     IS TO BE USED AS LOG MEDIUM, OR 
*                   = NAMR (IN THE FORM NAME:SECURITY:CARTRIDGE), IF A
*                     FILE IS TO BE USED AS LOG MEDIUM.  PLOG WILL
*                     CREATE THE FILE NAMR AND ASSIGN FILE TYPE AND SIZE. 
*                   = -1 IF THE CLEAN UP DOES NOT INCLUDE THE LOG FILE. 
*                   DEFAULT IS DISC FILE 'PLOG:DS.
*      DATA FLAG    = 0, IF NO DATA FROM REQUEST/REPLY BUFFERS IS TO BE 
*                     SAVED, OR 
*                   = NON-ZERO, IF DATA FROM REQUEST/REPLY BUFFERS IS TO BE 
*                     SAVED.
*                   DEFAULT IS NO DATA. 
*      # OF BUFFERS = # OF MOST RECENT REQUEST/REPLY BUFFERS TO LOG IF
*                     DISC IS LOG MEDIUM. 
*                   DEFAULT IS 300 BUFFERS. 
*      DEBUG        NON-ZERO WILL SET THE DEBUG FLAG (BIT 9 IN #TYPE).
* 
* 
*  PLOG HANGS ON CLASS #PLOG THROUGH WHICH REQUEST/REPLY BUFFERS ARE
*  RETHREADED BY THE DISTRIBUTED SYSTEM SOFTWARE.  PLOG KEEPS A RECORD OF 
*  ITS RESOURCES IN <RES> CONSISTING OF #PLOG, ITS CLASS NUMBER, #PRN, ITS
*  RESOURCE NUMBER, #TYPE, THE LOG TYPE WORD, BITS OF WHICH, IF SET,
*  MEAN:
* 
*  !   !   !   !   !   !   !   !   !   !   !   !   !   !   !   !   !
*  !--15--14--13--12--11--10---9---8---7---6---5---4---3---2---1---0
*    ^                   ^       ^ !<----------LOG LU #----------->!
*    !                   !       !
*  DISC                FULL    DATA 
*   LOG               BUFFER  LOGGED
* 
*  AND, IF DISC LOG, #RECS, #SIZE, AND #CRNT, THE RECORD SIZE,
*  # OF BLOCKS, AND THE CURRENT RECORD NUMBER, RESPECTIVELY 
* 
      SPC 3 
      EXT #PLOG,#PKUP,#GETR 
      EXT $TIME,EXEC,IFBRK,KCVT 
      EXT CLOSE,CREAT,OPEN
      EXT POST,PURGE,RNRQ,WRITF 
      EXT CLRQ
      EXT PNAME 
* 
#CLAS DEF #PLOG    CLASS #
#PRN  DEF #PLOG+1  RESOURCE # 
#TYPE DEF #PLOG+2  TYPE & LOG LU
#RECS DEF #PLOG+3  RECORD SIZE
#SIZE DEF #PLOG+4  # OF DISC BLOCKS 
#CRNT DEF #PLOG+5  CURRENT RECORD # 
      SKP 
* GLBLK-START 
* 
* 
******************************************************************
*                                                                *
*     G L O B A L   B L O C K               REV XXXX 790531      *
*                                                                *
*     GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY:      *
*                                                                *
*         REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST        *
*         GET,   #SLAV, RQCNV, RPCNV, GRPM,  LSTEN, PTOPM        *
*         EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3        *
*                                                                *
******************************************************************
* 
***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!***
#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 
PLOG  EQU * 
* 
*  PICK UP PARAMETERS 
* 
      JSB #PKUP 
       DEF *+4
       DEF PMASK
       DEF INLU 
       DEF DEFLU
* 
*  CHECK IF ENTRY TO CLEAN UP 
* 
      LDA INLU      LOAD CONSOLE LU 
      STA CFLG      SET THE CLEAN UP FLAG 
      SSA,RSS       NEGATIVE LU?
      JMP SETIN      NO, GO SETUP PARAMETERS
      LDB DEFLU      YES
      STB INLU
* 
      INA,SZA       IF INLU WAS -1, DO CLEAN UP 
      JMP INERR      ELSE, IT IS AN INPUT LU ERROR
*       
      JSB CLONE     IF THIS IS A CLONE OF PLOG, TERMINATE HIM 
* 
      LDA #PLOG     LOAD CLASS NUMBER FOR CLEAN UP
      STA CLNUM 
      LDA OUTLU     LOAD LOG NAMR 
      SSA,RSS       NEGATIVE ALSO?
      JMP SETLG     .NO, GO CLEAN UP LOG FILE 
      JMP TERM2     .YES, LOG FILE IS NOT CLEANED UP
* 
*  SET UP CONSOLE LU
* 
SETIN LDB DEFLU     LOAD DEFAULT LU 
      SZA,RSS       IS CONSOLE LU ZERO? 
      STB INLU      YES, USE DEFAULT
* 
      JSB CLONE    IF THIS IS A CLONE OF PLOG, TERMINATE HIM
* 
*  CHECK IF THE CLASS NUMBER WAS NOT CLEANNED UP
* 
      LDA #PLOG 
      SZA 
      JMP CUERR 
* 
*  SET UP LOG NAMR
* 
SETLG LDA PTYPE     LOAD DEVICE TYPE
      SZA,RSS 
      JMP DEFNA     JUMP IF DEFAULT (USE 'PLOG) 
      CPA D1        CHECK IF TAPE LU
      JMP TAPLU 
DSCLU LDA =B100000  WITH DISC,BIT 15 OF #TYPE = 1 
      STA #TYPE,I 
      JMP CHKCL 
TAPLU LDA OUTLU 
      SZA,RSS       OUTLU = 0?
      JMP DEFNA     .YES, USE DEFAULT 
      SSA           NEGATIVE LOG LU?
      JMP LUERR     .YES, LOG LU ERR
      IOR B100      .NO, SET BIT TO OUTPUT
      STA OUTBI      AS BINARY
      STA #TYPE,I   WITH TAPE, #TYPE = LOG LU 
      JMP CHKCL 
DEFNA LDA PLNAM 
      STA NAME
      DLD PLNAM+1 
      DST NAME+1
      LDA PLSEC 
      STA SEC 
      LDA PLCRN 
      STA CRN 
      LDA =B100000
      STA #TYPE,I 
* 
*  CHECK IF ENTRY TO CLEAN UP LOG FILE
* 
CHKCL EQU * 
      LDA CFLG      GET CLEAN UP FLAG 
      INA,SZA       CLEAN UP CALL? (A = -1) 
      JMP SETDF     .NO, JMP TO SET UP DATA FLAG
      JSB OPEN      .YES, OPEN LOG FILE FOR CLEAN UP PURPOSE
       DEF *+7
       DEF IDCB 
       DEF IERR 
       DEF NAME 
       DEF D3 
       DEF SEC
       DEF CRN
      SSA           ANY ERROR?
      JMP TERM2     .YES, JUST CLEAN UP CLASS # 
      JMP TERM1     .NO, JMP TO CLEAN UP
* 
*  SET UP DATA FLAG 
* 
SETDF CLA 
      LDB DATAF     GET DATA FLAG 
      SZB           IS IT SET?
      LDA =B400      YES--SET FLAG
      IOR #TYPE,I    AND MAKE IT BIT EIGHT IN #TYPE 
      STA #TYPE,I 
* 
      CLA 
      SZB,RSS       DATA FLAG?
      STA DAMAX      NO, DATA LENGTH = 0
      LDA RQMAX     LOAD HEADER LENGTH
      ADA DAMAX     ADD DATA LENGTH 
      ADA D3        ADD 3 WORD TO HOLD TIME AND HEADER LENGTH INFO. 
      SZB           ANY DATA? 
      INA            YES, ADD 1 MORE WORD TO HOLD DATA LENGTH INFO. 
      STA PKLEN     STORE AS RECORD SIZE
      STA #RECS,I   SAVE RECORD SIZE LOCALLY & IN RES 
* 
*  CHECK # OF BUFFER
* 
      LDA SIZE      GET PASSED SIZE 
      SSA           IS IT NEGATIVE? 
      JMP SZERR     .YES, ERROR 
* 
*  SET UP DEBUG FLAG
* 
      CLA 
      LDB DEBUG     GET DEBUG FLAG
      SZB           IS IT SET?
      LDA =B1000     YES, SET FLAG IN #TYPE 
      IOR #TYPE,I 
      STA #TYPE,I 
* 
*  (A)  ALLOCATE CLASS NUMBER 
* 
      CLA 
      STA CLNUM 
      JSB CLRQ      GET CLASS WORD
       DEF *+4
       DEF FUNC1    GET CLASS W/ NW, NA 
       DEF CLNUM    RETURN NEW CLASS #
       DEF D0       NO CLASS OWNERSHIP
       JMP CLALL    ERROR RETURN
      SZA           CLASS ALLOCATED?
      JMP CLALL       NO--INFORM USER THEN TERMINATE
      LDA CLNUM     GET ALLOCATED CLASS NUMBER
      IOR NDEAL     SET SAVE CLASS # BIT
      STA CLNUM       AND SAVE FOR DEALC USE
* 
*  (B)  ALLOCATE RESOURCE NUMBER
* 
      JSB RNRQ
       DEF *+1+3    RETURN ADDRESS
       DEF ALLOC    ALLOCATE GLOBALLY, NO WAIT,NO ABORT 
       DEF #PLOG+1   RESOURCE # STORAGE LOCATION
       DEF STAT     PLACE HOLDER--UNUSED
       JMP RNALL    ERROR RETURN
      LDA #PRN,I     IF #PRN = 0, 
      SZA,RSS         RN UNAVAILABLE
      JMP RNALL       IF SO, INFORM USER AND TERMINATE
      SPC 2 
* 
*  (C)  ALLOCATE LOG DEVICE/FILE
* 
      LDA #TYPE,I   DISK LOG FLAG SET?
      SSA 
      JMP DISC1       YES--BRANCH TO CREAT
* 
      JSB EXEC        NO--WRITE OUT #TYPE & #RECS WORDS HEADER TO TAPE
       DEF *+1+4    RETURN POINT
       DEF NA2      WRITE, NO ABORT 
       DEF OUTBI    LOG LU #
       DEF #PLOG+2  HEADER ADDRESS
       DEF D2       TWO WORDS LONG
       DEF THERR    ERROR RETURN
      JMP GOLOG 
      SPC 2 
* 
*  CREATE & INITIALIZE DISC FILE FOR LOGGING
* 
DISC1 LDA SIZE      GET # OF REQUESTS/REPLIES 
      SZA           DID USER SPECIFY? 
      JMP DISC2       YES--BRANCH OUT 
      LDA =D300     IF DEFAULTED, SAVE 300 BUFFERS
DISC2 CLB           SET UP REGISTERS TO DETERMINE # OF BLOCKS 
      INA           ADD 1 TO # BUFFERS FOR HEADER RECORD
      MPY PKLEN       AND MULTIPLY BY BUFFER LENGTH 
      DIV D128        DIVIDE BY BLOCK LENGTH
      SZB           IF B IS NOT ZERO
      INA             ADD ONE TO NUMBER OF BLOCKS 
      STA BLOKS     SAVE # OF BLOCKS FOR CREAT CALL 
* 
      CLB 
      LDA DATAF 
      SZA,RSS       DATA FLAG SET?
      INB            NO, REGULAR TYPE 2 FILE
      INB            YES, TYPE 1 FILE FOR FAST XFER 
      STB FTYPE 
DISC3 JSB CREAT     CREATE THE FILE 
       DEF *+1+7    RETURN POINT
       DEF IDCB     DCB FOR FILE (144 WORDS)
       DEF IERR     STATUS/ERROR WORD (ON SUCCESS = # OF 64W BLOCKS IN FILE)
       DEF NAME     FILE NAME 
       DEF ISIZE    BLOCK AND RECORDS SIZES 
       DEF FTYPE
       DEF SEC       WRITE PROTECT SECURITY CODE
       DEF CRN      CARTRIDGE 
      SSA,RSS       ANY ERRORS RETURNED?
      JMP DISC4       NO--BRANCH AROUND 
      CPA M2          YES--DUPLICATE FILE?
      RSS 
      JMP DOERR         NO--INFORM USER OF ERROR AND TERMINATE
* 
*  HERE IF PLOG INITIATED FOR FILE LOG & DISC FILE ALREADY EXISTS 
* 
      LDA .ASK      ASK USER IF OLD FILE SHOULD BE PURGED 
      LDB D23         AND ITS LENGTH
      JSB PRINT     PRINT MESSAGE 
       JMP TERM2    ERROR RETURN
      LDA INLU
      IOR =B400     SET ECHO MODE 
      STA INLU
      JSB EXEC      GET ANSWER
       DEF *+1+4
       DEF NA1
       DEF INLU 
       DEF YE/NO    YES/NO BUFFER 
       DEF D1 
       JMP TERM2    ERROR RETURN
      LDA YE/NO 
      CMA,INA 
      ADA =AYE      O.K. TO PURGE?
      SZA 
      JMP TERM2     NO, TERMINATE PLOG
* 
      JSB OPEN      OPEN OLD FILE TO PURGE IT 
       DEF *+1+6    RETURN POINT
       DEF IDCB     TEMPORARY DCB FOR THIS FILE 
       DEF IERR     STATUS/ERROR WORD 
       DEF NAME     FILE NAME 
       DEF D0       NO UNUSUAL OPTIONS
       DEF SEC       SECURITY CODE
       DEF CRN      CARTRIDGE 
      SSA           IF AN ERROR--TELL USER & TERMINATE
      JMP DOERR 
* 
      JSB PURGE     PURGE OLD FILE
       DEF *+1+5    RETURN POINT
       DEF IDCB     TEMPORARY DCB FOR THIS FILE 
       DEF IERR     STATUS/ERROR WORD 
       DEF NAME     FILE NAME 
       DEF SEC       SECURITY CODE
       DEF CRN      CARTRIDGE 
      SSA 
      JMP DOERR 
      JMP DISC3 
* 
DISC4 ARS 
      STA #SIZE,I   SET # OF 128W BLOCKS
      CLA 
      STA CNTR      SET FIRST WORD IN PKLIN TO 0
      INA 
      STA #CRNT,I   SET CURRENT RECORD NUMBER TO ONE
      JSB WRITF       AND WRITE FIRST RECORD, 1ST WORD =0 
       DEF *+1+5    RETURN POINT
       DEF IDCB 
       DEF IERR     ERROR STATUS WORD--PLACE HOLDER 
       DEF PKLIN     RECORD ADDRESS 
       DEF PKLEN     RECORD LENGTH
       DEF #PLOG+5  #CRNT, THE CURRENT RECORD # IN RES
      SSA           ANY ERRORS RETURNED?
      JMP DHERR       YES--INFORM USER & TERMINATE
      ISZ #CRNT,I     NO--BUMP RECORD ADDRESS 
      JSB OPEN      OPEN FILE FOR NON-EXCLUSIZE USE 
       DEF *+1+6     THIS WILL ALSO POST FILE 
       DEF IDCB     DCB FOR FILE
       DEF IERR     STATUS/ERROR WORD 
       DEF NAME     FILE NAME 
       DEF D3       SHARED, UPDATE OPTIONS
       DEF SEC       SECURITY CODE
      DEF CRN       CARTRIDGE 
      SSA           ANY ERRORS RETURNED?
      JMP DHERR       YES--INFORM USER & TERMINATE
      SPC 2 
* 
*  READY TO START LOGGING 
* 
GOLOG LDA CLNUM     GET CLASS # 
      STA #CLAS,I   TELL THE DS WE ARE READY (SET #PLOG'S CLASS)
      JSB IFBRK     CLEAR BREAK FLAG
       DEF *+1
      LDA .STAR 
      LDB =D7 
      JSB PRINT     PRINT START MESSAGE 
       JMP TERM1
      SPC 2 
* 
*  GET LOGGED DATA
* 
GETNX JSB #GETR 
       DEF *+6
       DEF CLNUM
       DEF RQARE
       DEF RQMAX
       DEF DAARE
       DEF DAMAX
       JMP GTERR
      ADA C#LSZ     ADD THE APPANDAGE LEN 
      STA CNTR      SAVE AS REQUEST LENGTH
      LDA 1         LOAD RETURNED DATA LENGTH 
      CMB,INB 
      ADB DAMAX     MAX LENGTH - RETURNED LEN 
      SSB 
      LDA DAMAX     RETURNED LEN > MAX LEN, USE MAX LEN 
      STA DLEN      SAVE DATA LENGTH
* 
      LDA CLNUM 
      ALR,RAR       CLEAR 'SAVE BUFFER' BIT 
      STA CLNUM 
      JSB EXEC      DUMMBY GET TO RELEASE SAM BUFFER
       DEF *+5
       DEF NA21 
       DEF CLNUM
       DEF D0 
       DEF D0 
       JMP GTERR
* 
      LDA CNTR
      SZA,RSS       ZERO LENGTH REQUEST?
      JMP TERM1       YES--TIME TO QUIT 
      DLD $TIME 
      DST BTIME     PUT SYSTEM TIME INTO OUTPUT BUFFER
      JSB WRTRQ     WRITE BUFFER TO LOG DEVICE
      SPC 2 
* 
*  CHECK END OF LOG REQUEST 
* 
      JSB IFBRK     SEE IF USER WANTS TO TERMINATE
       DEF *+1
      SZA,RSS 
      JMP GETNX     IF NOT, JUST CONTINUE 
      SPC 2 
* 
*  HERE ON BR,PLOG
* 
      CLA           SHUT OFF PLOG TO DS/1000
      STA #CLAS,I 
      JSB EXEC      SEND A ZERO LENGTH BUFFER 
       DEF *+1+7      TO SIGNIFY END OF LOG 
       DEF NA18     WRITE W/NO ABORT
       DEF D0       NO DATA 
       DEF D0 
       DEF D0 
       DEF D0 
       DEF D0       ZERO LENGTH REQUEST PARAMETER 
       DEF CLNUM    CLASS WORD
       JMP ZWERR    ERROR RETURN
      CCE 
      LDA CLNUM     GET CLASS # 
      RAL,ERA       SET NO WAIT BIT 
      STA CLNUM 
      JMP GETNX       AND CONTINUE CLEAN UP 
      SPC 2 
* 
*  PROGRAM TERMINATION: 
*    THE SEQUENCE OF TERMINATION IS VERY IMPORTANT SINCE AT 
*    DIFFERENT POINT OF THE PROGRAM, DIFFERENT RESOURCES NEED 
*    TO BE RELEASED.
* 
*  RESOURCES ARE ALLOCATED IN THIS ORDER: 
*    A.  CLASS NUMBER 
*    B.  RESOURCE NUMBER
*    C.  LOG DEVICE/FILE
*  THEREFORE THEY ARE DEALLOCATED/RELEASED IN THIS ORDER: 
*    A.  LOG DEVICE/FILE
*    B.  RESOURCE NUMBER
*    C.  CLASS NUMBER 
* 
* 
*  (A)  RELEASE LOG DEVICE/FILE 
* 
TERM1 LDA #TYPE,I   LOAD TYPE OF LOG DEVICE 
      SSA           DISC LOG? 
      JMP DTERM       DISC, BRANCH AROUND WEOF CALL 
      JSB WEOF      WITH BREAK DURING TAPE LOG, WRITE EOF & 
      JMP TERM2       GO ON 
* 
DTERM LDA #TYPE,I   DISC, SET UP FIRST RECORD FOR FILE
      STA CNTR
      LDA #CRNT,I   CONTAINS: #TYPE, #CRNT, #SIZE, AND #RECS
      LDB #SIZE,I 
      DST BTIME 
      LDA #RECS,I 
      STA RQARE 
      CLA,INA       SET CURRENT RECORD # TO 1 
      STA #CRNT,I 
      JSB WRTRQ       AND WRITE OUT FIRST RECORD
      JSB CLOSE     THEN CLOSE FILE 
       DEF *+1+1
       DEF IDCB     IGNORE ANY ERRORS 
      SSA 
      JMP DCERR 
* 
* 
*  (B)  RELEASE RESOURCE #
* 
TERM2 LDA #PRN,I     RESOURCE NUMBER ALLOCATED? 
      SZA,RSS 
      JMP TERM3       NO--BRANCH TERM3
      JSB RNRQ        YES--RELEASE IT 
       DEF *+1+3    RETURN ADDRESS
       DEF RN32     CLEAR RN, NO ABORT
       DEF #PLOG+1   RN IN RES
       DEF STAT     STATUS WORD--UNUSED 
       JMP RRERR
      CLA 
      STA #PRN,I     ERASE VALUE IN RES 
      SPC 2 
* 
*  (C)  RELEASE CLASS # 
* 
TERM3 LDA CLNUM     GET CLASS WORD
      SZA,RSS       CLASS NUMBER ALLOCATED? 
      JMP DONE        NO--BRANCH AROUND DEALLOCATION. 
      CLA 
      STA #CLAS,I   SHUT OFF PLOG TO DS/1000
* 
*  FLUSH BUFFERS AND DEALLOCATE CLASS # 
* 
      JSB CLRQ
       DEF *+3
       DEF FUNC2
       DEF CLNUM
       JMP RCERR
* 
*  DONE -- PLOG TERMINATES
* 
DONE  LDA .ENDM     PRINT "END PLOG" MESSAGE
      LDB D6
      JSB PRINT 
       NOP
* 
      JSB EXEC      THEN TERMINATE
       DEF *+1+3    RETURN ADDRESS
       DEF D6       REQUEST CODE = TERMINATE
       DEF D0         THIS PROGRAM, 
       DEF D0         NORMALLY
      SKP 
      HED PLOG--WRTRQ ROUTINE 
* 
*  ROUTINE TO WRITE OUT BLOCK AND DO FILE AND TAPE MANAGEMENT 
* 
WRTRQ NOP 
      JSB RNRQ      LOCK RN 
       DEF *+1+3    RETURN ADDRESS
       DEF RN1      1 = LOCAL LOCK, W/ WAIT, NO ABORT 
       DEF #PLOG+1  RESOURCE NUMBER 
       DEF STAT     PLACE HOLDER--UNUSED
       JMP LKERR    ERROR RETURN
      LDA #TYPE,I   IF DISC LOG,
      SSA             BRANCH TO WRITF CALL
      JMP WRTDS 
* 
*  TAPE WRITE 
* 
      LDA OUTLU     BEFORE WRITE, 
      IOR =B600      GET DYNAMIC STATUS 
      STA TEMP
      JSB EXEC
       DEF *+3
       DEF NA3
       DEF TEMP     CONWD 
       NOP          IGNORE ERROR FOR NOW
      STA TEMP      STORE STATUS SO WE CAN CHECK LATER
* 
      JSB EXEC      IF TAPE, WRITE OUT BLOCK OF INFO
       DEF *+1+4    RETURN ADDRESS
       DEF NA2      2 = WRITE, NO ABORT 
       DEF OUTBI    LOGGING LU #
       DEF PKLIN    OUTPUT BLOCK ADDRESS
       DEF #RECS,I  OUTPUT LENGTH 
       RSS          ERROR, SKIP NEXT JUMP 
      JMP UNLK
      DST EXCER     STORE ERROR CODE
      CCA           SET ERROR FLAG
      STA TEMP
* 
UNLK  EQU * 
      JSB RNRQ      UNLOCK RN 
       DEF *+1+3    RETURN ADDRESS
       DEF RN4      4 = CLEAR LOCK, NO ABORT
       DEF #PLOG+1   RESOURCE NUMBER
       DEF STAT     PLACE HOLDER--UNUSED
       JMP LKERR    ERROR RETURN
      LDA TEMP      GET FLAG WORD 
      SSA           ANY ERRORS? 
      JMP TWERR       YES--INFORM USER
      AND B40       EOT CONDITION?
      SZA,RSS 
      JMP WRTRQ,I       NO--RETURN
* 
      JSB REWND     REWIND TAPE 
      LDA .EOT
      LDB D18       INFORM USER 
      JSB PRINT 
       NOP
      JMP TERM2     FLUSH SYSTEM--THEN TERMINATE
      SPC 2 
* 
*  HERE IF FILE IS DISC MEDIUM
* 
WRTDS JSB WRITF     WRITE RECORD TO FILE
       DEF *+1+5    RETURN ADDRESS
       DEF IDCB     DCB FOR FILE
       DEF IERR     STATUS/ERROR WORD 
       DEF PKLIN    OUTPUT BLOCK ADDRESS
       DEF #RECS,I  OUTPUT LENGTH 
       DEF #PLOG+5  RECORD NUMBER (IN RES)
* 
      SSA,RSS       STATUS POSITIVE?
      JMP WRTD2       YES--BRANCH TO RECORD BUMP
      CPA M12         NO--EOF ENCOUNTERED?
      RSS 
      JMP DWERR         NO--INFORM USER OF ERROR
* 
      LDA B2000       YES--SET FULL BUFFER BIT IN #TYPE 
      IOR #TYPE,I 
      STA #TYPE,I 
      LDA D2        CURRENT RECORD # = RECORD # 2 
      STA #CRNT,I 
      JMP WRTDS     TRY WRITING RECORD AGAIN
* 
WRTD2 JSB POST      POST THE FILE TO MAKE SURE
       DEF *+1+1      THE RECORD GETS OUT TO THE DISC 
       DEF IDCB 
      SSA           IF ANY ERRORS ON POST,
      JMP DWERR       INFORM USER & TERMINATE 
* 
      ISZ #CRNT,I   RECORD WRITTEN, INCREMENT RECORD NUMBER 
      JSB RNRQ      UNLOCK RN 
       DEF *+1+3    RETURN ADDRESS
       DEF RN4      4 = CLEAR LOCK, NO ABORT
       DEF #PLOG+1  RESOURCE NUMBER ADDR. IN RES
       DEF STAT     PLACE HOLDER--UNUSED
       JMP LKERR    ERROR RETURN
      JMP WRTRQ,I   AND NORMAL RETURN 
      SKP 
      HED PLOG--UTILITY ROUTINES
* 
*  ROUTINE TO ADD AN EOF TO MAG TAPE LOG
* 
WEOF  NOP 
      LDA OUTLU     SET CONTROL BIT IN LU WORD FOR WRITE
      IOR B100
      STA CNTRL 
      JSB EXEC
       DEF *+1+2    RETURN ADDRESS
       DEF NA3      CONTROL WRITE-END-OF FILE 
       DEF CNTRL      W/ NO ABORT 
       NOP          (IGNORE ANY ERRORS) 
      JSB REWND     REWIND TAPE BITS FOR REWIND 
      JMP WEOF,I    AND RETURN
* 
REWND NOP           ROUTINE TO REWIND MAG TAPE
      LDA OUTLU     SET CONTROL BITS IN LU FOR REWIND 
      IOR B400
      STA CNTRL 
      JSB EXEC
       DEF *+1+2
       DEF NA3      CONTROL (W/ NO ABORT) 
       DEF CNTRL      REWIND
       NOP          ERRORS IGNORED
      JMP REWND,I 
      SPC 2 
* 
*  ROUTINE TO WRITE TO THE OPERATOR'S CONSOLE 
* 
PRINT NOP 
      STA .MSG      PUT BUFFER ADDRESS
      STB .MSGL       AND BUFFER LENGTH INTO CALL 
      JSB EXEC      WRITE TO CONSOLE LU 
       DEF *+1+4    RETURN ADDRESS
       DEF NA2      2 = WRITE, NO ABORT 
       DEF INLU      CONSOLE LU 
.MSG   NOP
       DEF .MSGL
       JMP PRINT,I  ERROR RETURN
      ISZ PRINT     BUMP TO NORMAL RETURN ADDRESS 
      JMP PRINT,I 
.MSGL NOP 
      SPC 2 
* 
*  ROUTINE TO TERMINATE CLONES OF PLOG                      
* 
CLONE NOP 
      JSB PNAME    GET ACTUAL NAME OF PROGRAM 
      DEF *+2 
      DEF PNAM         PROGRAM NAME ARRAY 
      LDA "PLOG+2        LAST 2 CHARS = "  "?   
      CPA PNAM+2
      RSS 
      JMP PLERR             NOPE
      LDA "PLOG+1           YES, NEXT CHARS = "OG"? 
      CPA PNAM+1
      RSS 
      JMP PLERR             NOPE
      LDA "PLOG             YES, NEXT CHARS = "PL"? 
      CPA PNAM
      RSS 
      JMP PLERR             NOPE
      JMP CLONE,I     THIS REALLY IS PLOG, SO RETURN
      SPC 2 
* 
*  ROUTINES TO HANDLE ERROR CONDITIONS
* 
PLERR LDA PNAM      NO CLONES ALLOWED!            
      STA PLER+2      NAME OF PROGRAM MUST BE PLOG
      DLD PNAM+1    INSERT BAD NAME 
      DST PLER+3
      LDA .PLER 
      LDB D25 
      JSB PRINT 
       NOP
      JMP DONE
CUERR LDA .CUER     CLASS CLEANUP ERROR 
      LDB D23 
      JSB PRINT 
      NOP 
      JMP DONE
RNALL LDA .RNER     GET UNALLOCATED RN MESSAGE
      LDB D19         AND ITS LENGTH
      JSB PRINT 
       NOP
      JMP TERM3 
CLALL LDA .CLER     GET UNALLOCATED CLASS # 
      LDB D22         MESSAGE AND ITS LENGTH
      JSB PRINT 
       NOP
      JMP DONE
INERR LDA .INER 
      LDB D20 
      JSB PRINT 
       NOP
      JMP DONE
LUERR LDA .LUER     GET ILLEGAL LOG LU MESSAGE
      LDB D19         AND ITS LENGTH
      JSB PRINT 
       NOP
      JMP DONE
SZERR LDA .SZER 
      LDB D22 
      JSB PRINT 
       NOP
      JMP DONE
THERR DST EXCER+2   SAVE A & B REGS.--ERROR CODE
      LDA .EXER     GET ADDRESS OF ERROR CODE 
      LDB D20         AND ITS LENGTH
      JSB PRINT 
       NOP
      JMP TERM2 
TWERR LDA .EXER 
      LDB D20 
      JSB PRINT 
       NOP
      JMP TERM1 
ZWERR DST EXCER+2 
      LDA .EXER 
      LDB D20 
      JSB PRINT 
       NOP
      JMP TERM1 
GTERR DST EXCER+2 
      LDA .EXER 
      LDB D20 
      JSB PRINT 
       NOP
      JMP TERM1 
LKERR LDA .LKER 
      LDB D20 
      JSB PRINT 
       NOP
      JMP TERM1 
RRERR LDA .RRER 
      LDB D20 
      JSB PRINT 
       NOP
      JMP TERM3 
RCERR DST EXCER+2 
      LDA .EXER 
      LDB D20 
      JSB PRINT 
       NOP
      JMP DONE
DHERR JSB FIERR 
      JMP TERM1 
DOERR JSB FIERR 
      JMP TERM2 
DWERR JSB FIERR 
      JMP TERM2 
DCERR JSB FIERR 
      JMP TERM2 
FIERR NOP 
      CMA,INA       SET ERROR CODE POSITIVE 
      STA TEMP
      JSB KCVT       AND CONVERT CODE TO ASCII
       DEF *+1+1
       DEF TEMP 
      STA FILER+8   PUT CODE INTO ERROR MESSAGE 
      LDA .FIER     GET ADDRESS OF ERROR MESSAGE
      LDB D19         AND ITS LENGTH
      JSB PRINT 
       NOP
      JMP FIERR,I 
      SPC 2 
* 
*  ERROR AND ALLOCATION PROBLEM MESSAGES
* 
PLER  ASC 25, **        IS ILLEGAL NAME--PROGRAM MUST BE PLOG   
.PLER DEF PLER
CUER  ASC 23, ** ERROR-- RUN PLOG,-1 TO CLEAN UP RESOURCES
.CUER DEF CUER
EOTMS ASC 18, ** END OF TAPE -- PLOG TERMINATING
.EOT  DEF EOTMS 
CLER  ASC 22, ** CLASS # UNAVAILABLE -- PLOG TERMINATING
.CLER DEF CLER
RNER  ASC 19, ** RN UNAVAILABLE -- PLOG TERMINATING 
.RNER DEF RNER
LKER  ASC 20, ** RN LOCKING ERROR -- PLOG TERMINATING 
.LKER DEF LKER
RRER  ASC 20, ** CANNOT RELEASE RN -- PLOG TERMINATING
.RRER DEF RRER
RCER  ASC 23, ** CANNOT RELEASE CLASS # -- PLOG TERMINATING 
.RCER DEF RCER
EXCER ASC 20, **      EXEC ERROR -- PLOG TERMINATING
.EXER DEF EXCER 
LUER  ASC 19, ** ILLEGAL LOG LU -- PLOG TERMINATING 
.LUER DEF LUER
INER  ASC 20, ** ILLEGAL INPUT LU -- PLOG TERMINATING 
.INER DEF INER
SZER  ASC 22, ** ILLEGAL BUFFER SIZE -- PLOG TERMINATING
.SZER DEF SZER
ASK   ASC 23, ** DUPLICATE FILE -- PURGE OLD FILE? (YE/NO)
.ASK  DEF ASK 
FILER ASC 19, ** FMP ERROR -    -- PLOG TERMINATING 
.FIER DEF FILER 
ENDM  ASC 6, ** END PLOG
.ENDM DEF ENDM
STAR  ASC 7, ** START PLOG
.STAR DEF STAR
      SPC 2 
* 
*  CONSTANTS AND WORK AREAS 
* 
D0    DEC 0         DECIMAL CONSTANTS 
D1    DEC 1 
D2    DEC 2 
D3    DEC 3 
D6    DEC 6 
D18   DEC 18
D19   DEC 19
D20   DEC 20
D23   DEC 23
D22   DEC 22
D25   DEC 25
D27   DEC 27
D29   DEC 29
D64   DEC 64
D128  DEC 128 
M2    DEC -2
M12   DEC -12 
B40   OCT 40
B100  EQU D64 
B400  OCT 000400
B2000 OCT 002000
NA1   OCT 100001    EXEC CALL REQUESTS WITH 
NA2   OCT 100002      NO ABORT BITS SET 
NA3   OCT 100003
NA18  OCT 100022
NA21  OCT 100025
RN1   OCT 040001
RN4   OCT 040004
RN32  OCT 040040
ALLOC OCT 140020
NDEAL OCT 020000    MASKS FOR SETTING DO NOT DEALLOCATE BIT 
FUNC1 OCT 140001    NO WAIT, NO ABORT, GET CLASS #
FUNC2 OCT 140002    NO WAIT, NO ABORT, DEALLOCATE CLASS # & BUFFERS 
PNAM  BSS 3         STORAGE FOR CURRENT PROGRAM NAME
"PLOG ASC 3,PLOG    ONLY ALLOWABLE PROGRAM NAME 
CFLG  BSS 1         PLOG CLEAN UP FLAG (-1 => DOING CLEANUP)
* 
*  THIS AREA IS USED BY #PKUP AND SHOULD ALWAYS BE IN THIS ORDER
* 
PMASK BYT 5,2       FIVE PARAMETERS, 2ND IS IN NAMR FORMAT
INLU  BSS 1         CONSOLE LU
NAME  BSS 10        LOG FILE NAME 
PTYPE EQU NAME+3    PARAMETER TYPE FROM NAMR
SEC   EQU NAME+4    LOG SECURITY
CRN   EQU NAME+5    LOG CRN 
DATAF BSS 1         DATA FLAG 
SIZE  BSS 1         # OF BUFFERS
DEBUG BSS 1         DEBUG FLAG
* 
DEFLU NOP           DEFAULT LU
OUTLU EQU NAME      LOG LU
OUTBI NOP           LOG LU WITH BINARY WRITE BIT SET
PLNAM ASC 3,'PLOG   DEFAULT FILE NAME 
PLSEC ASC 1,DS      DEFAULT SECURITY CODE 
PLCRN DEC 0         DEFAULT CARTRIDGE 
STAT  NOP           STATUS WORD FOR EXEC CALLS
TEMP  NOP           TEMPORARY STORAGE AREA
IERR  NOP 
CLNUM NOP           CLASS WORD
CNTRL NOP           I/O CONTROL WORD
RQMAX ABS #MXR+#LSZ  HEADER MAX 
DAMAX ABS 128-#MXR-#LSZ-4  DATA MAX 
C#LSZ ABS #LSZ
YE/NO NOP 
FTYPE NOP 
* 
ISIZE BSS 2 
BLOKS EQU ISIZE     # OF DISC BLOCKS
PKLEN EQU ISIZE+1   RECORD SIZE 
* 
PKLIN BSS 128 
CNTR  EQU PKLIN 
BTIME EQU PKLIN+1 
RQARE EQU PKLIN+3 
DLEN  EQU PKLIN+3+#MXR+#LSZ 
DAARE EQU PKLIN+4+#MXR+#LSZ 
IDCB  BSS 144 
      BSS 0 
      END PLOG