ASMB,L,C
      NAM WRT.C,7 92060-16102 770523 REV. 1901 $CLIB
* 
* 
*     NAME:   WRT.C 
*     SOURCE: 92060-18057 
*     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 WRITE FUNCTION
      SPC 3 
* PROC WRITEFCB(,FCB,BUFFER,LENGTH);
* VALUE LENGTH;INTEGER LENGTH;INTEGER ARRAY BUFFER;RECORD FCB;
* EXIT AT PARAMETER LIST + 1 WITH ERROR NUMBER IN A 
* EXIT AT PARAMETER LIST + 2  REGISTERS MEANINGLESS 
* BEGIN 
*   ADDRESSSETUP; 
*   WRITEARECORD(LENGTH); 
*   IF ERROR THEN GO ERROR EXIT;
* END OF WRITEFCB;
      ENT WRT.C 
      EXT ADS.C     POINTER SETUP ROUTINE 
      EXT C.PR2 
LENT. EQU C.PR2 
* 
* PROC WRITEFCB(FCB,BUFFER,LENGTH); 
* VALUE LENGTH;INTEGER LENGTH;INTEGER ARRAY BUFFER;RECORD FCB;
* BEGIN 
WRT.C BSS 1         ENTRY POINT 
*   ADDRESSSETUP; 
      JSB ADS.C 
      DEC -2
*   WRITEARECORD(LENGTH); 
      LDB LENT.,I 
      JSB WRTC. 
*   IF ERROR THEN GO ERROR EXIT;
      JMP WRT.C,I 
* END OF WRITEFCB;
      ISZ WRT.C 
      JMP WRT.C,I 
      SKP 
* THIS ROUTINE ASSUMES THAT THE REQUIRED ENVIRONMENT HAS BEEN SET UP
* BY THE CALLER, 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 
* ON ERROR CONDITIONS WITH THE ERROR CODE IN THE A REGISTER.
* 
* THE NORMAL RETURN WILL BE TO P+2 WITH BOTH REGISTERS MEANINGLESS
      SPC 3 
* PROC BUMBP; 
* BEGIN 
*   FCB.BP := FCB.BP+1; 
*   IF FCB.BP >= 128 THEN 
*   [ WRITEBUFFER ;= TRUE;
*     GETNEXTSECTOR(FALSE); 
*     IF ERROR THEN GO ERROR EXIT;] 
* END OF BUMBP & NORMAL RETURN TO P+1 ERROR EXITS WRITEARECORD
      SPC 3 
BUMBP BSS 1 
      ISZ BP,I
      LDA BP,I
      ADA =D-129
      SSA 
      JMP BUMBP,I 
      CLA,CCE 
      ERA           WRITEBUFFER FLAG = SIGN BIT 
      STA C.BFF,I   OF THE FIRST WORD IN THE BUFFER 
      CLA 
      JSB GES.C 
      JMP WRTC.,I   ALL THE WAY OUT 
      JMP BUMBP,I 
      SKP 
*PROC WRITEARECORD(LENGTH); 
*VALUE LENGTH; INTEGER LENGTH;
* THE LENGTH WILL BE PASSED IN THE B REGISTER 
* BEGIN 
* INTEGER UP, 
*         WORKCOUNT,
*         .2; 
* IF LENGTH < 0 THEN GO EXIT; 
* IF UNITRECORD THEN
*   EXEC(2,FCB.LU,USERBUFFER,LENGTH)
* ELSE
* [ UP := 0;
*   DISCBUFFER[FCB.BP] := WORKCOUNT := LENGTH;
*   WHILE WORKCOUNT > 0 DO
*   [ BUMBP;
*     DISCBUFFER[FCB.BP] := USERBUFFER[UP]; 
*     UP := UP+1; 
*     WORKCOUNT ;= WORKCOUNT-1; ];
*   BUMBP;
*   DISCBUFFER[FCB.BP] := LENGTH; 
*   BUMBP;
*   DISCBUFFER[FCB.BP] ;= -1; 
*   WRITEBUFFER := TRUE;];
* END OF WRITEARECORD;
      SKP 
      ENT WRTC. 
      EXT C.FID     FCB.ID THE FCB ID WORD
      EXT C.WRD 
      EXT C.FLU     FCB LU
BP    EQU C.WRD     DISC BUFFER POINTER 
      EXT C.BFF     DISC BUFFERHEAD POINTER 
      EXT C.PR1      THE USERS FIRST PARAMETER
.UBUF EQU C.PR1      USER BUFFERHEAD POINTER
      EXT GES.C     THE SECTOR READWRITE WORK HORSE 
B     EQU 1 
      EXT EXEC      GUESS WHO 
*PROC WRITEARECORD(LENGTH); 
* VALUE LENGTH; INTEGER LENGTH; 
* THE LENGTH WILL BE PASSED IN THE B REGISTER 
LENT# BSS 1         THE LENGTH VALUE HOLDER 
* BEGIN 
* INTEGER UP, 
UP    BSS 1 
*         WORKCOUNT,
WORKC BSS 1 
*         .2 := 2;
.2    DEC 2 
WRTC. BSS 1         ENTRY POINT 
      STB LENT# 
* IF LENGTH < 0 THEN GO EXIT; 
      SSB 
      JMP EXIT
* IF UNITRECORD THEN
      LDB C.FID,I   UNITRECORD FLAG IS THE SIGN BIT OF THE ID 
      SSB,RSS 
      JMP L1
*   EXEC(2,LU,.UBUF,LENGTH) 
      JSB EXEC
      DEF *+4+1 
      DEF .2
      DEF C.FLU,I 
      DEF .UBUF,I 
      DEF LENT# 
      JMP EXIT
* ELSE
*   UP := 0;
L1    CLA 
      STA UP
*   DISCBUFFER[FCB.BP] := WORKCOUNT := LENGTH;
      LDB C.BFF 
      ADB BP,I
      LDA LENT# 
      STA B,I 
*   WHILE WORKCOUNT > 0 DO
WHILE STA WORKC 
      SZA,RSS 
      JMP EWHIL 
*   [ BUMBP;
      JSB BUMBP 
*     DISCBUFFER[FCB.BP] := USERBUFFER[UP]; 
      LDB .UBUF 
      ADB UP
      LDA B,I 
      LDB C.BFF 
      ADB BP,I
      STA B,I 
*     UP := UP+1; 
      ISZ UP
*     WORKCOUNT := WORKCOUNT-1;]; 
      CCA 
      ADA WORKC 
      JMP WHILE 
EWHIL EQU * 
*   BUMBP;
      JSB BUMBP 
*   DISCBUFFER[FCB.BP] := LENGTH; 
      LDB C.BFF 
      ADB BP,I
      LDA LENT# 
      STA B,I 
*   BUMBP;
      JSB BUMBP 
*   DISCBUFFER[FCB.BP] ;= -1;]; 
      CCA 
      LDB C.BFF 
      ADB BP,I
      STA B,I 
*   WRITEBUFFER := TRUE;
      CLA,INA 
      RAR 
      STA C.BFF,I 
* END OF WRITEARECORD;
EXIT  ISZ WRTC. 
      JMP WRTC.,I 
      END 
                                              