ASMB,R,Q,C
*     NAME:   ERLOG 
*     SOURCE: 92070-18147 
*     RELOC:  92070-16147 
*     PGMR:   HLC 
* 
* 
*  **************************************************************** 
*  * (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 ERLOG,0  92070-16147  REV.1941  791022
      ENT $CVT,$SYMG,$ERMG,$STMG
      ENT $$ERL,$.ERL,$SY#,$XS3 
* 
      EXT $XEQ,$A,$B,$SUSP,$CON,.MVW
      EXT $RQRT,$XSIO,$IOFL,$LDRS,$LDAB 
      EXT $ZZZZ,$TREM,$STAT,$XQT
      EXT $CVT3,$PNAM,$PVCN 
* 
A     EQU 0 
B     EQU 1 
      SUP 
* 
*     ABORT WITH ERROR MESSAGE
* 
$ERMG NOP 
      STA A.
      STA $A,I
      CLA 
      STA $PVCN 
      CPA $XQT
      JMP HALT      ABORTIVE ERROR -- NO USER PROGRAM EXECUTING 
      LDA $STAT,I 
      RAL 
      CLE,SSA       IF THE NO-ABORT BIT IS CLEAR
      CPB =A          OR B IS BLANK 
      JMP ABORT          ABORT HIM
      STB $B,I
      CCA 
      ADA $RQRT 
      STA $SUSP,I 
      JMP $ERMG,I 
* 
ABORT RAR 
      IOR =B400     SET 'OF' BIT
      STA $STAT,I 
      STB B.
      LDA $SUSP,I 
      JSB $CVT3     CONVERT POINT OF SUSPENSION TO ASCII
      LDA $CON,I
      AND =B377 
      STA ERMG      SAVE TERMINAL LU
      LDB $XQT
      JSB $PNAM     MOVE NAME TO BUFFER 
      DEF ERMG+2
      JSB $SYMG     PRINT 'PROGA ABORTED SC05 37756'
      DEF ERMG
      LDB $XQT
      JSB $TREM     REMOVE FROM TIME LIST 
      LDB $XQT
      CPB $LDRS 
      JMP LDAB      CURRENTLY BEING SWAPPED   
      LDA $STAT,I 
      AND =B77      STATUS
      CPA =B2 
      RSS           I/O SUSPENDED 
      STB $ZZZZ     SET TO ABORT
FLUSH LDA $XQT
      JSB $IOFL     FLUSH PENDING I/O REQUESTS
      JMP $ERMG,I 
* 
* 
LDAB  JSB $LDAB     ABORT THE SWAP    
      JMP FLUSH 
* 
* 
ERMG  DEC 1         LU
      DEC -24       LENGTH
      ASC 7,XXXXX ABORTED 
A.    ASC 1,XX      TWO CHARACTERS
B.    ASC 1,00      TWO DIGITS
$CVT  BSS 3 
* 
HALT  LDA A.
      HLT 3         HALT WITH ERROR CODE IN A AND B 
      JMP HALT      NO RECOVERY 
* 
* 
      HED  BUFFERED SYSTEM MESSAGE OUTPUT 
* 
$SYMG NOP 
      LDA $SYMG,I 
      ISZ $SYMG 
      LDB $SY#     IF BUFFER
      CPB D5         IS FILLED, 
      JMP $SYMG,I    REJECT EXIT. 
* 
      LDB SYC      SET CURRENT
      JSB .MVW
      DEF D14 
      NOP 
      LDA SYC 
      CPB SBL      IF NEXT EXCEEDS BUFFER,
      LDB SBF       RESET TO FWA BUFFER 
      STB SYC       AND SAVE. 
* 
      LDB $SY#     IF ENTRY.
      ISZ $SY#
      SZB,RSS 
      JSB SYSCL     INITIATE OUTPUT.
      CLA,CLE       MESSAGE ACCEPTED
      JMP $SYMG,I 
* 
* 
* CALL <$XSIO> TO INITIATE OUTPUT 
* 
SYSCL NOP 
      LDB A,I 
      STB LU        SAVE LU NUMBER
      INA 
      LDB A,I       GET THE MESSAGE LENGTH
      STB LNG       SET IN THE CALL 
      INA           STEP TO BUFFER ADDRESS
      STA BUFF      SET IN THE CALL 
      CLA 
      STA PRIOR     PRIORITY ZERO (OVERLAID BY TLOG)
$XS3  JSB $XSIO 
LU    DEC 1 
      DEF SYS8      - COMPLETION ROUTINE ADDRESS
      NOP           LINKAGE 
      DEC 2         ASCII WRITE - 
BUFF  NOP           MESSAGE ADDRESS 
LNG   NOP           MESSAGE LENGTH
      NOP           NO 'Z' BUFFER 
      NOP           NO 'Z' BUFFER 
PRIOR NOP           PRIORITY ZERO 
      NOP           RESERVED
      JMP SYSCL,I 
* 
* COMPLETION ROUTINE FROM I/O CALL
* 
SYS8  CCA          SUBTRACT 1 FROM
      ADA $SY#      ENTRY COUNT FOR 
      STA $SY#      MESSAGE JUST OUTPUT.
      SZA,RSS      IF NO MORE IN BUFFER,
      JMP $XEQ      EXIT. 
* 
      LDA BUFF     SET
      ADA =D12        NEXT ENTRY
      CPA SBL       ADDRESS 
* 
$STMG LDA SBF       PRINT STARTING MESSAGE
      JSB SYSCL    INITIATE OUTPUT
      JMP $XEQ      -EXIT.
* 
$SY#  DEC 1         5-WORD TABLE, DO NOT REARRANGE
SYC   DEF SBUF2     POINTER TO NEXT AVAILABLE BUFFER
SBF   DEF SBUF1     POINTER TO FIRST BUFFER 
D5    DEC 5         NUMBER OF BUFFERS 
D14   DEC 14        SIZE OF EACH BUFFER 
* 
* 
SBUF1 DEC 1 
      DEC -24 
      OCT 6412      CARRIAGE RETURN, LINE FEED
      ASC 10,*RTE-L SYSTEM READY* 
      OCT 3412      BELL, LINE FEED 
* 
SBUF2 BSS 14
* 
SBUF3 BSS 14
* 
SBUF4 BSS 14
* 
SBUF5 BSS 14
SBL   DEF * 
* 
$$ERL EQU *         STANDARD MODULE 
$.ERL DEC 0         STANDARD MODULE 
      END 
                                                                                                                                                                  