ASMB,L,C
      NAM RED.C,7 92060-16102 790403 REV. 1926 $CLIB
* 
*     NAME:   RED.C 
*     SOURCE: 92060-18056 
*     PGMR:   EARL STUTES 
* 
*************************************************************** 
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.  ALL RIGHTS     * 
* RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE-  * 
* REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * 
* OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.   * 
*************************************************************** 
      SPC 2 
* THIS IS THE TOP LEVEL DRIVE ROUTINE FOR THE COMPILER
* LIBRARY READ FUNCTION 
      SPC 3 
* PROC READFCB(FCB,BUFFER,LENGTH,LINE#);
* VALUE LENGTH;INTEGER LENGTH,LINE#;RECORD FCB; 
* INTEGER ARRAY BUFFER; 
* EXIT AT PARAMETER LIST + 1 WITH ERROR NUMBER IN A 
* EXIT AT PARAMETER LIST + 2 WITH RECORD NUMBER IN A AND
*      WORD COUNT IN B
* BEGIN 
*   ADDRESSSETUP; 
*   IF FCB.PROMPT <> 0 THEN 
*     EXEC(2,FCB.FLU,FCB.PROMPT,1); 
*   READARECORD;
*   IF ERROR THEN GO ERROR EXIT;
*   ALENGTH ;= B; 
*   WRITEAFTERREAD; 
*   IF ERROR THEN GO ERROR EXIT;
*   A := FCB.RECORD# := FCB.RECORD# + 1;
*   INCLUDE;
*   IF ERROR THEN GO ERROR EXIT;
*   B := RECORDLENGTH;
* END OF READFCB; 
      SKP 
      ENT RED.C 
      EXT C.GRW     ADDRESS OF THE WRITEAFTERREAD ROUTINE 
      EXT C.INS     ADDRESS OF THE INCLUDE ROUTINE
      EXT ADS.C     POINTER SETUP ROUTINE 
      EXT C.RC#     THE CURRENT RECORD #
      EXT C.??      THE FCB PROMPT CHARACTER AND FLAG 
* 
* PROC READFCB(FCB,BUFFER,LENGTH,LINE#);
* VALUE LENGTH;INTEGER LENGTH,LINE#;RECORD FCB; 
* INTEGER ARRAY BUFFER; 
* BEGIN 
ALEN  BSS 1 
RED.C BSS 1 
*   ADDRESSSETUP; 
      JSB ADS.C 
      DEC -2
*   IF FCB.PROMPT <> 0 THEN 
      LDA C.??,I
      SZA,RSS 
      JMP L00 
      JSB EXEC
      DEF *+4+1 
      DEF .2
      DEF C.FLU,I 
      DEF C.??,I
      DEF .1
*   READARECORD;
L00   JSB REDC. 
*   IF ERROR THEN GO ERROR EXIT;
      JMP RED.C,I 
*   ALENGTH := B; 
      STB ALEN
*   WRITEAFTERREAD; 
      JSB C.GRW,I 
*   IF ERROR THEN GO ERROR EXIT;
      JMP RED.C,I 
*   A := FCB.RECORD# := FCB.RECORD# + 1;
      LDA C.RC#,I 
      INA 
      STA C.RC#,I 
*   INCLUDE;
      JSB C.INS,I 
*   IF ERROR THEN GO ERROR EXIT;
      JMP RED.C,I 
*   B := RECORDLENGTH;
      LDB ALEN
* END OF READFCB; 
      ISZ RED.C 
      JMP RED.C,I 
      SKP 
* IT IS ASSUMED THAT THE REQUIRED ENVIRONMENT HAS BEEN SET UP 
* BY THE CALLING ROUTINE NAMELY THAT ALL PARAMETERS NECESSARY 
* FOR THE PROPER EXECUTION HAVE BEEN SET BEFORE THE CALL
* 
* IT IS ALSO ASSUMED THAT THE ROUTINE WILL RETURN TO P+1 ON 
* ERROR CONDITIONS WITH THE ERROR CODE IN THE A REGISTER. 
* 
* THE NORMAL RETURN WILL BE TO P+2 WITH THE WORD COUNT IN B 
* A AT THAT TIME WILL BE MEANINGLESS
      SPC 3 
*PROC READARECORD;
* BEGIN 
* INTEGER UP,SAVECOUNT,WORKCOUNT; 
* IF FCB.UNITRECORD THEN
*   EXEC(1,FCB.LU,USERBUFFER,RLENGTH) 
* ELSE
* [ IF (NOT BUFFERVALID) OR (FCB.BP > 128) THEN 
*   [ GETNEXTSECTOR(TRUE);
*     IF ERROR THEN GO TO ERROR EXIT; ] 
*   UP := 0;
*   WORKCOUNT := SAVECOUNT := DISCBUFFER[FCB.BP]; 
*   IF WORKCOUNT < 0 THEN 
*     GO EXIT 
*   ELSE
*   [ WHILE WORKCOUNT > 0 DO
*     [ FCB.BP := FCB.BP+1; 
*       IF FCB.BP > 128 THEN
*       [ GETNEXTSECTOR(TRUE);
*         IF ERROR THEN GO TO ERROR EXIT; ] 
*       USERBUFFER[UP] := DISCBUFFER[FCB.BP]; 
*       UP := UP+1; 
*       IF UP = RLENGTH THEN
*       [ B := RLENGTH; 
*         FCB.BP := FCB.BP + WORKCOUNT + 1; 
*         GO EXIT2;]; 
*       WORKCOUNT := WORKCOUNT-1 ]; 
*     FCB.BP := FCB.BP+2;]; 
*EXIT: B := SAVECOUNT;] 
*EXIT2: 
* END OF READARECORD; 
      SKP 
      EXT C.STR     FCB.STARTRACK 
      EXT C.FLU      THE FILE PRIMARY LU
      EXT C.BFF     THE FCB BUFFER POINTER
      EXT C.FAD     FMGR DIRECTORY ADDRESS
      EXT C.WRD 
BP    EQU C.WRD     DISC BUFFER POINTER 
      EXT EXEC      GUESS WHO 
      EXT C.PR1     THE CALLER'S FIRST PARAMETER
.UBUF EQU C.PR1 
      EXT C.FID     FCB ID WORD 
      EXT C.PR2      THE CALLER'S SECOND PARAMETER
RLEN  EQU C.PR2      LENGTH OF USER BUFFER
      EXT GES.C     THE READ/WRITE SECTOR WORK HORSE
*PROC READARECORD;
* BEGIN 
* INTEGER UP,SAVECOUNT,WORKCOUNT; 
UP    BSS 1         USER BUFFER POINTER 
SAVC  BSS 1         DISC RECORD LENGTH HOLDER 
WORKC  BSS 1         DISC RECORD WORKING COUNTER
.1    DEC 1 
.2    DEC 2 
.M1   DEC -1
      SPC 2 
B     EQU 1 
      ENT REDC. 
REDC. BSS 1 
* IF FCB.UNITRECORD THEN
      LDA C.FID,I   UNITRECORD FLAG IS THE SIGN BIT 
      SSA,RSS 
      JMP L0
*   EXEC(1,FCB.LU,USERBUFFER,RLENGTH) 
      JSB EXEC
      DEF *+4+1 
      DEF .1
      DEF C.FLU,I 
      DEF .UBUF,I 
      DEF RLEN,I
      JMP L5
* ELSE
* [ IF (NOT BUFFERVALID) OR (FCB.BP > 128) THEN 
L0    LDA C.BFF,I 
      AND =B77777 
      SZA,RSS 
      JMP GETIT 
      LDA BP,I
      ADA =D-129
      SSA 
      JMP L1
*   [ GETNEXTSECTOR(TRUE);
GETIT CCA 
      JSB GES.C 
*     IF ERROR THEN GO ERROR EXIT; ]
      JMP REDC.,I 
*   UP := 0;
L1    CLA 
      STA UP
*   WORKCOUNT := SAVECOUNT := DISCBUFFER[FCB.BP]; 
      LDB C.BFF 
      ADB BP,I
      LDA B,I 
      STA SAVC
*   IF WORKCOUNT < 0 THEN 
      SSA,RSS 
      JMP WHILE 
*     GO EXIT;
      JMP EXIT
*   ELSE
*      WHILE WORKCOUNT > 0 DO 
WHILE STA WORKC 
      SZA,RSS 
      JMP EWHIL 
*      [ FCB.BP := FCB.BP+1;
      ISZ BP,I
*        IF FCB.BP > 128 THEN 
      LDA BP,I
      ADA =D-129
      SSA 
      JMP L3
*        [ GETNEXTSECTOR(TRUE); 
      CCA 
      JSB GES.C 
*          IF ERROR THEN GO ERROR EXIT; ] 
      JMP REDC.,I 
*       END;
*       USERBUFFER[UP] := DISCBUFFER[FCB.BP]; 
L3    LDB C.BFF 
      ADB BP,I
      LDA B,I 
      LDB .UBUF 
      ADB UP
      STA B,I 
*       UP := UP+1; 
      ISZ UP
*       IF UP = RLENGTH THEN
      LDB UP
      CPB RLEN,I
      JMP *+2 
      JMP L4
*       [ B := RLENGTH; 
*         FCB.BP := FCB.BP + WORKCOUNT + 1; 
      LDA BP,I
      ADA WORKC 
      INA 
      STA BP,I
*         GO EXIT2;]
      JMP EXIT2 
*       WORKCOUNT := WORKCOUNT-1  ] 
L4    CCA 
      ADA WORKC 
      JMP WHILE 
EWHIL EQU * 
*   FCB.BP ;= FCB.BP+2  ];
      ISZ BP,I
* 
*FOLLOWING CODE CHANGED ON 790403 
*REV 1926-REMOVES FMP '005' TYPE ERROR. 
*NOTE, HOWEVER, THAT THE SPECIAL CASE WHEN
*RECORD POINTER > 128 IS IGNORED. 
* 
      LDB BP,I      POINTER > 128?
      ADB =D-129
      SSB,RSS 
      JMP OVER.     IF SO, IGNOR CHECK. 
      LDB C.BFF     GET BASE ADDRESS. 
      ADB BP,I      ADD OFFSET WORD POINTER.
      LDB B,I       SHOULD YIELD WORD CNT FOR RECORD. 
      CPB SAVC      MUST COMPARE WITH 1ST WORD OF RECORD. 
      JMP OVER. 
      LDA =D-5      SIMULATE -005 ERROR & RETURN. 
      JMP REDC.,I 
OVER. ISZ BP,I      'OVER.' LABEL ADDED!
* 
*THAT'S IT! 
* 
*EXIT: B := SAVECOUNT;
EXIT EQU *
      LDB SAVC
*EXIT2: 
EXIT2 EQU * 
L5    ISZ REDC. 
      JMP REDC.,I 
      END 
                    