*AUDIT TRAIL PRINT (LINE) FORMATTER                     HEADER  FUPFOR  0001.000
         M.PGM     FORMATST,MPX-32,3.6.1,00                             0002.000
         SPACE     2                                                    0003.000
         CSECT                                                          0004.000
         SPACE     2                                                    0005.000
*                                                                       0006.000
************************************************************************0007.000
*                                                                      *0008.000
*                    PROPRIETARY INFORMATION                           *0009.000
*                    -----------------------                           *0010.000
*   THE INFORMATION CONTAINED HEREIN IS PROPRIETARY TO ENCORE          *0011.000
*   COMPUTER CORPORATION AND/OR ITS VENDORS, AND ITS USE, DISCLOSURE,  *0012.000
*   OR DUPLICATION IS SUBJECT TO THE RESTRICTIONS STATED IN THE        *0013.000
*   STANDARD ENCORE COMPUTER CORPORATION LICENSE TERMS AND CONDITIONS  *0014.000
*   OR THE APPROPRIATE THIRD-PARTY SUBLICENSE AGREEMENT.               *0015.000
*                                                                      *0016.000
*                       RESTRICTED RIGHTS                              *0017.000
*                       -----------------                              *0018.000
*   USE, DUPLICATION, OR DISCLOSURE BY THE GOVERNMENT IS SUBJECT       *0019.000
*   TO RESTRICTIONS AS SET FOURTH IN SUBDIVISION (c) (1) (ii) OF       *0020.000
*   THE RIGHTS IN TECHNICAL DATA AND COMPUTER SOFTWARE CLAUSE AT       *0021.000
*   252.227.7013                                                       *0022.000
************************************************************************0023.000
* (C) COPYRIGHT 1989 ENCORE COMPUTER CORPORATION                       *0024.000
*     ALL RIGHTS RESERVED                                              *0025.000
************************************************************************0026.000
*++++                                                                   0027.000
*                                                                       0028.000
*        THIS ROUTINE IS CALLED TO FORMAT A ASCII STRING BY COMBINING   0029.000
*        ASCII CONSTANTS WITH VARIABLES FORMATED INTO THE RESLULTANT    0030.000
*        BUFFER.                                                        0031.000
*                                                                       0032.000
* EXTERNAL REFERENCES:                                                  0033.000
*                                                                       0034.000
         DEF       FORMATST                                             0035.000
         M.REQS                                                         0036.000
         M.COMM.                                                        0037.000
*                                                                       0038.000
*-                                                                      0039.000
* GLOBAL DEFINITIONS:                                                   0040.000
*                                                                       0041.000
*        NONE                                                           0042.000
*                                                                       0043.000
*-                                                                      0044.000
* COMMON AREAS:                                                         0045.000
*                                                                       0046.000
*        NONE                                                           0047.000
*                                                                       0048.000
*----                                                                   0049.000
         TITLE     FORMATST                                             0050.000
         PAGE                                                           0051.000
*++++                                                                   0052.000
* ROUTINE: FORMATST                                                     0053.000
*                                                                       0054.000
* INPUTS:                                                               0055.000
*                                                                       0056.000
*        R1 = ADDRESS OF STACK AREA, FILE BOUNDED AND CONTAINING        0057.000
*             ONE SIXTEEN WORD AREA FOR EACH RECURSION.                 0058.000
*        R2 = INPUT FORMAT STRING CONTAINING CONSTANTS AND DIRECTIVES   0059.000
*        R3 = PARAMETER BLOCK TO BE FORMATED                            0060.000
*        R6 = ADDRESS OF OUTPUT BUFFER                                  0061.000
*        R7 = SIZE OF OUTPUT BUFFER                                     0062.000
*                                                                       0063.000
* IMPLICIT INPUTS:                                                      0064.000
*                                                                       0065.000
*        NONE                                                           0066.000
*                                                                       0067.000
* DESCRIPTION:                                                          0068.000
*                                                                       0069.000
*        THIS ROUTINE IS CALLED TO FORMAT A ASCII STRING BY COMBINING   0070.000
*        ASCII CONSTANTS WITH VARIABLES FORMATED INTO THE RESLULTANT    0071.000
*        BUFFER.                                                        0072.000
*                                                                       0073.000
*        THE FORMAT STRING IS A SERIES OF ASCII CHARACTERS TERMINATED BY0074.000
*        A ZERO BYTE. THE STRING CONTAINS ASCII CONSTANTS AND FORMAT    0075.000
*        DIRECTIVES. THE ROUTINE COPIES THE INPUT STRING TO THE         0076.000
*        OUTPUT UNTIL A FORMAT DIRECTIVE IS ENCOUNTERED. THEN THE       0077.000
*        NEXT ITEM IN THE PARAMETER BLOCK IS FORMATED ACCORDING TO      0078.000
*        THE DIRECTIVE AND ADDED TO THE OUTPUT STRING.                  0079.000
*                                                                       0080.000
* OUTPUTS:                                                              0081.000
*                                                                       0082.000
*        R1 = ADDRESS OF STACK AS INPUT TO THIS ROUTINE                 0083.000
*        R2 = LAST BYTE PROCESSED IN FORMAT STRING                      0084.000
*        R3 = NEXT PARAMETER IN BLOCK                                   0085.000
*        R6 = OUTPUT BUFFER                                             0086.000
*        R7 = LEFT HALFWORD IS BYTES FORMATED, RIGHT IS BUFFER SIZE     0087.000
*        R4,R5 ARE USED BY THIS ROUTINE                                 0088.000
*                                                                       0089.000
* IMPLICIT OUTPUTS:                                                     0090.000
*                                                                       0091.000
*        NONE                                                           0092.000
*                                                                       0093.000
         TITLE     FORMATTER DEFINITIONS                                0094.000
*                                                                       0095.000
*    LOCAL DEFINITIONS                                                  0096.000
*                                                                       0097.000
*0       EQU       0               REGISTER ZERO                        0098.000
*1       EQU       1               REGISTER ONE                         0099.000
*2       EQU       2               REGISTER TWO                         0100.000
*3       EQU       3               REGISTER THREE                       0101.000
*4       EQU       4               REGISTER FOUR                        0102.000
*5       EQU       5               REGISTER FIVE                        0103.000
*6       EQU       6               REGISTER SIX                         0104.000
*7       EQU       7               REGISTER SEVEN                       0105.000
*C1      EQU       1               CONDITION CODE ONE                   0106.000
*C2      EQU       2                 TWO                                0107.000
*C3      EQU       3                   THREE                            0108.000
*C4      EQU       4                     AND FOUR                       0109.000
FBIT     EQU       12              "F" BIT, EG: BYTE ADDRESS            0110.000
STKSIZE  EQU       2F              SIZE OF STACK FRAME                  0111.000
         SPACE                                                          0112.000
*                                                                       0113.000
*    FORMATTER STACK OFFSETS                                            0114.000
*                                                                       0115.000
FS.TEMP  EQU       0W              SCRATCH AREA                         0116.000
FS.TEND  EQU       1F              END OF SCRATCH AREA                  0117.000
FS.USRET EQU       0W+1F           USER RETERN ADDRESS                  0118.000
FS.SAVSP EQU       1W+1F           SAVED STACK POINTER                  0119.000
FS.FMTAD EQU       2W+1F           CURRENT FORMAT STRING ADDRESS        0120.000
FS.PRMBK EQU       3W+1F           ADDRESS OF PARAMETER BLOCK           0121.000
FS.FLAGS EQU       4W+0B+1F        INTERNAL FLAGS                       0122.000
FS.FTYPE EQU       4W+1B+1F        CURRENT FORMAT TYPE                  0123.000
FS.LENTH EQU       4W+2B+1F        NUMBER OF TO BYTES OUTPUT            0124.000
FS.COUNT EQU       4W+3B+1F        REPEAT COUNT FOR ITEM                0125.000
FS.OUTST EQU       5W+0H+1F        STARTING OUTPUT INDEX                0126.000
FS.OFSET EQU       5W+1H+1F        OFFSET TO FIELD TO OUTPUT            0127.000
FS.OUTBF EQU       6W+1F           ADDRESS OF OUTPUT BUFFER             0128.000
FS.CUROT EQU       7W+1F           CURRENT OUTPUT INDEX                 0129.000
FS.BUFSZ EQU       7W+1H+1F        SIZE OF OUTPUT BUFFER                0130.000
FS.END   EQU       2F              END OF STACK SPACE                   0131.000
*                                                                       0132.000
*    DEFINE COMMAND FLAG BITS                                           0133.000
*                                                                       0134.000
B.NU     EQU       7               BIT IN BYTE - NUMERIC CONVERSION     0135.000
W.NU     EQU       31              SAME FOR BIT IN REGISTER (WORD)      0136.000
W.IN     EQU       0               PARAMETER REFERENCED INDIRECTLY      0137.000
W.MI     EQU       1               FLAG MINUS SIGN NEEDED IN OUTPUT     0138.000
         TITLE     FORMATTER LOCAL DATA                                 0139.000
*                                                                       0140.000
* MACRO TO GENERATE DISPATCH TABLE HALFWORD INDEX                       0141.000
*                                                                       0142.000
ACTVEC   DEFM      ADR,INDX                                             0143.000
         IFP       %INDX,%A1                                            0144.000
%INDX    EQU       $-ACTABLE                                            0145.000
%A1      ANOP                                                           0146.000
         DATAH     %ADR-ACTABLE                                         0147.000
         ENDM                                                           0148.000
*                                                                       0149.000
* MACRO TO RECURSIVELY CALL THE FORMATTER                               0150.000
*                                                                       0151.000
RECURSE  DEFM                                                           0152.000
         ADI       R1,FS.TEND      DEALLOCATE TEMPORARY BUFFER          0153.000
         BL        FORMATST        FORMAT THE STRING                    0154.000
         SUI       R1,FS.TEND      REALLOCATE THE TEMPORARY BUFFER      0155.000
         ENDM                                                           0156.000
*                                                                       0157.000
*    DEFINE COMMAND DECODE TABLES                                       0158.000
*                                                                       0159.000
CMDCHARS EQU       $               COMMAND TABLE                        0160.000
         DATAB     C'*',F.IND      INDIRECT COMMAND                     0161.000
         DATAB     C'(',F.REC      RECURSE COMMAND                      0162.000
         DATAB     C')',F.ENR      END RECURSION LOOP                   0163.000
         DATAB     C'#',F.REP      VARIABLE REPEAT COUNT                0164.000
         DATAB     C'^',F.TAB      HORIZONTAL TAB                       0165.000
         DATAB     C'-',F.LST      USE LAST PARAMETER AGAIN             0166.000
         DATAB     C'+',F.SKP      SKIP ONE PARAMETER                   0167.000
         DATAB     C'A',F.ASC      ASCII CHAR FORMAT                    0168.000
         DATAB     C'C',F.CHR      ASCII CHAR DESCRIPTOR                0169.000
         DATAB     C'D',F.DAT      TODAYS DATE                          0170.000
         DATAB     C'L',F.LEN      LENGTH OF FORMATED OUTPUT            0171.000
         DATAB     C'N',F.DEC+1    DECIMAL NUMBER PLUS NUMERIC FLAG     0172.000
         DATAB     C'S',F.SPC      ADD SPACES TO THE BUFFER             0173.000
         DATAB     C'T',F.TIM      OUTPUT TIME OF DAY                   0174.000
         DATAB     C'X',F.HEX+1    HEX CONVERT PLUS NUMERIC FLAG        0175.000
         DATAB     C'Z',F.ASZ      ASCII ZERO STRING                    0176.000
         DATAB     0               TERMINATE THE TABLE                  0177.000
TIMEFMTS DATAB     C'%L2NB:%-L2NB1:%-L2NB2',0                           0178.000
*                                                                       0179.000
*     COMMAND DISPATCH TABLE MUST BE ORDERED THE SAME AS COMMANDS       0180.000
*                                                                       0181.000
*    NOTE: NUMERIC CONVERT ROUTINES COME IN THREE FLAVORS -             0182.000
*        BYTE, HALFWORD AND WORD AND MUST BE ORDERED AS SUCH            0183.000
*                                                                       0184.000
         BOUND     1W                                                   0185.000
ACTABLE  EQU       $               COMMAND ACTION DISPATCH TABLE        0186.000
         ACTVEC    INDIRECT,F.IND  INDIRECT ARGUMENT                    0187.000
         ACTVEC    RECURSE,F.REC   RECURSIVE CALL TO FORMATTER          0188.000
         ACTVEC    FMTEXIT,F.ENR   EXIT TO PREVIOUS LEVEL               0189.000
         ACTVEC    REPCOUNT,F.REP  VARIABLE REPEAT COUNT                0190.000
         ACTVEC    LSTAGAIN,F.LST  USE LAST PARAMETER OVER              0191.000
         ACTVEC    SKPPARAM,F.SKP  SKIP NEXT PARAMETER                  0192.000
         ACTVEC    ASCHARS,F.ASC   ASCII CHARACTERS IN THE BLOCK        0193.000
         ACTVEC    ASCDESC,F.CHR   ASCII CHARACTER DESCRIPTOR           0194.000
         ACTVEC    CURRDATE,F.DAT  CURRENT DATE OUTPUT                  0195.000
         ACTVEC    LENOUTPT,F.LEN  SET LENGTH OF OUTPUT                 0196.000
         ACTVEC    FMT.80,F.SPC    EXIT THE FORMATTING                  0197.000
         ACTVEC    TIMEODAY,F.TIM  FORMAT TIME OF DAY                   0198.000
*                                                                       0199.000
*                  NOTE                                                 0200.000
*                                                                       0201.000
*    PROGRAM LOGIC ASSUME THE ORDERING OF THE NUMERIC CONVERSION        0202.000
*    TABLES. THEY SHOULD NOT BE CHANGED                                 0203.000
*                                                                       0204.000
         ACTVEC    DECWORD,F.DEC   DECIMAL NUMBER                       0205.000
         ACTVEC    DECHALF0        HALFWORD VERSION                     0206.000
         ACTVEC    DECHALF1        RIGHT HALFWORD                       0207.000
         ACTVEC    DECBYTE0        LEFT MOST BYTE                       0208.000
         ACTVEC    DECBYTE1        NEXT                                 0209.000
         ACTVEC    DECBYTE2        ETC                                  0210.000
         ACTVEC    DECBYTE3        ETC ETC                              0211.000
         ACTVEC    HOZALTAB,F.TAB  HORIZONTAL TAB TO SPECIFIC COLUMN    0212.000
         ACTVEC    HEXWORD,F.HEX   HEXIDECIMAL NUMBER                   0213.000
         ACTVEC    HEXHALF0        HALFWORD                             0214.000
         ACTVEC    HEXHALF1        RIGHT HALFWORD                       0215.000
         ACTVEC    HEXBYTE0        BYTE CONVERSION                      0216.000
         ACTVEC    HEXBYTE1        BYTE CONVERSION                      0217.000
         ACTVEC    HEXBYTE2        BYTE CONVERSION                      0218.000
         ACTVEC    HEXBYTE3        AND MORE BYTE CONVERSION             0219.000
         ACTVEC    ASCIZERO,F.ASZ  ASCII ZERO STRING FORMATTER          0220.000
         TITLE     FORMAT ASCII STRING                                  0221.000
************************************************************************0222.000
*                                                                       0223.000
*    FORMAT ASCII STRING                                                0224.000
*                                                                       0225.000
************************************************************************0226.000
         SPACE                                                          0227.000
FORMATST EQU       $               FORMAT STRING                        0228.000
         SBR       R2,FBIT         SET BYTE ADDRESS BIT                 0229.000
         SUI       R1,STKSIZE      ALLOCATE STACK FRAME                 0230.000
         STF       R0,FS.USRET,R1  INIT THE FRAME                       0231.000
*                                                                       0232.000
*    COPY INPUT STRING TO OUTPUT LOOKING FOR FORMAT DIRECTIVE           0233.000
*                                                                       0234.000
FMT.00   BL        GETBYTE         GET NEXT BYTE FROM FORMAT STRING     0235.000
         CI        R5,G'%'         IS THIS A DIRECTIVE                  0236.000
         BEQ       FMT.10          BR IF YES                            0237.000
         BL        STORBYTE        BUT THE BYTE IN THE OUTPUT           0238.000
         BU        FMT.00          CONTINUE SCAN                        0239.000
         SPACE                                                          0240.000
*                                                                       0241.000
*    DIRECTIVE HAS BEEN FOUND                                           0242.000
*                                                                       0243.000
         SPACE                                                          0244.000
FMT.10   EQU       $               INIT VARIABLES FOR DIRECTIVE         0245.000
         ZMW       FS.FLAGS,R1     INIT VARIOUS BYTE PARAMETERS         0246.000
         ZMH       FS.OFSET,R1     RESET RAMDOM ADDRESS OFFSET          0247.000
         BL        GETNUMBR        GET NUMERIC FIELD FROM FORMAT STRING 0248.000
         STB       R7,FS.COUNT,R1  SAVE REPEAT COUNT                    0249.000
FMT.20   ZBR       R5,24           ZERO AND TEST SIGN BIT OF BYTE       0250.000
         BNS       FMT.25          BR IF VALID ASCII CHARACTER          0251.000
         SLL       R5,2            TURN INTO BYTE INDEX                 0252.000
         ARMH      R5,FS.OFSET,R1  UPDATE OFFSET VALUE                  0253.000
         SBM       15,FS.OFSET,R1  FLAG RANDOM ACCESS MODE TO BLOCK     0254.000
         BL        GETBYTE         GET NEXT BYTE FROM INPUT             0255.000
         BU        FMT.20          TRY AGAIN                            0256.000
FMT.25   ZR        R2              INIT INDEX INTO COMMAND TABLE        0257.000
FMT.30   LB        R7,CMDCHARS,R2  GET NEXT COMMAND                     0258.000
         BEQ       ERREXIT         NO COMMAND MATCH                     0259.000
         LB        R3,CMDCHARS+1,R2 GET COMMAND DISPATCH INDEX          0260.000
         ABR       R2,30           INCREMENT INDEX FOR BYTE PAIR        0261.000
         CAR       R5,R7           COMMAND MATCH                        0262.000
         BNE       FMT.30          NO-CONTINUE SCAN                     0263.000
         ZBR       R3,W.NU         CHECK IF NUMERIC DIRECTIVE           0264.000
         BNS       FMT.60          BR IF NOT NUMERIC                    0265.000
         LB        R5,*FS.FMTAD,R1 PEEK AT THE NEXT BYTE                0266.000
         CI        R5,G'W'         DOES IT SPECIFY WORD WIDTH           0267.000
         BEQ       FMT.50          BR IF YES                            0268.000
         CI        R5,G'H'         IS THIS HALFWORD WIDTH DIRECTIVE     0269.000
         BEQ       FMT.40          BR IF YES                            0270.000
         CI        R5,G'B'         HOW ABOUT BYTE WIDTH                 0271.000
         BNE       FMT.60          BR IF NO WIDTH CONTROL STATED        0272.000
         ADI       R3,4            ADJUST FORMAT DISPATCH INDEX         0273.000
FMT.40   ADI       R3,2            ADJUST DISPATCH INDEX                0274.000
         ABM       31,FS.FMTAD,R1  ADJUST POINTER OF WIDTH DIRECTIVE    0275.000
         LB        R5,*FS.FMTAD,R1 PEEK AT THE NEXT BYTE                0276.000
         SUI       R5,G'0'         CONVERT TO NUMERIC                   0277.000
         BLT       FMT.60          NOT A INDEX                          0278.000
         CI        R5,3            IS IT WITHIN THE LIMITS              0279.000
         BGT       FMT.60          BR IF NO - NOT A FIELD NUMBER        0280.000
         ADR       R5,R5           CONVERT TO HALFWORD INDEX            0281.000
         ADR       R5,R3           ADJUST DISPATCH INDEX                0282.000
FMT.50   ABM       31,FS.FMTAD,R1  DIRECTIVE WAS WIDTH - REMOVE IT      0283.000
FMT.60   STB       R3,FS.FTYPE,R1  SAV FORMAT TYPE FOR REPEAT           0284.000
FMT.70   LH        R0,FS.CUROT,R1  GET CURRENT OUTPUT INDEX             0285.000
         STH       R0,FS.OUTST,R1  MARK START OF CURRENT OUTPUT FIELD   0286.000
         LH        R2,ACTABLE,R3   GET INDEX TO ACTION ROUTINE          0287.000
         BU        ACTABLE,R2      DISPATCH TO ACTION                   0288.000
FMT.80   LB        R6,FS.LENTH,R1  GET LENGTH SPECIFIED FOR FIELD       0289.000
         BEQ       FMT.95          BR IF NO LENGTH SPECIFIED            0290.000
         ADMH      R6,FS.OUTST,R1  ADD IN THE STARTING INDEX            0291.000
FMT.85   CAMH      R6,FS.CUROT,R1  CHECK FOR SPECIFIED WIDTH            0292.000
         BLE       FMT.90          BACKUP INDEX IF NECESSARY            0293.000
         LI        R5,G' '         NOT ENOUGH YET, GET A BLANK          0294.000
         BL        STORBYTE        SPACE OUT THE BUFFER                 0295.000
         BU        FMT.85          CHECK IF FILLED OUT YET              0296.000
FMT.90   STH       R6,FS.CUROT,R1  SET THE CURRENT OUTPUT INDEX         0297.000
FMT.95   LB        R4,FS.COUNT,R1  GET A COUNT                          0298.000
         SUI       R4,1            DECREMENT LOOP COUNT                 0299.000
         BLE       FMT.00          BRANCH IF NO MORE ITERATIONS TO DO   0300.000
         STB       R4,FS.COUNT,R1  SAVE CURRENT COUNT VALUE             0301.000
         LB        R3,FS.FTYPE,R1  GET FORMAT TYPE BYTE                 0302.000
         BU        FMT.70          GO DO DISPATCH AGAIN                 0303.000
         SPACE                                                          0304.000
*                                                                       0305.000
*    INDIRECT - THE PARAMETER BLOCK CONTAINS AN ADDRESS, NOT THE ARG    0306.000
*                                                                       0307.000
         SPACE                                                          0308.000
INDIRECT SBM       W.IN,FS.FLAGS,R1 FLAG INDIRECT REF TO PARAMETER VALUE0309.000
         BU        LEN.10          JOIN COMMON ROUTINE                  0310.000
         SPACE                                                          0311.000
*                                                                       0312.000
*    VARCOUNT - A VARIABLE REPEAT COUNT SPECIFIED                       0313.000
*                                                                       0314.000
         SPACE                                                          0315.000
REPCOUNT BL        GETPARAM        GET THE PARAMETER                    0316.000
         STB       R7,FS.COUNT,R1  SET REPEAT COUNT                     0317.000
         BU        LEN.10          SET PARAM AND SCAN AGAIN             0318.000
         SPACE                                                          0319.000
*                                                                       0320.000
*    LSTAGAIN - USE LAST PARAMETER AGAIN                                0321.000
*                                                                       0322.000
*    THIS COMMAND IS USED TO BACK UP PARAMETER POINTER TO               0323.000
*    REUSE THE SAME VALUE.                                              0324.000
*                                                                       0325.000
         SPACE                                                          0326.000
LSTAGAIN LI        R4,-4           GET CONSTANT                         0327.000
         ARMW      R4,FS.PRMBK,R1  BACK UP POINTER                      0328.000
         BU        LEN.10          COMMON EXIT POINT                    0329.000
         SPACE                                                          0330.000
*                                                                       0331.000
*    SKPPARAM - SKIP NEXT PARAMETER IN BLOCK                            0332.000
*                                                                       0333.000
*    THIS COMMAND CAUSES THE NEXT ENTRY IN THE PARAMETER BLOCK TO       0334.000
*    BE SKIPPED OVER SO THAT IT WILL NOT BE USED                        0335.000
*                                                                       0336.000
         SPACE                                                          0337.000
SKPPARAM ABM       29,FS.PRMBK,R1  ADVANCE POINTER                      0338.000
         BU        LEN.10          COMMON EXIT                          0339.000
         SPACE                                                          0340.000
*                                                                       0341.000
*    RECURSION SPECIFIED                                                0342.000
*                                                                       0343.000
         SPACE                                                          0344.000
RECURSE  LD        R2,FS.FMTAD,R1  GET CURRENT STRING AND PARAMETER     0345.000
         LD        R6,FS.OUTBF,R1  OUTPUT BUFFER DESCRIPTOR             0346.000
REC.10   RECURSE                   RECURSIVELY CALL THE FORMATTER       0347.000
         LI        R0,-1           GET A COUNTER                        0348.000
         ARMB      R0,FS.COUNT,R1  COUNT DOWN NUMBER OF ITERATIONS      0349.000
         LB        R0,FS.COUNT,R1  SET CC'S                             0350.000
         BLE       REC.20          BR IF ALL DONE                       0351.000
         LW        R2,FS.FMTAD,R1  GET POINTER TO START OF REPEAT STRING0352.000
         BU        REC.10          GO DO MORE FORMATTING                0353.000
REC.20   STD       R2,FS.FMTAD,R1  UPDATE FORMAT & PARAM BLK ADDRESSES  0354.000
         STD       R6,FS.OUTBF,R1  AND OUTPUT BUFFER POINTERS           0355.000
         BU        FMT.00          START FORMATTING AGAIN               0356.000
         SPACE                                                          0357.000
*                                                                       0358.000
*    LENOUTPT - SET LENGTH OF OUTPUT                                    0359.000
*                                                                       0360.000
         SPACE                                                          0361.000
LENOUTPT BL        GETNUMBR        GET NUMBERIC VALUE                   0362.000
         STB       R7,FS.LENTH,R1  SAVE THAT VALUE                      0363.000
         TRR       R7,R7           WAS THERE A NON-ZERO VALUE           0364.000
         BNE       FMT.20          CONTINUE SCAN IF VALUE PRESENT       0365.000
         CI        R5,G'#'         LENGTH IN PARAMETER BLOCK            0366.000
         BNE       ERREXIT         THATS AN ERROR                       0367.000
         BL        GETPARAM        GET THE VALUE                        0368.000
         STB       R7,FS.LENTH,R1  SAVE IT                              0369.000
LEN.10   BL        GETBYTE         SET NEXT CHAR FROM FORMAT STRING     0370.000
         BU        FMT.20          CONTINUE SCAN                        0371.000
*                                                                       0372.000
*    HOZALTAB - HORIZONTAL TAB TO SPECIFIC COLUME                       0373.000
*                                                                       0374.000
         SPACE                                                          0375.000
HOZALTAB LB        R7,FS.COUNT,R1  GET COUNT FIELD                      0376.000
         ADMW      R7,FS.OUTBF,R1  ADD IN START OF THE BUFFER           0377.000
         LI        R5,G' '         GET A SPACE                          0378.000
HTB.10   BL        STORBYTE        OUTPUT A SPACE                       0379.000
         CAR       R7,R2           CHECK IF TABED FAR ENOUGH            0380.000
         BLE       HTB.10          BR IF NOT ENOUGH YET                 0381.000
         BU        FMT.00          START OVER                           0382.000
*                                                                       0383.000
*    ASCHARS - ASCII CHARS TO BE OUTPUT                                 0384.000
*                                                                       0385.000
         SPACE                                                          0386.000
ASCHARS  BL        GETPARAM        GET PARAMETER VALUE                  0387.000
         LI        R4,X'7F'        CHARACTER MASK                       0388.000
         LI        R6,-4           NUMBER OF CHARACTERS                 0389.000
ASC.10   SLC       R7,8            POISITION NEXT IN LEAST SIG BYTE     0390.000
         TRRM      R7,R5           ISOLATE THE BYTE                     0391.000
         BL        STORBYTE        STORE IN OUTPUT BUFFER               0392.000
         BIB       R6,ASC.10       LOOP                                 0393.000
         BU        FMT.80          TERMINATE LOOP                       0394.000
         SPACE                                                          0395.000
*                                                                       0396.000
*    ASCDESC - ASCII CHARS BY DESCRIPTOR                                0397.000
*                                                                       0398.000
*        THE PARAMETER BLOCK CONTAINS A DESCRIPTOR CONSISTING           0399.000
*        OF 24 BITS OF ADDRESS PLUS AN 8 BIT COUNT OF BYTES.            0400.000
*                                                                       0401.000
         SPACE                                                          0402.000
ASCDESC  BL        GETPARAM        GET PARAMETER                        0403.000
         TRR       R7,R3           GET ADDRESS INTO INDEX REG           0404.000
         SRL       R7,24           GET COUNT INTO LEAST SIG BYTE        0405.000
ASD.10   SUI       R7,1            COUNT DOWN NUMBER TO GO              0406.000
         BLT       FMT.80          EXIT TO DISPATCHER WHEN DONE         0407.000
         LB        R5,0B,R3        GET NEXT BYTE                        0408.000
         BL        STORBYTE        PUT THAT BYTE IN THE BUFFER          0409.000
         ADI       R3,1            BUMP INDEX TO CHAR                   0410.000
         BU        ASD.10          EXIT TO DISPATCHER                   0411.000
         SPACE                                                          0412.000
*                                                                       0413.000
*    ASCIZERO - ASCII ZERO TERMINATED STRINGS                           0414.000
*                                                                       0415.000
         SPACE                                                          0416.000
ASCIZERO BL        GETPARAM        GET THE PARAMETER                    0417.000
         TRR       R7,R3           GET ADDRESS INTO INDEX REGISTER      0418.000
ASZ.10   LB        R5,0B,R3        GET NEXT BYTE FROM THE STRING        0419.000
         BEQ       ASZ.20          BR IF END OF STRING                  0420.000
         BL        STORBYTE        BUT THE BYTE IN THE BUFFER           0421.000
         ADI       R3,1            INCREMENT STRING POINTER             0422.000
         BU        ASZ.10          LOOP FOR NEXT BYTE                   0423.000
ASZ.20   BU        FMT.80          BACK TO MAIN LOOP                    0424.000
         SPACE                                                          0425.000
*                                                                       0426.000
*    TIMEODAY - OUTPUT TIME OF DAY INTO STRING                          0427.000
*                                                                       0428.000
         SPACE                                                          0429.000
TIMEODAY M.TDAY                    ASK MPX FOR THE TIME                 0430.000
         STW       R7,FS.TEMP,R1   BUT DATA IN STACK TEMP               0431.000
         LA        R2,TIMEFMTS     GET FORMAT STRING                    0432.000
         LA        R3,FS.TEMP,R1   PARAMETER BLOCK                      0433.000
         LD        R6,FS.OUTBF,R1  GET CURRENT OUTPUT BUFFER DESCRITOR  0434.000
         RECURSE                   RECURSIVELY CALL THE FORMATTER       0435.000
         STD       R6,FS.OUTBF,R1  RESET OUTPUT BUFFER DESCRIPTOR       0436.000
         BU        FMT.80          EXIT THE FORMAT DIRECTIVE PROCESS    0437.000
         SPACE                                                          0438.000
*                                                                       0439.000
*    CURRDATE - ADD CURRENT DATE TO OUTPUT STRING                       0440.000
*                                                                       0441.000
         SPACE                                                          0442.000
CURRDATE LD        R6,C.DATE       GET THE DATE                         0443.000
DAT.10   LI        R4,-4           CHAR LOOP COUNT                      0444.000
DAT.20   SLC       R6,8            RIGHT JUSTIFY NEXT BYTE              0445.000
         TRR       R6,R5           GET DATA BYTE INTO CHARACTER REG     0446.000
         BL        STORBYTE        BUT IT IN THE OUTPUT                 0447.000
         BIB       R4,DAT.20       DO ALL 4 CHARS                       0448.000
         ZR        R6              ZERO THE VALUE JUST OUTPUT           0449.000
         XCR       R6,R7           GET OTHER WORD VALUE TO R6           0450.000
         BNE       DAT.10          BR IF NOT DONE YET                   0451.000
         BU        FMT.80          EXIT FORMAT DIRECTIVE PROCESSING     0452.000
         TITLE     NUMERIC CONVERSION ROUTINES                          0453.000
*                                                                       0454.000
*    NUMERIC CONVERSION ROUTINES                                        0455.000
*                                                                       0456.000
         SPACE                                                          0457.000
HEXBYTE0 LI        R3,0            OFFSET TO BYTE TO FETCH              0458.000
         BU        HXB.00          JOIN COMMON CODE                     0459.000
         SPACE                                                          0460.000
HEXBYTE1 LI        R3,1            OFFSET TO BYTE TO FETCH              0461.000
         BU        HXB.00          JOIN COMMON CODE                     0462.000
         SPACE                                                          0463.000
HEXBYTE2 LI        R3,2            OFFSET TO BYTE TO FETCH              0464.000
         BU        HXB.00          JOIN COMMON CODE                     0465.000
         SPACE                                                          0466.000
HEXBYTE3 LI        R3,3            OFFSET TO BYTE TO FETCH              0467.000
         SPACE                                                          0468.000
HXB.00   LI        R5,2            WIDTH FOR HEX BYTE                   0469.000
         BL        GETPARAM        GET BYTE VALUE                       0470.000
         ADR       R3,R2           ADJUST BYTE OFFSET                   0471.000
         LB        R7,0B,R2        GET VALUE AS 8 BIT BYTE              0472.000
         BU        HEX.00          COMMON ENTRY                         0473.000
         SPACE                                                          0474.000
HEXHALF0 LI        R3,0            OFFSET TO HALFWORD DESIRED           0475.000
         BU        HXH.00          JOIN COMMON CODE                     0476.000
         SPACE                                                          0477.000
HEXHALF1 LI        R3,2            OFFSET TO DESIRED HALFWORD           0478.000
         SPACE                                                          0479.000
HXH.00   LI        R5,4            WIDTH FOR HEX HALFWORD               0480.000
         BL        GETPARAM        GET PARAMETER ADDRESS IN REG 2       0481.000
         ADR       R3,R2           ADJUST FOR DESIRED HALFWORD          0482.000
         SBR       R2,31           FORCE HALFWORD ADDRESS (C-BIT)       0483.000
         LW        R7,0W,R2        GET HALFWORD-UG-THANKS TO C-BIT IN R20484.000
         ANMW      R7,=X'0000FFFF' RETAIN HALFWORD ONLY                 0485.000
         BU        HEX.00          COMMON ENTRY                         0486.000
         SPACE                                                          0487.000
HEXWORD  LI        R5,8            WIDTH FOR HEX WORD                   0488.000
         BL        GETPARAM        GET PARAMETER VALUE                  0489.000
HEX.00   LI        R4,16           RADIX FOR CONVERT                    0490.000
         BU        CVT.00          JION COMMON CONVERT LOGIC            0491.000
         SPACE                                                          0492.000
DECBYTE0 LI        R3,0            BYTE OF INTEREST                     0493.000
         BU        DCB.00          JOIN COMMON ENTRY                    0494.000
         SPACE                                                          0495.000
DECBYTE1 LI        R3,1            BYTE OF INTEREST                     0496.000
         BU        DCB.00          JOIN COMMON CODE                     0497.000
         SPACE                                                          0498.000
DECBYTE2 LI        R3,2            BYTE OF INTEREST                     0499.000
         BU        DCB.00          JOIN COMMON CODE                     0500.000
         SPACE                                                          0501.000
DECBYTE3 LI        R3,3            BYTE OF INTEREST                     0502.000
         SPACE                                                          0503.000
DCB.00   LI        R5,4            WIDTH FOR BYTE                       0504.000
         BL        GETPARAM        GET THE VALUE                        0505.000
         ADR       R3,R2           ADJUST TO DESIRED BYTE               0506.000
         LB        R7,0B,R2        GET VALUE AS A BYTE                  0507.000
         BU        DEC.00          COMMON ENTRY                         0508.000
         SPACE                                                          0509.000
DECHALF0 LI        R3,0            HALFWORD OF INTEREST                 0510.000
         BU        DCH.00          JOIN COMMON CODE                     0511.000
         SPACE                                                          0512.000
DECHALF1 LI        R3,2            INDEX TO HALFWORD OF INTEREST        0513.000
         SPACE                                                          0514.000
DCH.00   LI        R5,6            WIDTH FOR HALFWORD                   0515.000
         BL        GETPARAM        GET PARAMETER ADDRESS TO REG 2       0516.000
         ADR       R3,R2           FIND HALFWORD ADDRESS                0517.000
         SBR       R2,31           SET C-BIT FOR HALFWORD ADDRESS       0518.000
         LW        R7,0W,R2        GET HALFWORD-UG-THANHS TO C-BIT IN R20519.000
         BU        DEC.00          COMMON ENTRY                         0520.000
         SPACE                                                          0521.000
DECWORD  LI        R5,12           DEFAULT WIDTH                        0522.000
         BL        GETPARAM        GET WORD VALUE                       0523.000
DEC.00   LI        R4,10           RADIX FOR CONVERSION                 0524.000
         TRR       R7,R7           IS VALUE NEGATIVE                    0525.000
         BNN       CVT.00          BR IF POSITIVE NUMBER                0526.000
         TRN       R7,R7           MAKE POSITIVE                        0527.000
         SBM       W.MI,FS.FLAGS,R1 MARK MINUS SIGN NEEDED              0528.000
         SPACE                                                          0529.000
CVT.00   LB        R6,FS.LENTH,R1  CHECK IF LENGTH GIVEN                0530.000
         BNE       CVT.04          BR IF YES                            0531.000
         STB       R5,FS.LENTH,R1  SAVE DEFAULT LENGTH FOR VALUE        0532.000
CVT.04   LA        R3,FS.TEND,R1   SET  ADDRESS OF SCRATCH BUFFER       0533.000
CVT.10   ZR        R6              CLEAR HI HALF OF DOUBLEWORD          0534.000
         DVR       R4,R6           GET NEXT COMPONENT OF RADIX          0535.000
         ADI       R6,G'0'         ADD IN ASCII BIAS                    0536.000
         CI        R6,G'9'         IS CHARACTER ABOVE ASCII NINE        0537.000
         BLE       CVT.12          BR IF NO - CHAR IS OK                0538.000
         ADI       R6,G'A'-G'0'-10 ADJUST CHARACTER TO HEX              0539.000
CVT.12   SUI       R3,1            BACKUP BUFFER POINTER                0540.000
         STB       R6,0B,R3        SET RESULT IN BUFFER                 0541.000
         TRR       R7,R7           IS VALUE ZERO YET                    0542.000
         BNE       CVT.10          CONTINUE IF NO                       0543.000
         ZBM       W.MI,FS.FLAGS,R1 IS A MINUS SIGN NEEDED              0544.000
         BNS       CVT.15          BR IF NO                             0545.000
         LI        R5,G'-'         GET THE CHARACTER                    0546.000
         SUI       R3,1            BACKUP ONE CHARACTER                 0547.000
         STB       R5,0B,R3        SET CHARACTER INTO BUFFER            0548.000
CVT.15   LA        R7,FS.TEND,R1   GET END OF FORMATTED STRING          0549.000
         SUR       R3,R7           NUMBER OF BYTES GENERATED            0550.000
         LB        R6,FS.LENTH,R1  GET THE DEFINED LENGTH               0551.000
         SUR       R7,R6           FIND NUMBER OF SPACES NEEDED         0552.000
         BGE       CVT.20          BR IF NO OVERFLOW                    0553.000
         ADR       R6,R7           REDUCE SIZE OF OUTPUT FIELD          0554.000
         SUR       R6,R3           ADVANCE POINTER                      0555.000
CVT.20   LI        R5,G' '         ASSUME LEADING SPACES NEEDED         0556.000
         CI        R4,10           WAS IT DECIMAL RADIX                 0557.000
         BEQ       CVT.30          BR IF YES-USE A SPACE                0558.000
         LI        R5,G'0'         USE LEADING ZEROS OTHERWISE          0559.000
CVT.30   SUI       R6,1            ANY MORE LEADING CHARACTERS NEEDED   0560.000
         BN        CVT.40          BR IF NO MORE NEEDED                 0561.000
         BL        STORBYTE        OUTPUT FILLER                        0562.000
         BU        CVT.30          DO MORE IF NECESSARY                 0563.000
CVT.40   SUI       R7,1            COUNT NUMBER OF CONVERTED CHARS TO GO0564.000
         BN        CVT.50          BR IF ALL DONE                       0565.000
         LB        R5,0B,R3        GET NEXT CONVERTED CHARACTER         0566.000
         ADI       R3,1            ADVANCE POINTER                      0567.000
         BL        STORBYTE        PUT THIS ONE AWAY                    0568.000
         BU        CVT.40          CK FOR MORE                          0569.000
CVT.50   BU        FMT.80          RETURN TO DISPATCHER                 0570.000
         SPACE                                                          0571.000
*                                                                       0572.000
*    GETNUMBR - GET NUMERIC VALUE FROM FORMAT STRING                    0573.000
*                                                                       0574.000
*    THIS ROUTINE IS CALLED TO CONVERT AN ASCII NUMERIC CONSTANT        0575.000
*    FROM THE FORMAT STRING.  IT RETURNS WITH THE VALUE IN R7           0576.000
*    R5 CONTAINS THE CHARACTER THE CONVERSION STOPPED ON.               0577.000
*                                                                       0578.000
GETNUMBR TRR       R0,R4           SAVE RETURN ADDRESS                  0579.000
         ZR        R7              ZERO INITIAL VALUE                   0580.000
GNM.10   BL        GETBYTE         GET NEXT BYTE FROM FORMAT STRING     0581.000
         CI        R5,G'0'         IS CHARACTER BELOW NUMERICS          0582.000
         BLT       GNM.20          BR IF NOT NUMERIC                    0583.000
         CI        R5,G'9'         CHECK IF CHAR IS NUMERIC             0584.000
         BGT       GNM.20          BR IF NOT NUMERIC                    0585.000
         SUI       R5,G'0'         REMOVE ASCII BIAS                    0586.000
         MPI       R6,10           SCALE RESULT FOR DECIMAL RADIX       0587.000
         ADR       R5,R7           ACCUMULATE RESULT                    0588.000
         BU        GNM.10          CONTINUE SCAN                        0589.000
GNM.20   TRSW      R4              RETURN TO CALLER                     0590.000
         TITLE     FORMATTER COMMON SUBROUTINES                         0591.000
*                                                                       0592.000
*    GETBYTE - GET THE NEXT BYTE FROM THE FORMAT STRING                 0593.000
*                                                                       0594.000
*        THE BYTE IS RETURNED IN R5.                                    0595.000
*                                                                       0596.000
         SPACE                                                          0597.000
GETBYTE  LB        R5,*FS.FMTAD,R1 GET THE NEXT BYTE                    0598.000
         BEQ       FMTEXIT         EXIT IF NO MORE                      0599.000
         ABM       31,FS.FMTAD,R1  ADVANCE POINTER TO NEXT BYTE         0600.000
         TRSW      R0              RETURN                               0601.000
         SPACE                                                          0602.000
*                                                                       0603.000
*    STORBYTE - STORE A BYTE IN THE OUTPUT BUFFER                       0604.000
*                                                                       0605.000
         SPACE                                                          0606.000
STORBYTE LH        R2,FS.CUROT,R1  GET CURRENT OUTPUT INDEX             0607.000
         CAMH      R2,FS.BUFSZ,R1  IS BUFFER POINTER PAST THE END       0608.000
         BGE       ERREXIT         BR IF YES                            0609.000
         ADMW      R2,FS.OUTBF,R1  FIND ADDRESS OF NEXT BYTE TO STORE   0610.000
         CI        R5,G' '         IS CHARACTER PRINTABLE               0611.000
         BGE       STB.10          BR IF LOOKS OK                       0612.000
         LI        R5,G'.'         PRINT A "DOT"                        0613.000
STB.10   STB       R5,0B,R2        STORE THE CHARACTER                  0614.000
         ABM       15,FS.CUROT,R1  BUMP OUTPUT INDEX                    0615.000
         TRSW      R0              RETURN                               0616.000
         SPACE                                                          0617.000
*                                                                       0618.000
*    GETPARAM - GET NEXT PARAMETER                                      0619.000
*                                                                       0620.000
*    THIS ROUTINE SETS THE ADDRESS OF THE NEXT PARAMETER INTO R2        0621.000
*    AND ITS VALUE INTO REGISTER SEVEN. IT CONSIDERS THE PRESENCE       0622.000
*    OF AN INDIRECT ('*') OPERATOR PRECEEDING THE OPERATION             0623.000
*                                                                       0624.000
         SPACE                                                          0625.000
GETPARAM LH        R2,FS.OFSET,R1  GET RANDOM ADDRESS IN BLOCK          0626.000
         BEQ       GAD.10          BR IF SEQUENTIAL ADDRESS             0627.000
         ZBR       R2,31           REMOVE RANDOM ACCESS FLAG            0628.000
         ADMW      R2,FS.PRMBK,R1  ADD IN CURRENT BASE OF STRUCTURE     0629.000
         BU        GAD.20          JOIN COMMON CODE                     0630.000
GAD.10   LW        R2,FS.PRMBK,R1  GET NEXT PARAMETER ADDRESS           0631.000
         ABM       29,FS.PRMBK,R1  BUMP POINTER TO NEXT                 0632.000
GAD.20   TBM       W.IN,FS.FLAGS,R1 WAS INDIRECT SPECIFIED              0633.000
         BNS       GAD.30          BR IF NO INDIRECTION                 0634.000
         LW        R2,0,R2         FOLLOW INDIRECT OPERATION            0635.000
GAD.30   LW        R7,0,R2         GET PARAMETER VALUE                  0636.000
         TRSW      R0              RETURN TO CALLER                     0637.000
         SPACE                                                          0638.000
*                                                                       0639.000
*    ROUTINE EXIT POINTS                                                0640.000
*                                                                       0641.000
ERREXIT  SBM       CC1,FS.USRET,R1 SET ERROR FLAG                       0642.000
FMTEXIT  STW       R1,FS.SAVSP,R1  SET CURRENT STACK IN SAVE AREA       0643.000
         LF        R0,FS.USRET,R1  RESTORE THE REGISTERS                0644.000
         LA        R1,STKSIZE,R1   CLEAR THE STACK                      0645.000
         TRSW      R0              GO BACK TO CALLER                    0646.000
         END                                                            0647.000
