ASMB,R,L,C
      HED FCHEK 91741-16009 REV 1740 770317 * (C) HEWLETT-PACKARD CO. 1977
      NAM FCHEK,7 91741-16009 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 FCHEK 
* 
      EXT .ENTR,D$INI,D$RFH,D$STW,D$PRM,D3KMS 
      EXT D$ERR,D$WDC,D$RQB,D$IPM,D$NPM,D$SPM 
* 
* FCHEK 
* SOURCE: 91741-18009 
* BINARY: 91741-16009 
* JIM HARTSELL
* AUG. 13, 1975 
* 
FCHEK NOP           ENTRY POINT.
      CLA 
      STA PRAMS     CLEAR OLD PARAM ADDRESSES.
      STA PRAMS+1 
      STA PRAMS+2 
      STA PRAMS+3 
      STA PRAMS+4 
      LDA FCHEK 
      STA ENTRY 
      JMP BEGIN 
* 
PRAMS NOP           FILE NUMBER.
      NOP           ERROR CODE. 
      NOP           TRANSMISSION LOG. 
      NOP           BLOCK # (DBL-WORD). 
      NOP           # RECORDS IN BAD BLOCK. 
* 
ENTRY NOP           ENTRY POINT.
BEGIN JSB .ENTR     GET ADDRESSES OF USER PARAMS. 
DPRAM DEF PRAMS 
* 
* 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 B16 
      JSB D$STW     FCHEK CODE = 16 OCTAL.
* 
* MOVE USER PARAMS TO REQUEST BUFFER. 
* 
      LDA N1        MOVE FNUM.
      JSB D$PRM 
* 
      LDA N5        SET UP PARAMETER MASK.
      STA TEMP
      LDA DPRAM 
      STA TEMP1 
      CLA,RSS 
LOOP  RAL 
      LDB TEMP1,I 
      SZB 
      IOR B1      SET BIT IF PARAM SPECIFIED. 
      ISZ TEMP1 
      ISZ TEMP
      JMP LOOP
      JSB D$STW     STORE MASK IN REQUEST.
* 
      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. 
* 
      JMP RTPRM     NORMAL RETURN.  (A) = STATUS. 
* 
ABERR DST D$ERR     STORE CODE FOR FCHEK RETRIEVAL. 
* 
* PASS RETURN PARAMETERS TO CALLER. 
* 
RTPRM STA STAT      SAVE STATUS WORD FOR RETURN.
* 
      LDB D$RQB     IF REPLY PARAM NOT RETURNED,
      ADB B7         STORE ZERO IN PARAM SLOT.
      LDA B,I       REPLY BYTE COUNT. 
      ADB B7
      STB TEMP      POINTER TO LAST PARAM.
      INA 
      ARS           REPLY WORD COUNT. 
      ADA N7        # PARAM WORDS TO CLEAR. 
      SSA,RSS 
      JMP RTP       ALL PARAMS RETURNED.
LOOP1 CLB 
      STB TEMP,I
      LDB TEMP
      ADB N1
      STB TEMP
      INA,SZA 
      JMP LOOP1 
* 
RTP   LDB D255      SET UP FOR IMPOSSIBLE ERROR,
      LDA D$ERR      AND CHECK DS ERROR CODE. 
      SZA,RSS 
      JMP RTPM1     NO ERROR POSTED.
* 
      CPA "DS"      DS ERROR: IMPOSSIBLE ERROR? 
      RSS 
      JMP POST      YES.
* 
      DLD D$ERR     ERROR CODE IS "DSXX". PERFORM MAPPING.
      LDA B 
      LDB D254
      CPA "01"
      JMP POST      MAP "DS01" TO DECIMAL 254.
      LDB D245
      CPA "05"
      JMP POST      MAP "DS05" TO DECIMAL 245.
      LDB D216
      CPA "06"
      JMP POST      MAP "DS06" TO DECIMAL 216.
      LDB D255      IMPOSSIBLE ERROR. 
POST  LDA D$RQB     STORE DS ERROR IN REPLY BUFFER. 
      ADA D9
      STB A,I 
* 
RTPM1 LDB D$RQB     INITIALIZE: 
      ADB D9          (B) = ADDR OF 1ST REPLY VALUE.
      LDA DPRAM 
      INA             (A) = ADDR OF 1ST RETURN PARAM ADDR.
      JSB D$IPM 
* 
      LDA N2        PASS ERROR CODE, TLOG.
      CCB 
      JSB D$NPM 
* 
      LDA N2        PASS BLKNUM (2 WORDS).
      JSB D$SPM 
* 
      CCA           PASS NUMREC (1 WORD). 
      JSB D$SPM 
* 
      LDA STAT      RESTORE STATUS WORD.
      JMP ENTRY,I   RETURN. 
      SPC 3 
* 
* CONSTANTS AND WORKING STORAGE.
* 
A     EQU 0 
B     EQU 1 
B1    OCT 1 
B7    OCT 7 
B16   OCT 16
D9    DEC 9 
D216  DEC 216 
D245  DEC 245 
D254  DEC 254 
D255  DEC 255 
N1    DEC -1
N2    DEC -2
N5    DEC -5
N7    DEC -7
BIT15 OCT 100000
STAT  NOP 
TEMP NOP
TEMP1 NOP 
"DS"  ASC 1,DS
"01"  ASC 1,01
"05"  ASC 1,05
"06"  ASC 1,06
* 
      END 
                                                                                                                                            