         PCC      0
*M*      SL       DISPLAYS SEVERITY OF A ROM
*
*   CALL:        !SL rom-name
*
R1       EQU      1
R2       EQU      2
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
         REF      M:LL,M:C,J:JIT,J:CCBUF,J:ACCN
         REF      ERREXIT           ERROR MESSAGE PRINTER
F:SL     DSECT
F:SL     M:DCB    FILE,PASS
START    CSECT    1
         LI,R12   BA(J:ACCN)        DEFAULT ACCT
         LI,R11   8                 DEFAULT ACCT FLD LENGTH
         LI,R13   2                 R13=2: NO ACCT SPECIFIED
         LI,R6    BA(J:CCBUF)       STARTING PT FOR SCAN
         LC       J:JIT
         BCS,12   NOTBATCH          SKIP CODE FOR BATCH
         M:READ   M:C,(BUF,B1+1),(SIZE,80),WAIT
         LI,R6    BA(B1+1)          POINT AT CC INSTEAD OF CCBUF
NOTBATCH BAL,R7   SCAN              SCAN TO BLANK AFTER PROCESSOR CALL
         DATA     ' ',EH,X1,SCAN
EH       M:PRINT  (MESS,L('Eh?'+X'3000000'))
         CAL1,9   1
X1       BAL,R7   SCAN              SCAN TO START OF ROM NAME
         DATA     ' ',EH,SCAN,X2
X2       LW,R14   R6                COPY ROM NAME START ADDRESS
         BAL,R7   SCAN              SCAN TO END OF NAME
         DATA     '.',X3,X4,SCAN
X4       LI,R13   0                 ACCT SPECIFIED FLAG
X3       LW,R15   R6                COPY ADDR OF END-OF-NAME
         SW,R15   R14               R15=LENGTH OF NAME
         STB,R15  VLP+1             PUT LENGTH IN FPT
         SCS,R15  -8                MBS COUNT
         AI,R15   BA(VLP+1)+1       DEST ADDR
         MBS,R14  0                 MOVE NAME TO OPEN FPT
         BDR,R13  NAMEONLY          BRANCH IF NO ACCT SPECIFIED
         BAL,R7   SCAN              MOVE PAST '.'
         DATA     '.',EH,EH,X5      ACCT BYTE MUST FOLLOW DOT
X5       LW,R12   R6                COPY BA(ACCT START)
         LCW,R11  R6                COPY NEGATIVE TO COMPUTE LENGTH
         BAL,R7   SCAN              SCAN TO END OF ACCT
         DATA     '.',X6,X6,SCAN
X6       AW,R11   R6                R11=LENGTH OF ACCT
NAMEONLY LI,R13   BA(VLP+10)        MAKE ODD WORD
         STB,R11  R13                FOR MBS
         MBS,R12  0                 MOVE ACCT TO FPT
,,VLP    M:OPEN   F:SL,IN,(ABN,IOERR),(ERR,NEITHER),(FPARAM,FPB),;
                  (FILE,'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX','        ')
*
*   CHECK FOR ROM OR LMN
*
         LI,R15   X'20'             GET
         AND,R15  F:SL+5             ORG
         BEZ      ROM               BRANCH IF CONSECUTIVE
         LW,R15   %LMN              FLAG
         STW,R15  B2A                LMN
         M:READ   F:SL,(BUF,B1),(SIZE,48),WAIT,(KEY,HEAD)
         LB,R15   B1                CHK
         CI,R15   X'84'              LINK-BUILT
         BE       LINKLMN           NOTHING DOING IF SO
         LW,R4    B1+1              ISOLATE LMN SL
         SLS,R4   4
         SLS,R4   -28
         B        RL                GO SET IT UP
LINKLMN  M:PRINT  (MESS,LINK%)
         CAL1,9   1
*
*
ROM      LW,R15   %ROM              FLAG
         STW,R15  B2A                ROM
         M:PFIL   F:SL,EOF
         M:READ   F:SL,(BUF,B1),(SIZE,120),REV,WAIT
         LB,9     B1
         AI,9     -X'1C'            END-OF-ROM?
         BEZ      GOODROM
NEITHER  LCI      3                 MOVE
         LM,R1    NEITHER%           GROUSE
         STM,R1   B2A                 MESSAGE
         B        EDITDATE          GO BANG OUT THE MESSAGE
IOERR    EQU      %
         B        ERREXIT           PRINT ERROR MESSAGE
GOODROM  LI,3     115
LOOP     LB,4     B1+1,3
         BNEZ     GOT
         BDR,3    LOOP
         LB,4     B1+1
GOT      CI,R4    14                CHK FOR END-OF-MODULE
         BNE      %+2               NO
         LI,R4    0                 ASSUME SEVERITY 0, NOT 14
RL       LI,R5    2
         STB,R4   MEXIT,R5          SET STEP CC = SEV LVL
         LB,4     EB,4
         STB,4    B2+1
EDITDATE BAL,R14  FPS               EDIT MOD DATE INTO B2
         M:WRITE  M:LL,(BUF,B2A),(SIZE,29)
         B        MEXIT
         PAGE
*
*   SCANNER - SCANS A BYTE, THEN ACTS LIKE FORTRAN
*             ARITHMETIC 'IF' DEPENDING ON HOW THE BYTE
*             COMPARES WITH 1ST WORD OF PARAMETER LIST
*
*   CALL:
*         BAL,R7    SCAN
*         DATA      'char',lt-addr,eq-addr,gt-addr
*
SCAN     AI,R6    1                 BUMP PTR
         LB,R5    0,R6              GET BYTE
         CW,R5    0,R7              COMPARE
         STCF     R4                SAVE CC'S
         SCS,R4   4                 PUT CC'S IN LOW END OF REG
         AND,R4   =3                MASK CC'S
         LB,R4    TBL,R4            TRANSLATE CC'S TO INDEX
         LW,R4    *R7,R4            FIND WHAT WE'RE SUPPOSED TO DO
         B        0,R4              ...AND DO IT
TBL      DATA,1   2,1,3,0
         PAGE
*
*   FPARAM SEARCH FOR MODIFICATION DATE - EDIT INTO B2
*
FPS      LI,R5    FPB               START HERE
FPS1     AI,R5    1                 BUMP POINTER
         LW,R15   0,R5              GET WORD
         CW,R15   =X'0A000303'      MOD DATE?
         BNE      FPS1              NO
*
*   EDIT
*
         LI,R6    BA(B2)+8          SET UP EDIT STORING PTR
         LW,R15   1,R5              DO
         SLS,R15  -16                THE
         BAL,R7   ST2                 MONTHS
         LI,R15   '/'
         BAL,R7   ST1               SLASH
         LW,R15   1,R5              DO
         BAL,R7   ST2                DAYS
         LI,R15   '/'
         BAL,R7   ST1               SLASH
         LW,R15   2,R5              DO
         BAL,R7   ST2                YEARS
         LW,R15   =' - '
         BAL,R7   ST3               SPACER
         LW,R15   3,R5              DO
         SLS,R15  -16                THE
         BAL,R7   ST2                 HOURS
         LI,R15   ':'
         BAL,R7   ST1               COLON.
         LW,R15   3,R5              DO
         BAL,R7   ST2                MINUTES
         B        *R14              RETURN
         PAGE
*
*   STORE-ROUTINES FOR FPARAM EDIT
*
ST1      BAL,R1   STX
ST2      BAL,R1   STX
ST3      BAL,R1   STX
STX      AI,R1    -ST1              # OF CHARS-->R1
         LCW,R2   R1
         SAS,R2   3                 COMPUTE SHIFT COUNT
         SCS,R15  0,R2
STX0     SCS,R15  8                 POSITION CHAR
         AI,R6    1                 BUMP STORE PTR
         STB,R15  0,R6              STICK IT IN
         BDR,R1   STX0
         B        0,R7              RETURN
         PAGE
EB       TEXT     '0123456789ABCDEF'
NEITHER% TEXT     'NOT ROM/LMN'
%ROM     TEXT     'ROM'
%LMN     TEXT     'LMN'
HEAD     TEXTC    'HEAD'
LINK%    TEXTC    'SL WILL NOT WORK FOR LINK-BUILT LOAD MODULES'
         CSECT    0                 MODIFYABLE
MEXIT    DATA     X'04910001'
B1       DO1      30
         DATA     0
B2A      RES      1
B2       TEXT     'SEV 0    XX/XX/XX - XX:XX'
FPB      RES      90                FPARAM BUFFER
         END      START
