ASMB,R,Q,C
      HED G1STM 
*     NAME:   G1STM 
*     SOURCE: 92067-18436 
*     RELOC:  92067-16425 
*     PGMR:   A.M.G.
* 
*  ***************************************************************
*  * (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 G1STM,8 92067-16425 REV.1903 790103 
      ENT G1STM 
* 
      EXT G1OMS,CNUMD,KCVT,.DFER
      EXT ZPUT,SETDB,IPRSN,G0UG1
      EXT G0WD2,G0WD3,G0WD7,G0W11,G0BUF 
* 
*     THIS ROUTINE PRINTS THE JOB STATUS MESSAGE FOR GASP 
*     THE CALLING SEQUENCE IS:
* 
*     JSB G1STM 
*     DEF JRECNO    JOB NO. + 18
*     DEF U.G       =0 IF NO U.G TO PRINT ELSE #0 
* 
G1STM NOP 
      DLD G1STM,I   GET THE PRAM ADDRESSES
      ISZ G1STM     SET RETURN ADDRESS
      ISZ G1STM     SET RETURN ADDRESS
      LDA A,I       GET THE JOB NUMBER
      ADA N18       AND ADJUST
      STA JNO       SAVE FOR CONVERSION 
      LDB B,I       GET THE U.G FLAG
      STB U.GF      AND SAVE IT 
      JSB CNUMD     CONVERT 
      DEF *+3 
      DEF JNO       THE JOB NUMBER
      DEF STAT      TO THE STATUS BUFFER
      DLD STAT+1    MOVE THE RESULT ONE CHAR
      RRL 8         TO THE LEFT 
      DST STAT+1    RESTORE THE DATA
      JSB .DFER     MOVE NAME TO BUFFER.
      DEF NAME
      DEF G0WD7 
      JSB CNUMD     CONVERT THE 
      DEF *+3 
      DEF G0BUF     PRIORITY
      DEF STUS      TO THE BUFFER 
      LDA G0WD3     FIGURE DIRECT 
      AND MASKL     OR
      LDB DIR       SPOOL JOB 
      SZA           WELL? 
      LDB SRC       SPOOL JOB 
      STB STUS      SET RESULT
      LDA G0WD2     GET THE STATUS FLAG 
      AND B377      KEEP LOW PART 
      CPA G0WD2     IF SAME 
      IOR HBLK      PAD WITH A BLANK
      IOR G0WD2     AND SET 
      STA STUS+3    STATUS IN BUFFER
      LDA BLANK     GET A BLANK AND 
      STA STUS+4    PAD THE NEXT WORD 
      LDA D18       SET DEFAULT LENGTH (ALSO START OF FILES)
      STA LEN       IN CASE NO U.G OR FILES 
      INA           SET START ADDRESS FOR 
      STA STAT      U.G NAMES 
      LDA U.GF      CHECK IF USER GROUP TO BE 
      SZA,RSS       PRINTED 
      JMP NOU.G     NO SKIP THE FORMATING 
* 
      JSB IPRSN     ELSE PUT OUT A
      DEF *+4       MUG SHOT OF THE USER
      DEF G0UG1     11 WORD SOURCE TABLE
      DEF STAT+1    BUFFER ADDRESS
      DEF STAT      FIRST WORD OF BUFFER IS LENGTH
      LDA ILEN      SET START ADDRESS FOR 
      STA LEN       FILE REPORTS
NOU.G JSB SETDB     SET UP THE CHAR DEST. BUFFER
      DEF *+3 
      DEF STAT+1
      DEF LEN       AND COUNTER 
      CLA,INA 
      STA FNUM
      LDA W11AD 
      RAL,CLE,SLA,ERA REMOVE INDIRECT BIT 
      LDA A,I       GET DIRECT ADDRESS
      STA ADDR1 
      LDA M5
      STA CNTR
LOOP  LDA M16 
      STA CNTR1 
      LDA ADDR1,I 
      STA SAVE
ILOP  SLA 
      JMP GOTON 
BACK  RAR 
      STA SAVE
      ISZ FNUM
      ISZ CNTR1 
      JMP ILOP
* 
      ISZ ADDR1 
      ISZ CNTR
      JMP LOOP
* 
OUT   LDA LEN       CALCULATE THE RECORD SIZE 
      CPA ILEN      IF NO FILES 
      LDA STAT      USE PASSED BACK COUNT 
      CMA,INA       SET NEG TO INDICATE CHAR
      STA STAT      SET LENGTH IN THE BUFFER
      JSB G1OMS 
      DEF *+2 
      DEF STAT
      JMP G1STM,I 
GOTON JSB KCVT      CONVERT 
      DEF *+2 
      DEF FNUM      THE FILE NUMBER 
      STA TBUF      SAVE IN A BUFFER
      JSB ZPUT      PUT THE THREE CHAR STRING ' XX' 
      DEF *+4 
      DEF BLANK     STARTS WITH SECOND BLANK
      DEF D2
      DEF D3        3 CHARS 
      LDA LEN       CHECK IF ROOM FOR MORE
      ADA N76 
      SSA,RSS       WELL??
      JMP OUT       NO MORE ROOM  JUST REPORT WHAT WE HAVE
      LDA SAVE
      JMP BACK      NO CONTINUE 
* 
* 
      SUP 
JNO   NOP 
U.GF  NOP 
N18   DEC -18 
STAT  ASC 3 
NAME  ASC 3 
STUS  BSS 29
* 
DIR   ASC 1, D
SRC   ASC 1, S
LEN   NOP 
ILEN  DEC 40
FNUM  BSS 1 
ADDR1 BSS 1 
CNTR  BSS 1 
W11AD DEF G0W11 
CNTR1 BSS 1 
B377  OCT 377 
MASKL OCT 177400
D2    DEC 2 
D3    DEC 3 
D18   DEC 18
N76   DEC -76 
M5    DEC -5
M16   DEC -16 
BLANK OCT 20040 
TBUF  NOP           MUST BE AFTER A BLANK 
HBLK  OCT 20000 
SAVE  BSS 1 
A     EQU 0 
B     EQU 1 
      END 
                                                