ASMB
      HED .      TMS-FMP CALL   SAVE AND RESTORE DCB
      NAM TMFMP,7 92903-16100 REV.1913  781218
  SPC 3 
**********************************************************************
*                                                                    *
*     NAME:   TMFMP     TMS-FMP CALL                                 *
*     ENT:    TDCBS,TDCBR,TDCBC                                      *
*     SOURCE: &TMFMP    92903-18107                                  *
*     BINARY: %TMFMP    ----NONE---    PART OF  %TMSLB  92903-16100  *
*                                                                    *
*     PGMR:   FRANCOIS GAULLIER                                      *
*                                                                    *
**********************************************************************
      SPC 2 
*     **************************************************************
*     * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  ALL RIGHTS    *
*     * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
*     * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
*     * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
*     **************************************************************
  SPC 3 
      ENT TDCBS,TDCBR,TDCBC 
      EXT $TML7,.ENTR,WRITF,CLOSE,EXEC,LOCF,ICRLU 
* 
A     EQU 0 
B     EQU 1 
      SUP 
   SKP
*     THIS CODE PROVIDES TWO SUBROUTINES TO SAVE AND RESTORE
*     THE DCB BUFFER USED BY THE FMP CALLS. 
* 
*     WHEN THE FILE HAS BEEN SUCCESSFULY OPEN OR CREATED, THE 
*     USER SAVES THE DCB INTO SAM USING 'TDCBS', THE NEXT TIME THE USER 
*     WANTS TO ACCESS THAT FILE HE RESTORES THE DCB USING 'TDCBR' 
* 
* 
*     TDCBS  - RECORD FILE NAME IN THE DIRECTORY IF A NEW FILE
*              AND SAVE CORRESPONDING DCB IF DCB IS OPEN. 
*              IF THE CR# IS NOT SPECIFIED (=0), TMS-FMP WILL TAKE
*              THE FILE FROM THE DIRECTORY IF IT EXIST INSTEAD OF 
*              TAKING THE FILE FROM THE 1ST MOUNTED CR. 
*              IF THE CR# IS NOT SPECIFIED, TMS-FMP WILL RETURN 
*              THE CR# INTO NAME(4).
*     TDCBR  - RESTORE THE DCB CORRESPONDING TO THE FILE NAME 
*     TDCBC  - CLOSE THE FILE CORRESPONDING TO THE FILE NAME
* 
*     CALLING SEQUENCE: 
*    -------------------
* 
*             IF ( TDCBS(FNAME,IDCB [,IERR] ) )  GOTO ERROR 
* 
*                   FNAME - FILE NAME INFORMATION (5 WORDS LONG)
*                           FNAME[1:3] ASCII FILE NAME
*                           FNAME[4:4] CARTRIDGE REFERENCE NUMBER 
* 
*                   IDCB  - DCB BUFFER SET UP BY  OPEN OR CREAT FMP CALL
*                           DCB SIZE IS ASSUMED TO BE  144 WORDS. 
* 
*                   IERR  - OPTIONAL PARAMETER WHERE THE ERROR CODE 
*                           IS RETURNED.
*                           = -1  THE FILE IS ALREADY IN THE DIRECTORY, 
*                                 THE DCB IS ALREADY SAVED. 
*                           = -2  THE FILE IS NOT IN THE DIRECTORY, THE 
*                                 DCB IS NOT OPEN, NOTHING HAS BEEN SAVED.
*                           = -3  DIRECTORY OVERFLOW (MORE THAN 15 FILES) 
* 
* 
*             IF( TDCBR(FNAME,IDCB [,IERR] ) )   GOTO ERROR 
* 
*                   FNAME - FILE NAME, AS IN TDCBS CALL 
* 
*                   IDCB  - BUFFER WHERE THE DCB WILL BE RETURNED 
*                           DCB SIZE IS ASSUMED TO BE  144 WORDS. 
* 
*             ERROR RETURN IF TRY TO RESTORE THE DCB OF A FILE THAT HAS 
*             NOT BEEN SAVED. 
* 
  SKP 
* 
*             IF( TDCBC(FNAME) )  GOTO ERROR
* 
*                   FNAME - FILE NAME AS IN TDCBS CALL
* 
*             ERROR RETURN IF TRY TO CLOSE A DCB OF A FILE THAT HAS NOT 
*             BEEN SAVED, OR FROM A DIFFERENT PROGRAM THAT THE ONE USED 
*             TO OPEN THE FILE. 
* 
  SPC 2 
*     FORMAT OF THE DIRECTORY:
*    -------------------------- 
* 
*     6 WORDS PER ENTRY.        15 ENTRIES MAX.  --->  15*6=90 WORDS FOR
*                                                      THE DIRECTORY BUFFER.
* 
* 
*     FILE NAME    -  3 WORDS 
*     CR #         -  1 WORD
*     CLASS I/O #  -  1 WORD
*     IDSEG ADDR.  -  1 WORD
* 
*     THE CLASS I/O WORD IS THE CLASS I/O USED TO SAVE THE DCB INTO SAM.
*     EACH FILE HAS A DIFFERENT CLASS AND THE DCB IS THE ONLY BUFFER QUEUE
*     ON THAT CLASS.
*        BIT15 OF CLASS WORD INDICATE IF THE DCB HAS BEEN SAVED INTO SAM
*              OR NOT.
*              = 0   THE DCB IS IN THE USER BUFFER (HAS BEEN RESTORED)
*              = 1   THE DCB IS INTO SAM (HAS BEEN SAVED) 
*        BIT13 OF CLASS WORD IS SET/RESET TO NOT-DEALLOCATE/DEALLOCATE THE
*              CLASS AS NEEDED. 
*        THE USER ADDR OF THE DCB IS SAVED/RESTORED USING THE 1ST PARAM 
*        OF THE CLASS I/O CALL. THIS ADDR IS NEEDED WHEN THE DCB IS RESTORED
*        TO ADJUST THE ABSOLUTE ADDR WHICH IS HELD IN DCB(13).
* 
*     THE IDSEG ADDR IS KEPT IN THE DIRECTORY FOR 2 REASONS:
*        - DCB(10) MUST HAVE THE IDSEG ADDR OF THE PROGRAM THAT ISSUES THE
*          FMP CALL. (THIS IS THE OPEN FLAG). THIS SET OF SUBROUTINE RESTORES 
*          DCB(10) AS NEEDED. 
*        - ONLY THE PROGRAM THAT OPEN THE FILE, CAN CLOSE THE FILE. TMS-FMP 
*          WILL CLOSE THE FILE ONLY WHEN THE UPT THAT OPEN THAT FILE IS 
*          SCHEDULED TO COMPLETE. TMS-FMP WILL REJECT  TDCBC  CALL IF NOT 
*          ISSUE FORM THE UPT THAT OPEN THAT FILE.
   SKP
TDCBC NOP           CLOSE ONE FILE
      LDB *-1 
      LDA .DCB      SET LOCAL DCB ADDR
      STA .IDCB 
      LDA DM2 
      JMP TDCB. 
  SPC 2 
TDCBS NOP           DCB SAVE ENTRY POINT
      LDB *-1 
      LDA D2
      JMP TDCB. 
  SPC 2 
TDCBR NOP           DCB RESTORE ENTRY POINT 
      LDB *-1 
      CLA,INA 
TDCB. STA FLAG      SET REQUEST TYPE FLAG 
      STB TDCB      SET RETURN ADDR 
      JMP TDCB+1    GO EXECUTE .ENTR
* 
DM2   DEC -2
FLAG  NOP 
   SPC 5
.NAME NOP           ADDR OF FILE NAME (5 WORDS LONG)
.IDCB NOP           ADDR OF THE DCB 
.IER  DEC 0 
TDCB  NOP           DUMMY ENTRY POINT 
      JSB .ENTR     GET PARAMETERS ADDR 
      DEF .NAME 
* 
      LDA .CLS      CLOSE ROUTINE ADDR
      JSB $TML7     PASS IT TO 'TMLIB' AND
* 
      LDB .NAME     SAVE USER ADDR OF THE CR# 
      ADB D3
      STB .CR#
  SPC 1 
TDCB3 STA CLASS     GET FROM TMLIB THE TMS-FMP CLASS I/O
      CCE           READ IN THE FILE DIRECTORY
      JSB SAMIO     FROM SAM
.DIRB DEF DIRBU     BUFFER ADDR 
D90   DEC 90        BUFFER LENGTH 
      CPB D1        DIRECTORY LENGTH = 1 ?
      CLB           YES, SET IT TO ZERO 
      STB DIRLN     AND SAVE DIRECTORY LENGTH 
* 
      LDA .DIRB     SET UP END OF DIRECTORY ADDR
      ADA DIRLN 
      STA .DIRE 
  SPC 1 
      LDA FLAG      RECALL REQUEST FLAG 
      CPA DM1       CLOSE ALL FILES REQUEST ? 
      JMP RSTSV     YES, DO NOT SEARCH INTO THE DIRECTORY 
  SPC 1 
      LDA .DIRB     SEARCH INTO THE DIRECTORY FOR THE FILE NAME 
ADD02 STA DIRPT     SAVE DIRECTORY POINTER
      CPA .DIRE     END OF DIRECTORY ?
      JMP ADD20     YES, IT IS A NEW FILE 
      LDB .NAME     SEARCH INTO THE DIRECTORY 
      CMW D3        COMPARE WORD ?
      JMP ADD05     YES, FOUND IT 
      NOP           NO, CONTINUE SEARCHING
ADD04 LDA DIRPT     RECALL POINTER
      ADA DETL      AND GOTO NEXT ENTRY 
      JMP ADD02     TO LOOP UNTIL THE END 
* 
ADD05 LDB .CR#,I    GET THE CR# SUPPLY BY THE USER
      SZB,RSS       DEFINED ? 
      JMP ADD10     NO, GET THE ONE FROM THE DIRECTORY
      CPB A,I       YES, IS IT THE ONE THAT IS IN THE DIRECTORY ? 
      JMP RSTSV     YES, IT IS EXACTLY THE SAME FILE. 
      JMP ADD04     NO, RESUME THE SCAN OF THE DIRECTORY
* 
ADD10 LDB A,I       GET THE CR# FROM THE DIRECTORY
      STB .CR#,I    AND RETURN IT TO THE USER.
      JMP RSTSV     GO RESTORE THE DCB
   SPC 2
ADD20 LDA FLAG      THE FILE IS NOT FOUND, RECALL RQ FLAG 
      CPA D2        SAVE REQUEST ?
      RSS           YES, SAVE IF DCB IS OPEN
      JMP ERR       NO, NOT SAVE RQ, MUST BE IN THE DIRECTORY 
* 
      LDA .IDCB     CHECK IF THE DCB IS OPEN
      ADA D9        ACCESS OPEN FLAG
      LDA A,I 
      CPA XEQT      DCB OPEN ?
      RSS           YES, SAVE THAT FILE 
      JMP ERR02     NO, RETURN DCB NOT OPEN ERROR 
* 
      LDA DIRLN     ADDITION OF A NEW FILE INTO THE DIRECTORY 
      CPA D90       DIRECTORY FULL ?
      JMP ERR03     YES, RETURN DIRECTORY FULL ERROR
      LDB DIRPT     NO, INSERT IT 
      LDA .NAME     AT THE END OF THE DIRECTORY 
      MVW D4
      STB CLWPT 
      CLA           INIT CLASS I/O WORD TO ZERO 
      STA B,I 
      INB 
      LDA XEQT      AND SAVE ID SEGMENT ADDR OF THE 
      STA B,I       PROGRAM THAT HAS DEFINED THE DCB (FOR THE CLOSE)
* 
      ADB DM2       NOW CHECK IF CR# WAS DEFINED
      STB TEMP      SAVE ADDR OF CR# IN THE DIRECTORY 
      LDA B,I       RECALL CR#
      SZA           DEFINED ? 
      JMP ADD28     YES, KEEP IT
      JSB LOCF      NO, RETREIVE THE LU AND THEN THE CR 
      DEF *+8 
      DEF .IDCB,I   DCB 
      DEF TEMP1     IERR
      DEF TEMP1     IREC
      DEF TEMP1     IRB 
      DEF TEMP1     IOFF
      DEF TEMP1     JSEC
      DEF LU#       JLU 
      SZA           FMP CALL OK ? 
      HLT 13B       NO, ERROR !!!!!!!!!!!!!!!!!!
      LDA LU#       YES, RECALL LU AND MAKE IT NEG
      CMA,INA       TO RETREIVE THE CR
      STA LU# 
      JSB ICRLU     GET CR FROM LU
      DEF *+2 
      DEF LU# 
      SSA           OK ?
      HLT 15B       NO, ERROR !!!!!!!!!!!!!!!!!!!!!!
      STA TEMP,I    YES, STORE CR# INTO THE DIRECTORY 
      STA .CR#,I    AND RETURN IT TO THE USER 
* 
ADD28 LDA DIRLN     UPDATE DIRECTORY LENGTH 
      ADA DETL
      STA DIRLN 
* 
      LDA CLWPT,I   RECALL CLASS I/O WORD 
      JMP SAV       AND GO TO SAVE THE DCB
  SPC 1 
DIRPT NOP 
CLWPT NOP 
XEQPT NOP 
LU#   EQU XEQPT 
.CR#  NOP 
D1    DEC 1 
D2    DEC 2 
D4    DEC 4 
NBT13 OCT 157777
DETL  DEC 6         DIRECTORY ENTRY LENGTH
DMETL DEC -6
DM1   DEC -1
DM3   DEC -3
  SPC 2 
RSTSV LDA DIRPT 
      ADA D4        SET THE CLASS WORD POINTER
      STA CLWPT 
      INA           SET THE IDSEG POINTER 
      STA XEQPT 
      CMA           CHECK LEGALITY OF THE FILE NUMBER 
      ADA .DIRE 
      SSA           FILE NUMBER OK ?
      JMP ERR       NO, RETURN ERROR
      LDA CLWPT,I   GET THE CLASS I/O WORD
      LDB FLAG      RECALL REQUEST FLAG 
      CPB D2        SAVE REQUEST ?
      JMP SAV       YES, GOTO SAVE THE DCB
      SSA,RSS       NO, IT IS RST/CLS, CLASS OK ? 
      JMP CLS75     NO, GO CHECK FOR CLOSE REQUEST
* 
      RAL,CLE,ERA   CLEAR BIT 15 OF CLASS WORD
      SSB,RSS       RESTORE REQUEST ? 
      JMP RST10     YES, GOTO RESTORE DCB 
      AND NBT13     NO, IT IS CLOSE, RELEASE THE CLASS
      LDB XEQT      AND VERIFY THAT IT IS THE GOOD PROGRAM
      CPB XEQPT,I   TO PERFORM THE CLOSE, OK ?
      JMP RST10     YES, GO RESTORE THE DCB 
      JMP CLS78     NO, TRY TO CLOSE THE NEXT FILE
* 
RST10 STA CLWPT,I   STORE BACK THE CLASS WORD, WITH BIT15=0 
      LDB .IDCB     TO INDICATE "DCB RESTORED"
      STB RST13     SET DCB ADDR
      CCE           READ FROM SAM 
      JSB SAMIO 
RST13 NOP           BUFFER ADDR 
      DEC 144       BUFFER LENGTH 
* 
      LDA .IDCB     MODIFIED DCB WORDS THAT MUST
      ADA D9        BE MODIFIED 
      LDB XEQT
      STB A,I 
      ADA D3
      LDB A,I 
      ADB .IDCB     ADD NEW STARTING ADDR 
      ADB PARM1     AND SUBSTRACT THE OLD ONE 
      STB A,I       TO GET THE NEW ABSOLUTE POINTER 
* 
      LDA FLAG      RECALL REQUEST FLAG 
      CPA DM1       IS IT CLOSE ALL FILE REQUEST ?
      JMP CLS40     YES, CONTINUE 
      CPA DM2       IS IT CLOSE ONE FILE ?
      JMP CLS45     YES, GO CLOSE THE FILE
      JMP OKRTN     NO, IT WAS A RESTORE, RETURN OK 
  SPC 2 
SAV   SSA           DCB ALREADY SAVED ? 
      JMP ERR       YES, RETURN ERROR TO CALLER 
* 
      LDB .IDCB     SET BUFFER ADDR 
      STB SAV13 
      CMB,INB       SAVE ALSO INTO SAM THE CURRENT
      STB PARM1     DCB ADDRESS 
      CLE           WRITE BUFFER TO SAM 
      JSB SAMIO 
SAV13 NOP           BUFFER ADDR 
      DEC 144       BUFFER LENGTH 
      LDA TEMP1     RECALL THE CLASS WORD 
      IOR =B120000  MERGE BIT15 TO INDICATE -DCB SAVED- 
      STA CLWPT,I   AND BIT13 TO NOT DEALLOCATE THE CLASS 
* 
      LDA .IDCB     MODIFIED DCB WORD TO
      ADA D9        "FREE" THAT DCB, SO IF IT IS
      CLB           RE-USED, THE SAVE FILE WILL NOT 
      STB A,I       BE CLOSED.
      JMP OKRTN 
   SPC 2
*                   SAVE DIRECTORY BUFFER INTO SAM AND
*                   RETURN TO THE USER THE STATUS.
* 
ERR03 LDA DM3       RETURN 'DIRECTORY FULL' ERROR CODE
      JMP RTRN
* 
ERR02 LDA DM2       RETURN 'DCB NOT OPEN' ERROR CODE
      JMP RTRN
* 
OKRTN CLA,RSS       RETURN 'SUCCESFUL OPERATION' STATUS 
* 
ERR   CCA           ERROR RETURN (VALUE= .TRUE.)
* 
RTRN  STA RTNVA 
   SPC 1
      LDA DIRLN     SAVE BACK DIRECTORY INTO SAM
      SZA,RSS       AJUST DIRECTORY LENGTH
      CLA,INA       BEFORE THE WRITE/READ CALL
      STA DIRLN 
      CLE           SEND DIRECTORY TO SAM 
      LDA CLASS     GET CLASS I/O WORD
      JSB SAMIO 
      DEF DIRBU     DIRECTORY BUFFER
DIRLN NOP           DIRECTORY LENGTH
   SPC 1
      LDA RTNVA     RECALL RETURN VALUE 
      STA .IER,I    SET ERROR CODE
      CLB           RESET ERROR ADDR
      STB .IER      FOR THE NEXT TIME (OPTIONAL PARAM)
      JMP TDCB,I    AND RETURN
* 
RTNVA NOP 
  HED  CLOSE ALL FILES RECORDED IN THE DIRECTORY
.CLS  DEF *+1 
      NOP           CLOSE ALL FILE ROUTINE ENTRY POINT
      LDB *-1       RECALL RETURN ADDR. 
      STB TDCB      SET UP RETURN ADDR. 
      CCB           SET FLAG FOR CLOSE ALL FILES REQUEST
      STB FLAG
      LDB .DCB      SET LOCAL DCB BUFFER
      STB .IDCB 
      LDB .DIRB     INITIALIZE DIRECTORY POINTER
      STB DIRPT 
      JMP TDCB3     GO GET DIRECTORY FROM SAM 
* 
CLS40 JSB WRITF     DCB HAS BEEN RESTORED 
      DEF *+5       WRITE AN EOF
      DEF .IDCB,I   DCB ADDR
      DEF TEMP      ERR CODE RETURNED HERE
      DEF *         BUFFER ADDR 
      DEF DM1       WRITE EOF 
      SSA           FMP CALL OK ? 
      HLT 17B       NO, ERROR !!!!!!!!!!!!!!!!!!!!!!!!! 
CLS45 JSB CLOSE     YES, CLOSE THE FILE 
      DEF *+2 
      DEF .IDCB,I   DCB ADDR
      SSA           FMP CALL OK ? 
      HLT 21B       NO, ERROR !!!!!!!!!!!!!!!!!!!!!!!!! 
* 
      LDA DIRPT     THE FILE HAS BEEN CLOSE, DELETE 
      ADA DETL      THE CORRESPONDING ENTRY FROM THE DIRECTORY
      LDB .DIRE     COMPUTE LENGTH TO MOVE
      CMB,INB 
      ADB A         IN ORDER TO SUPPRESS THAT ENTRY 
      CMB,INB 
      STB TEMP      SAVE WORD COUNT 
      SZB,RSS       MOVE NEEDED ? 
      JMP CLS42     NO, SKIP THE MOVE 
      LDB A         GET FORM ADDR 
      ADB DMETL     SET TO ADDR 
      MVW TEMP      AND REPACK THE DIRECTORY
CLS42 LDA DIRLN     UPDATE DIRECTORY LENGTH 
      ADA DMETL     AS WELL 
      STA DIRLN 
      LDA .DIRE     UPDATE ALSO END OF DIRECTORY
      ADA DMETL 
      STA .DIRE 
* 
      LDB FLAG      RECALL REQUEST FLAG 
      CPB DM2       WAS IT CLOSE ONE FILE REQUEST ? 
      JMP OKRTN     YES, RETURN 
* 
      JMP RSTSV     TRY TO CLOSE NEXT FILE IN THE DIRECTORY 
  SPC 1 
CLS75 CPB DM1       IS IT CLOSE ALL FILES REQUEST ? 
      RSS           YES, CONTINUE 
      JMP ERR       NO, ERROR RETURN
* 
CLS78 LDA DIRPT     GO TO NEXT FILE IN THE DIRECTORY
      ADA DETL
      STA DIRPT 
      JMP RSTSV 
   HED UTUILITY SUBROUTINE
SAMIO NOP           WRITE/READ DIRECTORY TO/FROM SAM
      CLB           B=LU
      SEZ           A=CLASS I/O, IF GET REQUEST SWAP A&B
      SWP 
      DST TEMP1     AND SAVE CLASS I/O AND LU 
      LDA D20       SET UP REQUEST CODE (20 FOR WRITE/READ) 
      SEZ           IF GET REQUEST
      INA           SET UP GET RCODE (21) 
      STA TEMP
      LDA SAMIO,I   GET BUFFER ADDR 
      STA SAMI3     AND SET BUFFER ADDR 
      ISZ SAMIO     PREPARE FOR BUFFER LENGTH 
* 
      JSB EXEC      WRITE/READ OR GET REQUEST 
      DEF *+8 
      DEF TEMP      RQ
      DEF TEMP1+1   LU OR CLASS 
SAMI3 NOP           BUFFER ADDR.
      DEF SAMIO,I   BUFFER LENGTH 
      DEF PARM1 
      DEF PARM2 
      DEF TEMP1     CLASS OR 3RD PARAM
* 
      ISZ SAMIO     AJUST RETURN ADDR 
      SSA           EXEC CALL OK ?
      HLT 23B 
      JMP SAMIO,I   RETURN
  SPC 1 
CLASS NOP 
PARM1 NOP 
PARM2 NOP 
TEMP  NOP 
TEMP1 BSS 2 
* 
.DCB  DEF *+1 
      BSS 144 
DIRBU BSS 90        (15 FILES MAX)
.DIRE NOP 
  SPC 1 
D20   DEC 20
D9    DEC 9 
D3    DEC 3 
  SPC 2 
XEQT  EQU 1717B 
  SPC 1 
      UNS 
      ORG *         DEFINE LAST LOCATION
      END 
                                                                                                        