      .title   iferr
;
;     This routine tests its argument (BLBS) to see
;     whether it is an error or a success.
;     If it is an error it SIGNALs the error so that it
;     will cause image exit if it gets to the system-
;     established handlers.
;     Typically, the result will be to output the error
;     message associated with the error, a traceback
;     of where it happened, and then stop.
;
      $JPIDEF
      $SSDEF
iferr::  .word    0
      blbs  @4(ap),done    ; if bottom bit set, success
      cmpl  @4(ap),#ss$_exquota  ; did we exceed our quotas ?
      bnequ noquo
      calls   #0,quota_err      ; Yes. Show them current counts.
noquo:   pushl @4(ap)         ; else failure.
      calls #1,lib$stop    ; signal the error
                           ; user can continue only if they
                           ; unwind the stack (this level
                           ; is assumed to be unable to continue).
done: ret                  ; and return if someone intercepts it.
      
quota_err::                 ; first get current counts
      .word    0
      $getjpi_s   itmlst=items
      pushl r0
      pushl sp
      calls #1,iferr
      popl  r0
good: subl2 prccnt,prclm
      $faol_s  ctrstr=string,outlen=rlen,outbuf=buffer,prmlst=astcnt
      pushl r0
      pushl sp
      calls #1,iferr
      popl  r0
good2:   movzwl   rlen,buffer
      pushl    #ss$_normal
      pushl    #1
      movl  sp,r0
      $putmsg_s   msgvec=(r0),actrtn=fake_it
      pushl r0
      pushl sp
      calls #1,iferr
good3:   ret
fake_it:
      .word    0
      movq     buffer,@4(ap)
      movl     #ss$_normal,r0
      ret
      .macro   defitem  item
      .word 4
      .word jpi$_'item
      .long item
      .long 0
      .endm    defitem
rlen: .word    0
      nlen =   400
buff: .blkb    nlen
buffer:  .long nlen
      .long buff
items:
      .list    me
      defitem  astcnt
      defitem  biocnt
      defitem  bytcnt
      defitem  diocnt
      defitem  filcnt
      defitem  prccnt
      defitem  prclm
      defitem  tqcnt
      .long    0
      .list
astcnt:  .long 0
biocnt:  .long 0
bytcnt:  .long 0
diocnt:  .long 0
filcnt:  .long 0
prclm:   .long 0
tqcnt:   .long 0
prccnt:  .long 0
string:  .ascid  ?Current quotas still available:? -
                                ?!/AST (asynch. traps)       !SL? -
                                ?!/BIO (buffered I/Os)       !SL? -
                                ?!/BYT (buffered I/O bytes)  !SL? -
                                ?!/DIO (direct I/Os)         !SL? -
                                ?!/FIL (open files)          !SL? -
                                ?!/PRC (subprocesses)        !SL? -
                                ?!/TQE (timer queue entries) !SL?    
      .end
