ASMB,R,L,C
      HED REAL-TIME, DOS, AND IOMEC/DOS WRITE LOAD/GO DISK FILE 
* 
*     NAME:   %WRIT 
*     SOURCE: 92068-18004 
*     RELOC:  PART OF 92067-16268 AND 92067-16035 
*     PGMR:   R.A.G.
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  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 %WRIT,7 92068-1X004 REV.2013 771116 
      ENT %WRIT,%WRIF 
      ENT %WBUF 
      EXT EXEC
      EXT $OPSY 
      SPC 1 
      SPC 1 
*  PURPOSE: 
*    THIS ROUTINE WRITES RELOCATABLE RECORDS ON DISK. 
      SPC 1 
*  USES:
*    THIS ROUTINE IS USED BY COMPILERS TO WRITE THE RELOCATABLE 
*    RECORDS IT PRODUCES ON A DOS, DOS-M, DOS-III, OR RTE 
*    DISC BASED SYSTEM.  IN DOS SYSTEMS, THE AREA OF THE DISC IS
*    CALLED THE "JBIN".  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 %WRIT     (ALL INITIALIZATION DONE BY SYSTEM) 
*                   DEF *+3 
*                   DEF BUFFR     FIRST WORD ADDRESS OF WRITE BUFFER
*                   DEF RLEN      ADDRESS OF NUMBER OF WORDS TO WRITE 
*                   <RETURN>      P+4 
* 
*    ASSEMBLY ONLY
*                   JSB %WRIF     POST ANY PARTIAL RECORD IN MEMORY 
*                   <RETURN>      P+1 
      SPC 1 
*  ERRORS:
*    IN DOS, DOS-M, DOS-III SYSTEMS THE MESSAGE "JBIN OVF" WILL 
*    APPEAR ON LOGICAL UNIT ONE, IF THE THE JBIN OVERFLOWS. 
*    IN RTE, THE SYSTEM WILL ABORT THE CALLING PROGRAM WITH 
*    AN "IO06" ERROR IF THE "LG" AREA WAS NOT DEFINED, OR 
*    AN "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 " %WRIF " MUST BE CALLED TO POST ANY PARTIAL RECORD
*    STILL IN MEMORY ONTO THE DISK. 
      SPC 1 
*  THIS ROUTINE COULD BE SHORTEN TO ABOUT 404(8)
      SPC 1 
WROVF CCA 
      LDB O101      ADDR OF JBINS= 101B 
      JSB EXEC      SET JBINS=-1
      DEF *+2 
      DEF .M19      -19 
      JSB EXEC
      DEF *+5 
      DEF M2OR2 
      DEF .1        LUN=1 FOR SYSTEM TTY
      DEF OVMES     FWA OF MESSAGE
      DEF .M8       -8 FOR 8 CHARS. 
      JMP %WRIF,I   EXIT
OVMES ASC 4,JBIN OVF
.WRIN NOP 
DOS1  JMP RTEIN 
*     LDA DM8 
*     STA N 
      LDA 102B      JBINC 
      CLB 
      SZA,RSS       ANY JBIN TRACKS ? 
      JMP WROVF     NO,OVERFLOW ERROR 
      LSL 8 
*     CLE,ELA 
*     ELB,CLE       LSL 8 - SHIFT TRACK NO INTO B 
*     ISZ N 
*     JMP *-3 
      ALF,ALF       (A) = SECTOR NO 
      STB TRACK 
      CLB           ALWAYS EVEN 
      JMP DOSC1 
RTEIN LDA 1766B     LGOC= CURRENT LOAD/GO CODEWORD
      LDB M2OR2 
      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 
DOSC1 STA SECTR     SET SECTOR NO.
      LDA MSIZE 
      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 
*%WRIF OUTPUTS THE WRITE-BUFFER TO THE CURRENT SECTOR 
*ON DISK, UPDATES THE CURRENT SECTOR NO.
*%WRIF IS USUALLY CALLED AT THE END OF EACH SUBPROGRAM OUTPUT.
      SPC 1 
%WRIF NOP 
DOS2  JMP RTEIF 
      LDA 101B      JBINS 
      CPA DM1       NO JBIN LEFT ? (DUM GUY)
      JMP %WRIF,I   YES,EXIT. 
RTEIF 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 %WRIF,I   NONE, JUST RETURN 
      STA SSIZE     EITHER 64 OR 128
      CLA 
      STA BFRAD,I   0 FOR END OF SUBPROGRAM 
      JSB EXEC      WRITE SECTOR
      DEF *+7 
      DEF M2OR2     CODE FOR WRITE
CDOS  DEF WLUN      LUN 
BFWA  DEF %WBUF     FWA OF BUFFER 
      DEF SSIZE     64 OR 128 WORDS 
      DEF TRACK     TRACK NO
      DEF SECTR     SECTOR NO 
DOS3  JMP RTEFC 
*     LDA DM8 
*     STA N 
      LDA 102B      LGOC WORD 
      INA 
      ISZ SECTR     BUMP SECTOR 
      LDB SECTR 
      CPB 116B      NO OF SECTORS IN TRACK
      CLB,RSS 
      JMP WRIF2 
      RRL 8 
*     CLE,SSA 
*     CCE 
*     ELB           RRL 8 - TRACK NO TO B 
*     ELA 
*     ISZ N 
*     JMP *-5 
WRIF1 ADB DM1 
      STB TRACK     NEW TRACK NO
      JSB EXEC      STATUS REQUEST
      DEF *+5 
      DEF .16       CODE = 16 
      DEF .1        1 TRACK 
      DEF TRACK     STARTING TRACK NO.
      DEF STRAK     ACTUAL GOOD TRACK RETURNED
      LDA STRAK 
      SZA,RSS       OVERFLOW ?
      JMP WROVF     YES 
*     LDB DM8 
*     STB N 
      LDB TRACK 
      CPB STRAK     GOOD TRACK ?
      CLA,RSS 
      JMP WRIF1     NO, TRY NEXT LOWER TRACK
      CPB RTRAK     WORK TRACK ?
      JMP WROVF     YES,OVERFLOW
      RRR 8 
*     CLE,ERB 
*     ERA           RRR 8 - TRACK TO UPPER A
*     ISZ N 
*     JMP *-3 
WRIF2 LDB O102      ADDR OF JBINC 
      JSB EXEC      SET JFILC = TRACK,O (AT 125B) 
      DEF *+2 
      DEF .M19      -19 
RTEFC JSB .WRIN     RE-INITIALIZE FOR NEXT WRITE
      JMP %WRIF,I   EXIT
      SPC 1 
RTRAK EQU 267B
SSIZE NOP 
O77   OCT 77
O101  OCT 101 
*DM8   DEC -8 
O377  OCT 377 
O177  OCT 177 
DM1   DEC -1
O102  OCT 102 
      SPC 1 
%WRIT NOP 
      LDA %WRIT,I 
      STA EXIT      SET RETURN ADR
      STA %WRIF      ALSO FOR WROVF 
INITI JMP INITL     INITIALIZE AT 1ST ENTRY 
DOS4  JMP WRIT1     RTE 
      LDA 101B      JBINS 
      CPA DM1       NO JBIN LEFT ?
      JMP EXIT,I    YES,EXIT
WRIT1 ISZ %WRIT 
      LDA %WRIT 
      LDA 0,I 
      RAL,CLE,SLA,ERA    TEST I-BIT AND CLEAR 
      JMP *-2 
      STA WBFAD     SOURCE-BUFFER FWA 
      ISZ %WRIT 
      LDA %WRIT,I 
      LDA 0,I 
      CMA,INA 
      STA COUNT     SET COUNT 
WMOVE LDA WBFAD,I 
      STA BFRAD,I   MOVE WORD 
      ISZ BFRAD          POINTERS 
      ISZ BCOUN     BUMP SECTOR-BUFFER COUNT
      RSS 
      JSB %WRIF     END OF BUFFER, WRITE SECTOR 
      ISZ WBFAD     BUMP
      ISZ COUNT     BUMP COUNTER
      JMP WMOVE     CONTINUE TRANSFER 
      JMP EXIT,I    READY, EXIT 
      SPC 1 
EXIT  NOP           RETURN ADDR 
STRAK NOP           TEMP FOR NEXT GOOD TRACK
PSIZE DEC 64
MSIZE DEC -64 
.M19  DEC -19 
.16   DEC 16
.1    EQU 54B 
.M8   EQU 43B 
M2OR2 DEC 2 
*N     NOP
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
%WBUF BSS 128 
      ORG %WBUF+64  I DON'T WHY THIS IS AN ENTRY POINT
INITL CLA           NOP TO AVOID 2ND ENTRY
      STA INITI 
      LDA $OPSY     FIND OUT WHAT SYSTEM, DOS,DOSM,RTE
      SSA           RTE = -1 OR -2
      JMP RWRIN     RTE 
      LDB TDM2      DISC WRITE = -2 IN DOS-DOSM 
      STB M2OR2 
      LDB TO55      GET OCT 55
      STB CDOS      LU FOR DISC IS ON BASE PAGE 
      CLB           TURN INTO DOS CODE
      STB DOS1
      STB DOS2
      STB DOS3
      STB DOS4
      LDB PSIZE     DEC 64
      SZA           SEE IF DOS OR DOSM? 
RWRIN LDB TD128     CHANGE TO 128 WORD SECTORS
      STB PSIZE 
      CMB,INB 
      STB MSIZE 
      JSB .WRIN     SET UP TRACK/SECTOR ADDRESS 
      JMP INITI+1   CONTINUE PROCESSING 
      SPC 1 
TO55  OCT 55
TD128 DEC 128 
TDM2  DEC -2
      SPC 1 
      ORR 
BCOUN NOP           DON'T MOVE, YOU BE SORRY
B     EQU 1 
      END 
* 
*