ASMB
       NAM WRITR,7 92069-16015 REV.2026 800124
* 
* 
******************************************************************
* (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. 
******************************************************************* 
* 
* 
*     SOURCE:    92069-18052
*     RELOC:     92069-16015
* 
* 
*****************************************************************:
* 
***************************************************************** 
*  WRITR WRITES THE ROOT TABLE TO THE DISC
*  THE ROOT TABLE IS LOCATED IN THE SPACE AFTER THE LONGEST 
*  PROGRAM SEGMENT
* 
*  THE RUN TABLE SHOULD PRECEES THE OVERHEAD RECORD, AND THE
*  OVERHEAD RECORD SHOULD PRECEED THE FREESPACE POINTERS. 
* 
*                     --------------- 
*                     !             ! 
*                     !             ! 
*                     !   RUN TABLE ! 
*                     !             ! 
*                     !             ! 
*                     --------------- 
*                     !   OVERHEAD  ! 
*                     ! (5 WORDS)   ! 
*                     --------------- 
*                     ! FREE SPACE  ! 
*                     !  POINTERS   ! 
*                     --------------- 
* 
* 
*  THE WORD OVRHD IS THE BYTE OFFSET TO THE FIRST WORD OF THE 
*  OVERHEAD RECORD. THE WORD RINDX IS THE BYTE OFFSET WHICH POINTS TO 
*  ONE WORD PAST THE END OF THE FREE SPACE POINTERS.  RINDX 
*  AND OVRHD ARE SET UP IN THE MODULE RAPUP.
* 
* 
*  CALLING SEQUENCE:
* 
*  CALL WRITR(IERR,IDCB)
*  WHERE IERR = FMGR ERROR CODE 
*        IDCB = THE FMP FILE CONTROL BLOCK
* 
* 
***************************************************************** 
* 
* 
      ENT WRITR 
      EXT EWRIT,.ENTR 
      EXT ROOTA 
* 
*$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 
* 
* 
*                      CONSTANTS IN COMMON
* 
* 
* 
      COM CARD(36),CHAR,CODE,CPACK(100),CRDPR 
      COM DSEC,DCRN 
      COM ENTL,ERROR
      COM NMFLG 
      COM FWAM
      COM GGERR 
      COM ICNT,IDCB(144),INDX 
      COM INFPT,INFO(6),IGLOB(10),INPUT,ITMTB 
      COM KPACK(50) 
      COM LDCB(144),LGLOB,LIST,LWAM 
      COM MEDIA 
      COM NPACK(50),NSETS(50) 
      COM OVRHD 
      COM PTHTB(32) 
      COM RDEF(64),RESNO,RFILE(3),RINDX 
      COM SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE 
      COM TYPE,PRGFG
* 
*$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 
* CHANGED TO INCREASE SIZE OF PTHTB 
* 
* 
* 
IERR  NOP 
DCB  NOP
WRITR NOP 
      JSB .ENTR 
      DEF IERR
* 
      LDA OVRHD     GET ADDRESS OF OVERHEAD RECORD
      ARS           TURN BYTE OFFSET TO WORD OFFSET 
      ADA FWAM      ADD TO FIRST WORD OF AVAILABLE MEMORY 
      STA ADDR
* 
      JSB EWRIT     WRITE OVERHEAD RECORD 
      DEF *+6 
      DEF DCB,I 
      DEF IERR,I
      DEF ADDR,I
      DEF .5        SIZE OF OVERHEAD
      DEF ONE 
* 
      LDA IERR,I
      SSA 
      JMP WRITX 
* 
      LDA OVRHD     GET SIZE OF FREE SPACE POINTERS 
      CMA,INA 
      ADA RINDX     BYTE OFFSET 1 WORD PAST FREE SPACE PTRS 
      ARS 
      ADA M5
      STA III 
* 
      LDA ADDR      GET ADDRESS TO FREE SPACE POINTERS
      ADA .5          SKIP OVERHEAD 
      STA ADDR
* 
      JSB EWRIT     WRITE THE FREE SPACE POINTERS 
      DEF *+6 
      DEF DCB,I 
      DEF IERR,I
      DEF ADDR,I
      DEF III 
      DEF TWO 
* 
      LDA IERR,I    WAS THERE AN ERROR? 
      SSA 
      JMP WRITX 
* 
      JSB ROOTA     GET THE RUN TABLE RECORD NUMBER 
      DEF *+2 
      DEF OVRHD 
       STA B
      CLA 
      DST IV
* 
      LDA OVRHD 
      ARS 
      STA II
* 
      JSB EWRIT     WRITE OUT THE ROOT FILE 
      DEF *+6 
      DEF DCB,I 
      DEF IERR,I
      DEF FWAM,I
      DEF II
      DEF IV
* 
WRITX JMP WRITR,I 
* 
* 
* 
ADDR  DEF *-* 
II    DEF *-* 
III   DEF *-* 
IIII  DEF *-* 
IV    BSS 2 
* 
* THIS IS A DOUBLE INTEGER ONE
* 
ONE   DEC 0 
      DEC 1 
* 
* 
* 
* 
* THIS IS A DOUBLE INTEGER TWO
* 
TWO   DEC 0 
      DEC 2 
.5    DEC 5 
M5    DEC -5
* 
* 
*  A AND B REGISTER EQUATES 
* 
* 
A     EQU 0 
B     EQU 1 
      END 
                                                                                                                                                                                        