.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)         ; set up status result as arg to lib$stop
      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        ; make sure getjpi succeeded
      popl  r0
good: subl2 prccnt,prclm
      $faol_s  ctrstr=string,outlen=rlen,outbuf=buffer,prmlst=astcnt
      pushl r0
      pushl sp
      calls #1,iferr        ; make sure faol succeeded 
      popl  r0
good2:   movzwl   rlen,buffer   ; modify descriptor to use resultant length
      pushl    #ss$_normal  ; This part borders on "tricky code".  We want 
      pushl    #1           ; to let $putmsg actually write out the current 
      movl  sp,r0           ; quotas since it seems to have a magic way of
                            ; doing this even if the open file quota has
                            ; been exceeded.  The technique we use is to
                            ; call $putmsg with a dummy status (in this
                            ; case ss$_normal), but specify an action
                            ; routine which will be executed after the
                            ; message code has been retrieved and stuffed
                            ; into a buffer.  The tricky part is that in the
                            ; action routine we overwrite the descriptor of
                            ; the buffer $putmsg used for our bogus message
                            ; with a descriptor for the stuff we really want
                            ; written out.
      $putmsg_s   msgvec=(r0),actrtn=fake_it
      pushl r0
      pushl sp
      calls #1,iferr        ; make sure putmsg succeeded.
good3:   ret
fake_it:                    ; see comments above
      .word    0
      movq     buffer,@4(ap)   ; here's where we overwrite putmsg's descriptor 
      movl     #ss$_normal,r0
      ret
;     set up item list for call to getjpi
      .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:
      defitem  astcnt
      defitem  biocnt
      defitem  bytcnt
      defitem  diocnt
      defitem  filcnt
      defitem  prccnt
      defitem  prclm
      defitem  tqcnt
      .long    0   ; end of item 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