ASMB,R,L,C
      HED REAL-TIME, FMGR WRITE LOAD/GO DISK FILE 
*     NAME:    WRLG.
*     SOURCE:  92067-18147
*     RELOC:   92067-16125
*     PGMR:    ???? 
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS     *
*  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
*  ***************************************************************
* 
      NAM WRLG.,7 92067-16125 REV.1903 760622 
      ENT WRLG.,EFLG. 
      EXT EXEC
      SPC 1 
      SPC 1 
*  PURPOSE: 
*    THIS ROUTINE WRITES RELOCATABLE RECORDS ON DISK. 
      SPC 1 
*  USES:
*    THIS ROUTINE IS USED BY FMGR TO WRITE THE RELOCATABLE
*    RECORDS ON A RTE 
*    DISC BASED SYSTEM. 
*    IN RTE SYSTEMS, THIS AREA IS CALLED THE
*    "LG" AREA.  THE FORMAT ON DISC IS SAME AS PAPER TAPE FORMAT. 
      SPC 1 
*  CALLED:
*    ASSEMBLY ONLY
*                   JSB WRLG.     (ALL INITIALIZATION DONE BY SYSTEM) 
*                   DEF *+4 
*                   DEF BUFFR     FIRST WORD ADDRESS OF WRITE BUFFER
*                   DEF RLEN      ADDRESS OF NUMBER OF WORDS TO WRITE 
*                   DEF PBUF      ADDRESS OF A 128 WORD PACKING BUFFER
*                   <RETURN>      P+5 A = 0 IF NO ERROR ELSE ERROR
* 
*    ASSEMBLY ONLY
*                   JSB EFLG.     POST ANY PARTIAL RECORD IN MEMORY 
*                   DEF *+2       RETURN ADDRESS
*                   <RETURN>      P+2 A=0 IF NO ERROR ELSE ERROR
      SPC 1 
*  ERRORS:
*    THE PROGRAM WILL RETURN TO THE CALLING PROGRAM WITH
*    A,B= "IO06" ERROR IF THE "LG" AREA WAS NOT DEFINED, OR 
*    A,B= "IO09" ERROR IF THE "LG" AREA OVERFLOWS.
      SPC 1 
*  NOTES: 
*    "NAM" RELOCATABLE RECORDS MUST ALWAYS START ON A SECTOR BOUNDRY, 
*    THEREFORE, WHENEVER AN "END" RELOCATABLE RECORD IS WRITTEN, THE
*    ENTRY POINT " EFLG. " MUST BE CALLED TO POST ANY PARTIAL RECORD
*    STILL IN MEMORY ONTO THE DISK. 
      SPC 1 
.WRIN NOP 
INIT2 STA BFWA      SET THE BUFFER ADDRESS ON FIRST ENTRY 
      CLA           CLEAR FOR NEXT
      STA INIT2     ENTRIES 
      LDA 1766B     LGOC= CURRENT LOAD/GO CODEWORD
      LDB D2
      SSA 
      INB 
      STB WLUN      LUN=2 IF SIGN=0, =3 OTHERWISE 
      ALF,ALF 
      RAL 
      AND O377
      STA TRACK     SET TRACK NO. 
      LDA 1766B     LGOC= CURRENT LOAD/GO CODE-WORD 
      AND O177
      STA B 
      STA SECTR     SET SECTOR NO.
      LDA DM128 
      SLB           CHECK IF ODD SECTOR IN RTE
      ARS           YES, DIVIDE SECTOR TO 64 WORDS
      STA BCOUN     SECTOR-BUFFER COUNT = -64 
      CMA,INA       SET THE SECTOR SIZE 
      STA PSIZE     MAY BE 64 OR 128 WORDS IF RTE 
      LDA BFWA
      STA BFRAD     SET SECTOR BUFFER ADDR = FWA BFR
      JMP .WRIN,I 
* 
*EFLG. OUTPUTS THE WRITE-BUFFER TO THE CURRENT SECTOR 
*ON DISK, UPDATES THE CURRENT SECTOR NO.
*EFLG. IS USUALLY CALLED AT THE END OF EACH SUBPROGRAM OUTPUT.
      SPC 1 
EFLG. NOP 
      LDA EFLG.,I   GET RETURN ADD
      STA EFLG.     AND SET IT
      CCA           CHECK HOW MANY SECTORS TO POST
      ADA BCOUN 
      ADA PSIZE     A=# WORDS WRITTEN -1
      IOR O77       MIRGE IN 63 
      SSA,INA       CHECK IF ANY & BUMP 
      JMP OKEX      NONE, JUST RETURN 
* 
      STA SSIZE     EITHER 64 OR 128
      LDB BCOUN     IF NOT A WHOLE SECTOR 
      CLA 
      SZB 
      STA BFRAD,I   0 FOR END OF SUBPROGRAM 
      JSB EXEC      WRITE SECTOR
      DEF *+7 
      DEF D2I       CODE FOR WRITE
      DEF WLUN      LUN 
BFWA  NOP           FWA OF BUFFER 
      DEF SSIZE     64 OR 128 WORDS 
      DEF TRACK     TRACK NO
      DEF SECTR     SECTOR NO 
      JMP EFLG.,I   RETURN IF ERROR 
* 
      JSB .WRIN     RE-INITIALIZE FOR NEXT WRITE
OKEX  CLA           SHOW NO ERROR 
      JMP EFLG.,I   EXIT
      SPC 1 
SSIZE NOP 
O77   OCT 77
O377  OCT 377 
O177  OCT 177 
      SPC 1 
WRLG. NOP 
      LDA WRLG.,I 
      STA EXIT      SET RETURN ADR
      ISZ WRLG. 
      LDA WRLG. 
      LDA A,I 
      RAL,CLE,SLA,ERA    TEST I-BIT AND CLEAR 
      JMP *-2 
      STA WBFAD     SOURCE-BUFFER FWA 
      ISZ WRLG. 
      LDA WRLG.,I 
      LDA 0,I 
      CMA,INA 
      STA COUNT     SET COUNT 
      ISZ WRLG.     STEP TO THE BUFFER ADDRESS
      LDA WRLG.     GET TO A
      LDA A,I       AND TRACK DOWN INDIRECTS
      RAL,CLE,SLA,ERA 
      JMP *-2 
* 
INIT  JSB .WRIN     CALL TO INIT
      CLA           FIRST TIME ONLY 
      STA INIT      SET IT
WMOVE LDA WBFAD,I 
      STA BFRAD,I   MOVE WORD 
      ISZ BFRAD          POINTERS 
      ISZ BCOUN     BUMP SECTOR-BUFFER COUNT
      JMP NOEND     NOT END OF BUFFER 
* 
      JSB EFLG.     END OF BUFFER, WRITE SECTOR 
      DEF *+1 
      SZA           IF OK JUST CONTINUE 
      JMP EXIT,I    ELSE EXIT A,B = CODE
* 
NOEND ISZ WBFAD     BUMP
      ISZ COUNT     BUMP COUNTER
      JMP WMOVE     CONTINUE TRANSFER 
* 
      CLA           SHOW NO ERROR 
      JMP EXIT,I    READY, EXIT 
      SPC 1 
EXIT  NOP           RETURN ADDR 
PSIZE DEC 128 
DM128 DEC -128
D2    DEC 2 
D2I   DEF 2,I 
WLUN  NOP           LUN 
TRACK NOP           CURRENT TRACK NO
SECTR NOP           CURRENT SECTOR NO 
BFRAD NOP           CURRENT ADDR IN WRITE-BUFFER
WBFAD NOP           CURRENT SOURCE-BUFFER ADDR
COUNT NOP           TRANSFER COUNT
BCOUN NOP 
B     EQU 1 
A     EQU 0 
      END 
* 
* 
                    