ASMB,R,L,C
      HED "IDRPL" FTN/SPL SUBROUTINE TO DO A FMGR ":RP,PROG"
*     SOURCE: 92070-18062 
*     RELOC:  92070-16062 
*     PGMR:   M.L.K.
* 
*  ***************************************************************
*  * (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.       *
*  ***************************************************************
* 
      NAM IDRPL,7  92070-1X062  REV.1941  790709
* 
      SKP 
* 
      ENT IDRPL 
      EXT EXEC,.ENTR,$LIBR,$LIBX,IDSGA,NAM..
      EXT GTOPN,LOGLU,$CKSM,IDMEM,.MVW
      EXT $FWBG,$BGBP 
      SUP 
* 
* 
*  PURPOSE: 
*    TO ACCOMPLISH THE EQUIVALENT OF A FMGR ":RP,PROG" IN A SUBROUTINE. 
*  CALLED:
*     CALL IDRPL (IDCB,IERR,NAME,IPERM) 
*           -OR-
*     IF (IDRPL (IDCB,IERR,NAME,IPERM).NE.0) GO TO IERROR 
*  WHERE: 
*     IERR = RETURN ERROR CODE (SAME AS ERROR CODES IN FMGR)
*     IDCB = AN OPEN DCB OF THE TYPE 6 FILE ON LU=2 OR LU=3 
*     NAME = 5 CHARACTER BUFFER OF THE PROGRAM NAME PUT IN ID SEGMENT 
*     IPERM= 0 IF PROGRAM TO BE TEMPORARY, #0 IF TO BE PERMANENT
* 
*  WORDS SET BY IDRPL:
* 
*     LONG ID SEGMENT 
*     13-15   PROGRAM NAME FROM THIRD INPUT PARAMETER 
*     16      ID BIT SET ACCORDING TO IPERM PARAMETER 
*     25      BASE PAGE TRACK OFFSET FROM MAIN TRACK
*     26      BASE PAGE SECTOR/MAIN SECTOR (IN 128 WORD SECTORS)
*     27      MAIN TRACK
*     28      DISC LU 
*     29      SEQUENCE NUMBER SET FROM THE CURRENT CONTENTS OF THE ID 
*               SEGMENT TO BE USED.  CONSOLE LU FROM LOGLU. 
* 
* 
*   SHORT ID SEGMENT
*     3       SEGMENT'S MAIN TRACK OFFSET FROM WORD 27 IN LONG ID 
*     6       SEGMENT'S BASE PAGE TRACK OFFSET FROM WORD 3 IN SHORT ID
*     7       SEGMENT'S BASE PAGE/MAIN SECTOR ADDRESS (PHYSICAL SECTORS)
*     8       SHORT ID SEGMENT'S CHECKSUM FOR OP SYSTEM.
* 
*  RETURN:
* 
*     IERR =   0 > SUCCESSFUL INSTALLATION OF IDSEGMENT INTO SYSTEM 
*     E-REG =  1 IF ERROR, ELSE E-REG =  0 (FOR FRETURN SPL)
*     IERR  = -1 > DISC ERROR 
*     IERR = -11 > IDCB NOT OPEN
*     IERR =  14 > NO BLANK ID SEGMENTS OR EXTENSIONS AVAILABLE 
*     IERR = -15 > ILLEGAL NAME 
*     IERR =  19 > ID(34),ID(35) WORDS DID NOT CHECKSUM CORRECTLY.
*     IERR =  23 > DUPLICATE PROGRAM NAME.
*     IERR =  39 > CANNOT RP PROGRAM.  DISC ADDRESS OUT OF RANGE
*     IERR =  40 > REAL TIME PROGRAM ALREADY IN CORRESPONDING AREA. 
* 
*  NOTES: 
* 
*    (1)  A-REG = IERR ON RETURN, THEREFORE MAY BE USED AS FUNCTION 
*    (2)  IDRPL  DOES NOT CLOSE THE FILE. 
*    (3)  RECOMMEND FILE BE NON EXECUTIVELY OPENED
*    (4)  E-REG = 1, IF ERROR, E=0, IF NO ERROR(FOR SPL)
*    (5)  ONLY THE 1ST 10 WORDS OF THE DCB ARE USED BY THIS SUBROUTINE. 
*    (6)  B REGISTER HAS THE ADDRESS OF THE PROGRAM NAME IN CONFLICT
*         IF ERROR 40 IS RETURNED.
      SKP 
IDRPL NOP           DUMMY ENTRY POINT 
      LDA DZERO 
      STA PERM
      LDA IDRPL 
      STA DRPL
      JMP DRPL+1
      SPC 2 
IDCB  NOP           OPEN DCB ADDRESS
IERR  NOP           RETURNED ERROR CODE 
NAME  NOP           FIVE CHAR ASCII NAME TO GIVE PROGRAM
PERM  NOP           PERMANENT OR TEMPORARY INDICATOR
* 
DRPL  NOP           ENTRY 
      JSB .ENTR 
      DEF IDCB
      LDA IDCB,I    GET TRACK-LU WORD FROM DCB
      AND B77       ISOLATE LU OF THE DISC
      STA LU        AND SAVE FOR EXEC AND ID
      ADA B7700     ADD DISC PROTECT
      STA PDSLU     TO ITS LU 
      LDB IDCB      CALCULATE FILE TRACK/SECTOR WORD
      ADB .3        ADDRESSES 
      STB DCB3      POINTER TO TRACK OF FILE
      INB           BUMP TO SECTOR OF FILE
      STB DCB4      AND SET INTO EXEC CALL
      ADB .4        BUMP TO SECT/TRACK WORD 
      LDA B,I       GET # OF 64 SECTORS PER TRACK 
      STA #SC/T     SAVE # OF 64 WORD SECTORS PER TRACK 
      RAR           SHIFT FOR # OF 128 WORD SECTORS 
      STA SEC/T     AND SAVE
      CCE,INB       PREPARE E-REG IN CASE OF ERROR, B TO OPEN FLAG
      JSB GTOPN     GET CURRENT OPEN FLAG 
      DEF *+1 
      CPA B,I       SAME AS IN DCB? 
      RSS           YES, SKIP 
      JMP ERR11     NO, FILE NOT OPEN 
* 
      JSB LOGLU     GET CONSOLE LU
      DEF *+2 
      DEF CONLU     DUMMY PARAMETER 
      STA CONLU     SAVE FOR FUTURE USE 
* 
      JSB EXEC      READ 1ST 34 WORDS OF FILE 
      DEF *+7 
      DEF .1        READ
      DEF PDSLU     PROTECTED DISC LU 
DEFID DEF IDBUF     DESTINATION BUFFER ADDRESS
      DEF .34       BUFFER LENGTH 
DCB3  DEF *         DISC TRACK
DCB4  DEF *         DISK SECTOR 
* 
      CLA,CCE       CLEAR SUM TOTAL 
      JSB SUM       CALCULATE CHECKSUM
      DEF IDBUF     OF THE 1ST 31 WORDS OF FILE 
      DEC -31 
      CPA ID+32     EQUAL TO WORD 32? 
      CLA,RSS       YES 
      JMP ERR19     NO
      LDA $CKSM     GET SYSTEM CHECKSUM 
      CPA ID+31     COMPARE?
      JMP DORP      YES, CONTINUE 
ERR19 LDA .19       NO, FMGR ERROR 19 
      JMP EREXT 
ERR39 LDA .39 
      JMP EREXT 
ER01  CCA           SET DISC ERROR
      JMP EREXT 
ERR11 LDA .11 
      CMA,INA       MAKE NEGATIVE 
EREXT CCE           ERROR EXIT E-REG = 1
EXIT  STA IERR,I    TELL CALLER RETURN CODE 
      JMP DRPL,I    RETURN IERR = A-REG 
      SKP 
* 
*     SET UP MAIN ID SEGMENT
* 
DORP  LDA DCB3,I    GET STARTING TRACK NUMBER 
      STA TRACK     INITIALIZE TRACK VALUE FOR BUMP 
      STA TRAK      INITIALIZE TRACK VALUE FOR SETPT
      LDA DCB4,I    GET STARTING SECTOR NUMBER
      STA SEKTR     INITIALIZE SECTOR VALUE FOR SETPT 
      RAR           SHIFT FOR PHYSICAL SECTORS
      STA SECTR     INITIALIZE SECTOR VALUE FOR BUMP
* 
*  MAIN DISC ADDRESS
* 
      CLA,INA       SET A TO 1 FOR HIGH ADDRESS 
      CLB           SET B TO 0 FOR LOW ADDRESS
      JSB BUMP      NOW BUMP DISC ADDRESS BY ONE SECTOR PAST ID 
      STB ID+27     STORE MAIN TRACK IN WORD 27 
      STA ID+26     STORE MAIN SECTOR IN LOW BYTE WORD 26 
* 
*  BASE PAGE DISC ADDRESS 
* 
      LDA ID+22     GET THE HIGH MAIN ADDRESS 
      LDB ID+21     GET THE LOW MAIN ADDRESS
      JSB BUMP      CALCULATE THE DISC ADDRESS OF THE MAIN BASE PAGE
      ALF,ALF       SHIFT BASE PAGE SECTOR TO HIGH BYTE 
      IOR ID+26     ADD IN THE MAIN SECTOR
      STA ID+26     AND STORE AGAIN IN WORD 26
* 
      LDA ID+27     GET MAIN TRACK
      CMA,INA       AND SET IT NEGATIVE 
      STA NEGMN     SAVE THIS FOR LATER 
      ADB A         ADD THE CURRENT TRACK TO GET OFFSET 
      LDA M64       TEST IF OFFSET IS GREATER THAN 63 
      ADA B 
      SSA,RSS       POSITIVE? 
      JMP ERR39     YES, ERROR IN SETUP 
      BLF,BLF       NO, IT'S OK.  SO SHIFT THE OFFSET 
      RBL,RBL         TO THE TOP SIX BITS 
      LDA ID+25     GET ID WORD 25
      IOR B           AND ADD IN BP OFFSET
      STA ID+25     AND STORE AGAIN IN WORD 25
* 
*  DISC LU
* 
      LDA LU        GET LU
      STA ID+28      AND STORE IN WORD 28 
* 
*  SET UP ID NAME 
* 
      JSB NAM..     CHECK FOR LEGAL NAME
      DEF *+2 
      DEF NAME,I
      SZA           NAME OK?
      JMP EREXT     NO, FMGR ERROR -15
* 
      LDA NAME,I    GET FIRST TWO CHARACTERS
      STA ID+13     STORE IN WORD 13
      LDA NAME      GET THE ADDRESS OF THE NAME 
      INA           POINT TO THE SECOND WORD
      DLD A,I       AND GET THE REST
      STA ID+14     STORE THE SECOND WORD 
      LDA B         MOVE LAST CHARACTER TO A
      AND UBYTE     CLEAR LOWER BYTE
      STA ID+15     AND STORE IN ID WORD 15 
* 
*  SET ID BIT IF NECESSARY
* 
      LDA IDBIT     PRESET THE ID BIT 
      LDB PERM,I    NOW GET THE PERMANENT PARAMETER 
      SZB           PREMANENT OR TEMPORARY? 
      CLA           PERMANENT, DON'T SET ID BIT 
      IOR ID+16     TEMPORARY, SET ID BIT 
      STA ID+16     STORE BACK IN WORD 16 
* 
*  CHECK PRIORITY, SET TO 99 IF 0 
* 
      LDA ID+7      GET PRIORITY
      SZA,RSS       IF IT IS ZERO 
      LDA .99       THEN SET IT TO 99 
      STA ID+7      AND SET IN WORD 7 
      SKP 
* 
*     SET UP SHORT ID SEGMENTS
* 
*  SET UP LOOP
      LDA ID+24     GET ID WORD 24
      ALF,ALF       SWAP BYTES
      RAR,RAR       POSITION # OF SEGMENTS INTO LOWER BITS
      AND B77       AND ISOLATE 
      SZA,RSS       ANY SEGMENTS? 
      JMP WRTID     NO, GO WRITE ID SEG INTO MEMORY 
      CMA,INA       SET # SEG NEGATIVE
      STA LPCNT     SAVE AS LOOP COUNTER
      CCA           SET INIT TO -1 TO CAUSE 
      STA INIT      SETPT TO INITIALIZE THE SECTOR BUFFER 
* 
      LDA $FWBG     GET BG BOUNDRY IN CASE REAL TIME
      STA ID+33     STORE IN PLACE OF HI SEGMENT
      LDA $BGBP     GET BG BP BOUNDRY IN CASE REAL TIME 
      STA ID+34     STORE IN PLACE OF HI SEGMENT BP 
* 
      LDA ID+24     GET MAIN LOW BASE PAGE ADDRESS
      AND B1777     ISOLATE LOW BASE PAGE 
      STA B         AND PUT INTO B
      LDA ID+25     GET MAIN HIGH BASE PAGE + 1 ADDRESS 
      AND B1777       AND ISOLATE IT
      STA HMNBP     STORE FOR LOOP IN HI MAIN BASE PAGE 
      JSB BUMP      POSITION TRACK AND SECTOR TO SEGMENT 0
* 
LOOP  JSB SETPT     SET UP POINTERS TO SHORT ID SEGMENT 
      LDA SECTR     GET CURRENT SECTOR OF THE SEGMENT'S MAIN
      STA SID7,I    STORE IT IN THE SHORT ID WORD 7 
      LDB TRACK     GET CURRENT TRACK OF THE SEGMENT'S MAIN 
      STB TR        SAVE A COPY TO CALCULATE BP OFFSET
      ADB NEGMN     SUBTRACT THE MAIN'S TRACK TO GET OFFSET 
      LDA M256      TEST WHETHER OFFSET IS GREATER THAN 255 
      ADA B           AND WON'T FIT IN A BYTE 
      SSA,RSS       OK? 
      JMP ERR39     NO, EXIT, CAN'T SET IT UP 
      LDA SID3,I    GET LAST LETTER OF NAME AND 
      AND UBYTE     ISOLATE IT
      IOR B         PUT TRACK OFFSET IN WORD 3
      STA SID3,I    AND STORE IT BACK 
* 
*  SET UP FOR SEGMENT'S BASE PAGE 
* 
      LDA SID5,I    GET THE SEGMENT'S MAIN HIGH ADDRESS + 1 
      LDB ID+22     USE THE MAIN'S HIGH ADDRESS AS LOW
      JSB BUMP      UPDATE THE DISC POINTERS
      ALF,ALF       POSITION THE BP SECTOR IN THE UPPER BYTE
      IOR SID7,I    PUT IN THE SEGMENT'S MAIN SECTOR
      STA SID7,I    AND STORE BACK IN WORD 7
      LDB TR        GET SEGMENT'S MAIN TRACK
      CMB,INB       AND SET IT NEGATIVE 
      ADB TRACK     ADD THE SEGMENT'S BP TRACK
      LDA M64       TEST IF GREATER THAN 64 
      ADA B 
      SSA,RSS       TOO BIG?
      JMP ERR39     YES, EXIT.  CAN'T SET IT UP 
      BLF,BLF       POSITION TRACK OFFSET TO UPPER
      RBL,RBL         SIX BITS
      LDA SID6,I    GET HIGH BP ADDRESS + 1 IN A
      AND B1777     ISOLATE HIGH BP ADDRESS + 1 
      ADB A         PUT BP TRACK OFFSET IN
      STB SID6,I    AND REPLACE IN WORD 6 
* 
*  NOW BUMP DISC ADDRESS TO NEXT SEGMENT
* 
      LDB HMNBP     LOAD MAIN'S BP ADDRESS (A REG ALREADY SET)
      JSB BUMP      NOW UPDATE DISC ADDRESSES 
* 
*  CALCULATE THE SHORT ID'S CHECKSUM
* 
      LDA SID1      PUT THE SHORT ID SEGMENT'S ADDRESS
      STA SIDAD     INTO CALL FOR CHECKSUM
      CLA           CLEAR PENDING SUM 
      JSB SUM       CALCULATE SUM OF SHORT
SIDAD NOP           BEGINNING ADDRESS OF SHORT ID SEGMENT 
      DEC -7          TO WORD 7 
      STA SID8,I    STORE IN WORD 8 
* 
*  CHECK COUNT
* 
      ISZ LPCNT     DONE YET? 
      JMP LOOP      NO, DO NEXT SEGMENT 
* 
*  WRITE OUT LAST SECTOR
* 
      LDA ENDSB     GET ADDRESS OF THE END OF THE SECTOR BUFFER 
      ADA M8        AND SUBTRACT 8 AND STORE IN SID1.  THIS WILL
      STA SID1      FORCE A WRITE OF THE CURRENT SECTOR.
      JSB SETPT     NOW CALL TO DO WRITE
      SKP 
* 
*     GO PRIVILEGED TO WRITE THE ID SEGMENT 
* 
* 
WRTID JSB $LIBR     GO PRIVILEGED TO PREVENT
      NOP           CONFLICTS WITH OTHER ROUTINES 
* 
      JSB IDSGA     SEARCH FOR DUPLICATE PROGRAM NAMES
      DEF *+2 
      DEF NAME,I
      SEZ,CME       IF NOT FOUND, CLEAR E-REG AND A-REG 
      JMP RTPRG     AND GO FIND A BLANK ID SEGMENT
      LDA .23       IF FOUND, RETURN FMGR 23 ERROR
      JMP PEXIT       WITH E-REG = 1
* 
*  TEST FOR REAL-TIME PROGRAM MEMORY CONFLICT 
* 
RTPRG JSB IDMEM     TEST FOR REAL-TIME MEMORY BOUNDS
      DEF *+2         CONFLICTS 
      DEF IDBUF     PASS IT THE BUILT UP ID SEGMENT 
      CCE,SZA,RSS   IF NO CONFLICT FOUND (OR NOT REAL-TIME) 
      JMP SERCH      THEN SEARCH FOR FREE ID SEGMENT
      LDB A         PUT NAME ADDRESS IN B 
      LDA .40       OTHERWISE EXIT WITH FMGR 40 ERROR 
      JMP PEXIT       WITH E-REG = 1
* 
*  SEARCH FOR FREE ID SEGMENT 
* 
SERCH JSB IDSGA     CALL FOR MATCH OF BLANK NAME
      DEF *+2 
      DEF ZERO      ARRAY OF THREE ZEROS
      SEZ,RSS       IF FOUND, GO MOVE ID DOWN 
      JMP MOVE
      LDA .14       OTHERWISE, EXIT.  FMGR 14 
      JMP PEXIT       E-REG = 1 
* 
*  MOVE ID SEGMENT INTO SYSTEM
* 
MOVE  STA B         SAVE COPY OF ID ADDRESS 
      ADA .28       POINT TO WORD 29
      LDA A,I       GET THE WORD WITH SEQUENCE NUMBER 
      AND B170K     ISOLATE SEQUENCE NUMBER 
      IOR CONLU     SET IN USER'S CONSOLE 
      STA ID+29     AND SET BACK INTO ID 29 
* 
      LDA DEFID     SET A TO SOURCE (B TO DESTINATION)
      JSB .MVW      MOVE THE ID SEGMENT 
      DEF .30 
      NOP           (FOR COMPATIBILITY) 
      CLA,CLE       SET UP FOR GOOD RETURN
* 
PEXIT JSB $LIBX     DONE! 
      DEF *+1 
      DEF EXIT
      SKP 
* 
*  SETPT (SET UP POINTERS TO SHORT ID SEGMENT) - SETS UP POINTERS 
*  SID1,SID3,SID5,SID6,SID7,SID8 TO THE CORRESPONDING WORDS IN THE
*  CURRENT ID SEGMENT.  WILL WRITE OUT AND READ NEXT SECTOR IF
*  NECESSARY. 
* 
*  ON ENTRY IF INIT = -1, INITIALIZES SUBROUTINE AND CLEARS INIT. 
*  USES VARIBLES SECBF(128)   SECTOR BUFFER 
*                SEKTR        DISC ADDRESS TO READ
*                TRAK           WRITE TO
*                SEC/T        NUMBER OF SECTORS/TRACK 
* 
SETPT NOP 
      ISZ INIT      IS THIS THE INITIALIZE CALL?
      RSS           NO, GO SET UP ID POINTERS 
      JMP REED      YES, GO READ SECTOR WITH SHORT ID SEGMENTS
* 
      LDA SID1      GET CURRENT SHORT ID POINTER
      ADA .8          AND POINT TO THE NEXT ID
      CPA ENDSB     AT THE END OF THE SECTOR? 
      JMP RITE        THEN WRITE IT OUT AND READ THE NEXT BLOCK 
SET   STA SID1        ELSE, STORE FOR WORD 1
      ADA .2        ADD 2 FOR 
      STA SID3        WORD 3
      ADA .2        ADD 2 FOR 
      STA SID5        WORD 5
      INA           INCREMENT 
      STA SID6      FOR WORD 6
      INA           INCREMENT 
      STA SID7      FOR WORD 7
      INA           INCREMENT 
      STA SID8      FOR WORD 8
      JMP SETPT,I   EXIT
* 
* 
RITE  JSB EXEC      WRITE OUT SECTOR CONTAINING UPDATED 
      DEF *+7         SHORT ID SEGMENTS 
      DEF .2        WRITE 
      DEF PDSLU     PROTECTED DISC LU 
      DEF SECBF     SECTOR BUFFER 
      DEF .128      WHOLE SECTOR
      DEF TRAK      DISC TRACK
      DEF SEKTR     DISC SECTOR 
      CPB .128      CHECK FOR COMPLETE TRANSMISSION 
      RSS           OK, GO READ 
      JMP ER01      DISC ERROR, EXIT
* 
REED  LDA SEKTR     GET CURRENT SECTOR ADDRESS
      ADA .2        INCREMENT TO THE NEXT SECTOR (64 WORD)
      CPA #SC/T     OVERFLOW THIS TRACK?
      CLA,RSS       YES, SET SECTOR TO 0
      RSS           NO, SKIP TRACK INCREMENT
      ISZ TRAK      INCREMENT TRACK ADDRESS 
      STA SEKTR     STORE SECTOR ADDRESS
      JSB EXEC      READ NEXT SECTOR FROM THE DISC
      DEF *+7         WHICH CONTAINS THE SHORT ID SEGMENTS
      DEF .1        READ
      DEF PDSLU     PROTECTED DISC LU 
DSCBF DEF SECBF     SECTOR BUFFER 
      DEF .128      WHOLE SECTOR
      DEF TRAK      DISC TRACK
      DEF SEKTR     DISC SECTOR 
      CPB .128      CHECK FOR COMPLETE TRANSMISSION 
      RSS           OK
      JMP ER01      DISC ERROR, EXIT
* 
      LDA DSCBF     GET ADDRESS OF SECTOR BUFFER
      JMP SET         AND SET UP NEW POINTERS 
      SKP 
* 
* BUMP - BUMP DISC POINTERS TO POINT AT THE VARIOUS MAINS, BASE PAGES,
* AND SEGMENTS CONTAINED WITHIN A TYPE 6 FILE.
* 
* 
*    CALLING SEQUENCE:
*                      A = HIGH ADDRESS + 1 
*                      B = LOW ADDRESS
*                      JSB BUMP 
*                      A = SECTOR   AND   SECTR = SECTOR
*                      B = TRACK    AND   TRACK = TRACK 
*                                         SEC/T = SECTORS/TRACK 
* 
* 
BUMP  NOP 
      CMB,INB       SET THE LOW ADDRESS NEGATIVE
      ADA B         AND ADD TO HIGH ADDRESS.  A = PROGRAM SIZE
      CLB           CLEAR B FOR DIVIDE
      DIV .128      DIVIDE BY 128 FOR NUMBER OF SECTORS 
      SZB           IF REMAINDER IS ZERO, SKIP
      INA           OTHERWISE ADD ONE TO SECTOR COUNT FOR A PARTIAL SECTOR
      ADA SECTR     ADD IN CURRENT SECTOR 
      CLB           CLEAR B FOR DIVIDE
      DIV SEC/T     DIVIDE BY SECTORS/TRACK 
      STB SECTR     STORE REMAINDER AS SECTOR 
      ADA TRACK     AND ADD QUOTIENT TO TRACK ADDRESS 
      STA TRACK     AND SAVE AS CURRENT TRACK ADDRESS 
      SWP           PUT SECTORS IN A AND TRACK IN B 
      JMP BUMP,I    RETURN
      SKP 
* 
*     SUM - USED TO SUM THE WORDS IN ID SEGMENTS FOR CHECKSUM TESTS 
* 
* 
SUM   NOP           P+1 = ADDRESS, P+2 = NEGATIVE NUMBER OF WORDS 
      LDB SUM,I 
      ISZ SUM 
      STB #MOVE     SAVE START SUMMING ADDRESS
      LDB SUM,I     GET NUMBER OF WORDS 
      ISZ SUM       POINT TO RETURN ADDRESS 
      ADA #MOVE,I   ACCUMULATE THE SUM
      ISZ #MOVE     BUMP TO NEXT WORD 
      INB,SZB       DONE? 
      JMP *-3       NO, ADD THE NEXT
      JMP SUM,I     YES, RETURN 
      SKP 
* 
*     CONSTANTS 
* 
DZERO DEF ZERO
ZERO  NOP           THIS ARRAY IS USED TO FIND
      NOP             A BLANK 
      NOP             ID SEGMENT
B77   OCT 77
.3    DEC 3 
.4    DEC 4 
.1    DEC 1 
.34   DEC 34
.19   DEC 19
.11   DEC 11
M64   DEC -64 
UBYTE OCT 177400
IDBIT OCT 2000
.39   DEC 39
.40   DEC 40
.99   DEC 99
B1777 OCT 1777
B7700 OCT 7700
M256  DEC -256
M8    DEC -8
.23   DEC 23
.14   DEC 14
.28   DEC 28
B170K OCT 170000
.30   DEC 30
.8    DEC 8 
.2    DEC 2 
.128  DEC 128 
* 
*     VARIBLES
* 
LU    NOP           DISC LU 
PDSLU NOP           PROTECTED DISC LU 
IDBUF BSS 34        ID SEGMENT BUFFER 
ID    EQU IDBUF-1 
TRACK NOP           TRACK WORD FOR BUMP 
SECTR NOP           SECTOR WORD FOR BUMP
TRAK  NOP           TRACK WORD FOR SETPT
SEKTR NOP           SECTOR WORD FOR SETPT 
SEC/T NOP           SECTORS/TRACK FOR DISC 'LU' 
#SC/T NOP           LOGICAL SECTORS PER TRACK 
NEGMN NOP           NEGATIVE VALUE OF MAIN TRACK
HMNBP NOP           HIGH MAIN BASE PAGE ADDRESS 
SECBF BSS 128       SECTOR BUFFER 
ENDSB DEF *         END OF SECTOR BUFFER ADDRESS
LPCNT NOP           LOOP COUNTER
TR    NOP           TEMPORARY TRACK WORD
SID1  NOP           SHORT ID POINTER TO WORD 1
SID3  NOP           SHORT ID POINTER TO WORD 3
SID5  NOP           SHORT ID POINTER TO WORD 5
SID6  NOP           SHORT ID POINTER TO WORD 6
SID7  NOP           SHORT ID POINTER TO WORD 7
SID8  NOP           SHORT ID POINTER TO WORD 8
CONLU NOP           CONSOLE LU
#MOVE NOP           USED BY SUM 
INIT  NOP           INITIALIZATION FLAG USED BY SETPT 
* 
* 
A     EQU 0 
B     EQU 1 
END   EQU * 
      END 
                                                                                              