ASMB,R,L,C
      HED FCLOS 91741-16010 REV 1740 770317 * (C) HEWLETT-PACKARD CO. 1977
      NAM FCLOS,7 91741-16010 REV 1740 770317 
      SPC 1 
******************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS      *
*  * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,       *
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
*  * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY.   *
******************************************************************
      SPC 2 
      ENT FCLOS,FRDSK,FRLAB,FWLAB,FSPAC,FPOIN,FCNTL 
      ENT FSTMD,FRNAM,FRLAT,FLOCK,FUNLK 
* 
      EXT D$RQB,D$NWD 
      EXT .ENTR,D$INI,D$RFH,D$STW,D$PRM,D3KMS 
      EXT D$ERR,D$WDC,D$NWD,D$ASC,D$IPM,D$SPM 
* 
* FCLOS 
* SOURCE: 91741-18010 
* BINARY: 91741-16010 
* JIM HARTSELL
* AUG. 13, 1975 
* 
A     EQU 0 
B     EQU 1 
* 
FCLOS NOP           FCLOSE. 
      JSB ENTRY 
      OCT 203 
* 
FRDSK NOP           FREADSEEK.
      JSB ENTRY 
      OCT 501 
* 
FRLAB NOP           FREADLABEL. 
      JSB ENTRY 
      OCT 1001
* 
FWLAB NOP           FWRITELABEL.
      JSB ENTRY 
      OCT 1101
* 
FSPAC NOP           FSPACE. 
      JSB ENTRY 
      OCT 1302
* 
FPOIN NOP           FPOINT. 
      JSB ENTRY 
      OCT 1401
* 
FCNTL NOP           FCONTROL. 
      JSB ENTRY 
      OCT 1703
* 
FSTMD NOP           FSETMODE. 
      JSB ENTRY 
      OCT 2002
* 
FRNAM NOP           FRENAME.
      JSB ENTRY 
      OCT 2101
* 
FRLAT NOP           FRELATE.
      JSB ENTRY 
      OCT 2202
* 
FLOCK NOP           FLOCK.
      JSB ENTRY 
      OCT 2302
* 
FUNLK NOP           FUNLOCK.
      JSB ENTRY 
      OCT 2401
* 
* ALL ENTRY POINTS CONVERGE HERE. 
* 
ENTRY NOP 
      LDA ENTRY,I   SAVE FUNCTION CODE. 
      ALF,ALF 
      RAL,RAL 
      AND B77 
      STA FCN 
      LDA ENTRY,I   SAVE # OF INITIAL PARAMS. 
      AND B77 
      CMA,INA 
      STA NUM 
      CLA           CLEAR OLD PARAM ADDRESSES.
      STA PRAMS 
      STA PRAMS+1 
      STA PRAMS+2 
      STA PRAMS+3 
      LDA ENTRY     GET ADDR OF USER'S JSB + 1. 
      ADA N2
      LDA A,I 
      STA RETRN     SET UP FOR .ENTR CALL.
      JMP BEGIN 
* 
PRAMS NOP 
      NOP 
      NOP 
      NOP 
* 
RETRN NOP           COMMON ENTRY POINT. 
BEGIN JSB .ENTR     GET ADDRESSES OF USER PARAMS. 
DPRAM DEF PRAMS 
* 
      CLA           CLEAR ERROR CODE FOR FCHEK. 
      CLB 
      DST D$ERR 
* 
* BUILD FRONT END OF REQUEST BUFFER.
* 
      LDA DPRAM     ADDR OF 1ST PARAM TO SEND.
      JSB D$INI     INITIALIZE BUFFER STUFFERS. 
* 
      JSB D$RFH     SET UP FIXED FORMAT.
* 
      LDA FCN 
      JSB D$STW     STORE FUNCTION CODE IN REQUEST. 
* 
* MOVE USER PARAMS TO REQUEST BUFFER. 
* 
      LDA NUM       MOVE INITIAL PARAMETERS.
      JSB D$PRM 
* 
* PERFORM SPECIAL HANDLING FOR CERTAIN FILE CALLS.
* 
      LDA FCN 
      CPA B5
      JMP F5        FREADSEEK.
      CPA B10 
      JMP F11       FREADLABEL. 
      CPA B11 
      JMP F11       FWRITELABEL.
      CPA B14 
      JMP F5        FPOINT. 
      CPA B21 
      JMP F21       FRENAME.
      JMP STWD
* 
F5    LDA N2        FREADSEEK:
      JSB D$NWD       MOVE RECNUM.
      JMP STWD
* 
F11   CLA           FWRITELABEL AND FREADLABEL: 
      LDA PRAMS+2,I 
      JSB D$STW       STORE TCOUNT (+WORDS).
      CLA             (A) CLEARED IN CASE NO PARAM. 
      LDA PRAMS+3,I 
      JSB D$STW       STORE LABELID.
* 
      LDA DPRAM     SET UP PARAMETER MASK.
      STA TEMP
      LDA N4        MAX. NUMBER OF PARAMS.
      STA TEMP1 
      CLA,RSS 
MSK   RAL           SHIFT ACCUMULATED BITS. 
      LDB TEMP,I    SEE IF PARAM GIVEN. 
      SZB 
      IOR B1        YES. SET THE BIT. 
      ISZ TEMP
      ISZ TEMP1 
      JMP MSK       LOOP TILL DONE. 
* 
      JSB D$STW       STORE MASK. 
      LDA FCN       DONE IF FREADLABEL. 
      CPA B10 
      JMP STWD
      LDA PRAMS+1   FWRITELABEL.
      SZA,RSS 
      JMP STWD       NO TARGET ADDRESS. 
      CLA            CLEARED IN CASE NO PARAM.
      LDA PRAMS+2,I 
      SZA,RSS 
      JMP STWD       TCOUNT IS ZERO OR NOT GIVEN. 
      SSA 
      ARS            NEG BYTES. MAKE NEG WORDS. 
      SSA,RSS 
      CMA,INA        POS WORDS. MAKE NEG WORDS. 
      JSB D$NWD     STORE LABEL.
      JMP STWD
* 
F21   LDA PRAMS+1   FRENAME:
      LDB N14 
      SZA           SKIP IF NO FILE NAME. 
      JSB D$ASC       STORE NEW FILE NAME.
* 
STWD  JSB D$WDC     SET WORD COUNT. 
* 
* REQUEST BUFFER READY. SEND TO QUEX'S CLASS, 
* AND WAIT FOR REPLY. 
* 
      JSB D3KMS     SHIP REQUEST BUFFER TO QUEX.
      DEF *+2 
      DEF BIT15     NO ABORT. 
      JMP ABERR     ERROR RETURN. 
* 
* PASS ANY RETURN PARAMETERS TO USER. 
* 
      STA TEMP      SAVE STATUS WORD. 
* 
      LDA FCN       CHECK TYPE OF CALL. 
      CPA B10 
      JMP FF10
      CPA B17 
      JMP FF17
      CPA B22 
      RSS 
      JMP RET 
* 
      LDB D$RQB     FRELATE:
      ADB D9
      LDA B,I         PASS
      JMP RETRN,I     (A) = INT-OR-DUP WORD.
* 
FF17  LDB D$RQB     FCONTROL: 
      ADB D9
      LDB B,I         GET RETURN PARAMETER. 
      LDA PRAMS+2 
      SZA 
      STB A,I         PASS TO CALLER. 
      JMP RET 
* 
FF10  LDA PRAMS+1   IF NO TARGET ADDR,
      SZA,RSS 
      JMP RET        DON'T PASS LABEL.
      LDA DPRAM     FREADLABEL: 
      INA 
      LDB D$RQB 
      ADB D9
      JSB D$IPM       INITIALIZE PARAM PASSERS. 
* 
      LDA D$RQB       DETERMINE # WORDS IN LABEL. 
      ADA B7
      LDA A,I 
      ADA N1           # BYTES -1 (DELETE STATUS WORD). 
      ARS              # WORDS. 
      CMA,INA          NEG. # WORDS.
      SZA              SKIP IF NO LABEL RETURNED. 
      JSB D$SPM        PASS N-WORD PARAM. 
* 
RET   LDA TEMP      RESTORE STATUS WORD.
* 
      JMP RETRN,I   RETURN TO USER. (A) = STATUS. 
* 
ABERR DST D$ERR     STORE CODE FOR FCHEK RETRIEVAL. 
      CLA 
      JMP RETRN,I   RETURN. 
      SKP 
* 
* CONSTANTS AND WORKING STORAGE.
* 
B1    OCT 1 
B5    OCT 5 
B7    OCT 7 
B10   OCT 10
B11   OCT 11
B14   OCT 14
B17   OCT 17
B21   OCT 21
B22   OCT 22
B77   OCT 77
N1    DEC -1
N4    DEC -4
D9    DEC 9 
N2    DEC -2
N14   DEC -14 
BIT15 OCT 100000
TEMP  NOP 
TEMP1 NOP 
FCN   NOP 
NUM   NOP 
* 
      END 
                                                                                                                                                                                                