!PFMTQ4 IS EQUIVALENT TO F77FMT1 ON PERQ
!
!*     RUNCOMP=0 FOR COMPILE TIME FORMAT
!*     RUNCOMP=1 FOR RUN TIME FORMAT

!*                                                                      FORMATCD
!*

%EXTERNALINTEGERFN FORMATCD(%INTEGER INSTART,DISP,ARYADR,INLEN,OUTLEN,  
    LEVEL,RUNCOMP, %INTEGERNAME TABLEN, ACTFMTLEN)
!*
!*
%SWITCH SW(0 : 122)
%HALFINTEGER PTR, CODE, BRACK, FLAG, I, CHAR, BOTHZERO
%HALFINTEGER NXTCHAR, OUTPTR, FMTPTR, TEXTPTR, HOLLEN, QUOTE CNT,ITEMPTR
%HALFINTEGER COPYCODE, ERR,LINELEN
%INTEGER LARGESTINT, COUNT, NUMBER,FMTAD,INLENGTH
%HALFINTEGER NOCOMMA, J, K,COMMAREQD
%HALFINTEGERARRAY LOOP(0 : 8)
%BYTEINTEGERARRAYNAME FORMAT
%BYTEINTEGERARRAYFORMAT AF(0 : 1320)
%BYTEINTEGERARRAY HOLL(0 : 1320)
%RECORDFORMAT FMTF(%INTEGER WORD  %ORC
      ((%BYTEINTEGER CODE,SPARE %OR %HALFINTEGER EXP),  
        %HALFINTEGER COUNT))
%RECORD (FMTF) %ARRAYFORMAT ARYFMT(0:4000)
%RECORD (FMTF) %ARRAYNAME FMT
      FMTAD = INSTART
      FORMAT == ARRAY(INSTART,AF)
      FMT==ARRAY(ARYADR,ARYFMT)
%ROUTINE OPEHUSERERROR(%HALFINTEGER A,B,C,D)
WRITE(A,10)
NEWLINE
%END
%ROUTINE COPY(%INTEGER LEN,SBASE,%HALFINTEGER SDISP,
                  %INTEGER TBASE,%HALFINTEGER TDISP)
!{2900C}      %SYSTEMROUTINESPEC MOVE(%INTEGER LENGTH,FROM,TO)
{PERQC}      **@TBASE
{PERQC}      *LDDW
{PERQC}      **TDISP
{PERQC}      **@SBASE
{PERQC}      *LDDW
{PERQC}      **SDISP
{PERQC}      **LEN+1
{PERQC}      *STLATE_X'63'
{PERQC}      *MVBW
!{2900C}      MOVE(LEN,SBASE+SDISP,TBASE+TDISP)
%END
!*
!*                                                               PRINT FORMAT2
!*

      %ROUTINE PRINT FORMAT2
      %BYTEINTEGERARRAYNAME FORMAT
      %BYTEINTEGERARRAYFORMAT AF(0 : INLENGTH)
            FORMAT == ARRAY(FMTAD,AF)
      %STRING (255) S
      %HALFINTEGER END, START, FIN, LOOP, I, J
            END = -1
            START = 0
            FIN = 0
                  PRINTSTRING("CURRENT FORMAT")
                  NEWLINE
            LOOP = INLENGTH//LINELEN
            %IF INLENGTH-LOOP*LINELEN # 0 %THEN LOOP = LOOP+1
            %CYCLE I = 1,1,LOOP
                  NEWLINE
                  %IF I*LINELEN < INLENGTH %C
                     %THEN END = END+LINELEN %C
                     %ELSE END = INLENGTH-1 %AND FIN = 1
                  COPY(END-START+1,ADDR(FORMAT(0)),START,
               ADDR(S),1)
                  LENGTH(S) = END-START+1
                  PRINTSTRING(S)
                  %IF START <= ITEMPTR <= END %THEN %START
                        NEWLINE
                        S = ""
                        %IF ITEMPTR = 0 %THEN -> POINTER
                        %CYCLE J = 1,1,ITEMPTR-START
                              S = S." "
                        %REPEAT
POINTER:                S = S."!"
                        PRINTSTRING(S)
                        NEWLINES(2)
                  %FINISH
                  %IF FIN # 1 %THEN START = START+LINELEN %C
                     %ELSE %RETURN
            %REPEAT
      %END
!*
!*                                                                      ERROR
!*

            %INTEGERFN ERROR(%HALFINTEGER NO)
!*                                      101 NO LEFT BRACKET
!*                                      102 NO RIGHT BRACKET
!*                                      103 NEGATIVE SIGN INCORRECT
!*                                      104 INVALID FORMAT
!*                                      105 DECIMAL FIELD GREATER THAN WIDTH
!*                                      106 FORMAT WIDTH OF 0 INCORRECT
!*                                      107 REPETITION FACTOR INVALID
!*                                      108 NULL LITERAL INVALID
!*                                      109 INTEGER FIELD TOO LARGE
!*                                      110 NO WIDTH FIELD ALLOWED
!*                                      111 HOLLERITH INPUT IS NOT ALLOWED
!*                                      112 MIN DIGITS > WIDTH
!*                                      113 0 FIELD INVALID
!*                                      114 NON REPEATABLE EDIT DESCRIPTOR
!*                                      115 COMMA REQUIRED
!*                                      116 DECIMAL POINT INVALID
      OPEH USER ERROR(NO,2,2,0)
                  PRINT FORMAT2
                  %RESULT = -1
            %END
!*
!*                                                                      GETNUM
!*

      %ROUTINE GETNUM(%HALFINTEGERNAME FLAG, %INTEGERNAME NUMBER,
                         %HALFINTEGERNAME ERR)
      %HALFINTEGER I
            NUMBER = -1
            ERR = 0
BACK:       %IF FMTPTR = INLEN %THEN ERR = 102 %AND %RETURN
            %IF FORMAT(FMTPTR) = ' ' %C
               %THEN FMTPTR = FMTPTR+1 %C
               %AND ITEMPTR = ITEMPTR+1 %AND -> BACK
            FLAG = FORMAT(FMTPTR)
            %IF FLAG>96 %AND FLAG<123 %THEN FLAG=FLAG-32
            %UNLESS 48 <= FLAG <= 57 %C
               %THEN FMTPTR = FMTPTR+1 %AND %RETURN
                                        !FLAG=39 ' '' '
                                        !FLAG=40 '('
                                        !FLAG=41 ')'
                                        !    FLAG=43 '+'
                                        !FLAG=44 ','
                                        !FLAG=45 '-'
                                        !FLAG=46 '.'
                                        !  FLAG=47 '/'
                                        !FLAG=48 - 57 DIGITS
                                        !FLAG=58 ':'
                                        ! FLAG= 65 - 90 LETTERS
            NUMBER = 0
            %CYCLE I = 0,1,20
                  %IF FORMAT(FMTPTR) = ' ' %THEN -> NEXT ITEM
                  %UNLESS X'30' <= FORMAT(FMTPTR) <= X'39' %C
                     %THEN %EXIT
                  NUMBER = NUMBER*10+FORMAT(FMTPTR)-'0'
                  %IF FMTPTR = INLEN %AND FORMAT(FMTPTR-1) #  %C
                     X'29' %THEN ERR = 102 %AND %RETURN
NEXT ITEM:
                  FMTPTR = FMTPTR+1
            %REPEAT
      %END
!*
!*                                                                      SETFMT
!*

      %INTEGERFN SETFMT(%HALFINTEGER SWITCH, COD, %INTEGER NO, 
                 %HALFINTEGER INCPTR,RESETCNT, SETCOMMA,SETCODE)
      %SWITCH SW(0 : 3)
            %IF NO>LARGESTINT %THEN ERR=109
            -> SW(SWITCH)
SW(0):                                  ! SET CODE AND COUNT
      FMT(PTR)_CODE=COD
SW(1):                                  ! SET COUNT
      FMT(PTR)_COUNT=NO
            -> SET
SW(2):                                  ! SET EXPONENT
      FMT(PTR)_EXP=NO
            -> SET
SW(3):                                  ! SET CODE IN PTR-1
            FMT(PTR-1)_CODE = COD
            -> SET
SET:
            %IF INCPTR = 1 %THEN PTR = PTR+1
            %IF RESETCNT = 1 %THEN COUNT = -1
            %IF SETCOMMA = 1 %THEN COMMAREQD = 1 %C
               %ELSE COMMAREQD = 0
      %IF SETCODE=1 %THEN CODE=-1
      %RESULT=0
      %END
!*
!*          SETCNT
!*
      %ROUTINE SETCNT
         %IF COUNT=1 %THEN COUNT=-1 %ELSEC
         ERR=SETFMT(0,X'5B',COUNT,1,1,0,0)
      %END
!*
!*                                                START OF CODE FOR FORMATCD
!*
      LINELEN=80
      INLEN=INLEN+DISP
      INLENGTH = INLEN
      CODE = -1
      COUNT = -1
      PTR = 0
      COMMAREQD = 0
      BRACK = 0
      QUOTECNT = 0
!*                                              SET NOCOMMA TO 0 SO AS TO ALLOW 
!*                                          HOLLERITH WITHOUT A FOLLOWING COMMA 
!*                                       SET TO 1 FOR RELEASE TO ENFORCE COMMAS
      NOCOMMA = 1
      FMTPTR = DISP
      BOTHZERO = 0
      COPYCODE = 0
      OUTPTR = 0
      TEXTPTR = 0
      LARGESTINT=32767
      ITEMPTR = FMTPTR
      %CYCLE I = 0,1,OUTLEN//4-1
            FMT(I)_WORD = 0
      %REPEAT
REMSPACE:

      %IF FORMAT(FMTPTR) = ' ' %C
         %THEN FMTPTR = FMTPTR+1 %AND -> REMSPACE
      %IF FORMAT(FMTPTR) # '(' %C
         %THEN FMTPTR = FMTPTR+1 %AND -> ERR101
      ACTFMTLEN = FMTPTR
      FMTPTR = FMTPTR+1
      BRACK = BRACK+1
      ITEMPTR = FMTPTR
CHECK FIRST ITEM:  GETNUM(FLAG,NUMBER,ERR);!COMMA INVALID AT START OF FORMAT
      %IF FLAG=44 %THEN -> ERR113
      %IF ERR>100 %THEN -> ERR %ELSE -> MISSGETITEM
GETITEM:

      GETNUM(FLAG,NUMBER,ERR)
      %IF ERR > 100 %THEN -> ERR
MISSGETITEM:

      %IF COMMAREQD = 1 %THEN %START
            ITEMPTR = FMTPTR
            %IF FLAG = 41 %OR FLAG = 44 %OR FLAG = 47 %C
               %OR FLAG = 58 %THEN COMMAREQD = 0 %C
               %ELSE ITEMPTR = ITEMPTR-1 %AND -> ERR115
      %FINISH
      %IF NUMBER >= 0 %THEN COUNT = NUMBER %AND -> GETITEM
CONT:
         %UNLESS FLAG=44 %THEN COPYCODE=0
         -> SW(FLAG)
!*
!*                                                                      QUOTE
!*
SW(39):

      %IF COUNT >= 0 %THEN -> ERR114
      QUOTE CNT = 0
      %CYCLE HOLLEN = 0,1,1320
            %IF FMTPTR = INLEN %THEN -> ERR102
            CHAR = FORMAT(FMTPTR)
            FMTPTR = FMTPTR+1
            %IF CHAR = '''' %THEN %START
                  %IF FMTPTR = INLEN %THEN -> ERR102
                  NXTCHAR = FORMAT(FMTPTR)
                  %IF NXTCHAR = '''' %THEN FMTPTR = FMTPTR+1 %C
                     %AND QUOTE CNT = QUOTE CNT+1 %ELSE -> OUT
            %FINISH
            HOLL(HOLLEN+1) = CHAR
      %REPEAT
OUT:
      %IF HOLLEN = 0 %THEN -> ERR108
!*  FOR HOLLERITHS WITH LEN>1
      %IF HOLLEN > 1 %THEN %START
            ERR=SETFMT(0,X'48',HOLLEN,1,0,NOCOMMA,0)
      %IF ERR>100 %THEN -> ERR
            COPY(HOLLEN,ADDR(HOLL(0)),1,ADDR(FMT(0)_CODE),PTR*4)
            -> SET HOLL LEN
      %FINISH
!* FOR HOLLERITHS OF LEN =1
      ERR=SETFMT(0,X'43',HOLL(1),1,0,NOCOMMA,0)
      %IF ERR>100 %THEN -> ERR
      -> GETITEM
!*
!*                                                                    H FORMAT
!*
SW(72):

      %IF COUNT < 0 %THEN -> ERR107
      %IF COUNT = 0 %THEN -> ERR106
!*   HOLLERITH OF LEN=1
!*
      %IF COUNT = 1 %THEN %START
            ERR=SETFMT(0,X'43',FORMAT(FMTPTR),1,1,NOCOMMA,0)
      %IF ERR>100 %THEN -> ERR
            FMTPTR = FMTPTR+1
            -> GETITEM
      %FINISH
!*  HOLLERITH OF LENGTH >1
!*  SETTING ARRAY HOLL TO HOLD ACTUAL HOLLERITH
!*
      HOLLEN = COUNT
      ERR=SETFMT(0,X'48',HOLLEN,1,0,NOCOMMA,0)
      %IF ERR>100 %THEN -> ERR
      COUNT = -1
      %IF FMTPTR+HOLLEN = INLEN %THEN -> ERR102
      COPY(HOLLEN,ADDR(FORMAT(0)),FMTPTR,ADDR(FMT(0)_CODE),PTR*4)
      FMTPTR = FMTPTR+HOLLEN
SET HOLL LEN:

      I = HOLLEN//4
      %IF HOLLEN-4*I # 0 %THEN PTR = PTR+I+1 %ELSE PTR = PTR+I
      -> GETITEM
!*
!*                                                                LEFT BRACKET
!*
SW(40):

      BRACK = BRACK+1
      %IF COUNT = 0 %THEN -> ERR107
      %IF COUNT < 0 %THEN ERR=SETFMT(0,X'42',1,1,0,0,0) %C
         %ELSE ERR=SETFMT(0,X'42',COUNT,1,1,0,0)
      %IF ERR>100 %THEN -> ERR
      LOOP(BRACK) = PTR*4
      -> GETITEM
!*
!*                                                                RIGHT BRACKET
!*
SW(41):

      %IF BRACK = 1 %THEN ACTFMTLEN = FMTPTR-ACTFMTLEN %C
         %AND -> END
      ERR=SETFMT(0,X'4B',LOOP(BRACK),1,0,1,0)
      %IF ERR>100 %THEN -> ERR
      LOOP(BRACK) = 0
      BRACK = BRACK-1
      -> GETITEM
!*
!*                                                                    PLUS SIGN
!*
SW(43):

      -> GETITEM
!*
!*                                                                      COMMA
!*
SW(44):

      %IF COPYCODE=44 %THEN -> ERR113
      %IF COUNT >= 0 %THEN -> ERR114
      ITEMPTR = FMTPTR
      COPYCODE=FLAG
      -> GETITEM
!*
!*                                                                  MINUS SIGN
!*
SW(45):

      GETNUM(FLAG,NUMBER,ERR)
      %IF ERR > 100 %THEN -> ERR
      %UNLESS NUMBER > 0 %THEN -> ERR103
      COUNT = -NUMBER
      GETNUM(FLAG,NUMBER,ERR)
      %IF ERR > 100 %THEN -> ERR
      %IF FLAG = 80 %THEN -> SW80 %ELSE -> ERR103
      -> GETITEM
!*
!*                                                          DECIMAL POINT
!*
SW(46):

      -> ERR104
POINT:
      ERR=SETFMT(1,0,COUNT,1,0,1,0)
      %IF ERR>100 %THEN -> ERR
      GETNUM(FLAG,NUMBER,ERR)
      %IF ERR > 100 %THEN -> ERR
      %IF NUMBER < 0 %THEN -> ERR104
      %IF NUMBER > COUNT %THEN %START
            %IF CODE = 73 %THEN -> ERR112 %ELSE -> ERR105
      %FINISH %ELSE COUNT = -1
      ERR=SETFMT(1,0,NUMBER,0,0,0,0)
      %IF ERR>100 %THEN -> ERR
!*                                      TO ALLOW EW.DEE AND GW.DEE FORMATS
      GETNUM(FLAG,NUMBER,ERR)
      %IF ERR > 100 %THEN -> ERR
      %IF FLAG # 69 %THEN FMTPTR = FMTPTR-1 %AND -> RETURN
      %IF FLAG = 69 %THEN %START
            %UNLESS CODE = 69 %OR CODE = 71 %THEN -> ERR104
            GETNUM(FLAG,NUMBER,ERR)
            %IF ERR > 100 %THEN -> ERR
      %IF NUMBER>0 %AND NUMBER<LARGESTINT+1 %THEN %START
               ERR=SETFMT(2,0,NUMBER,0,0,0,0) 
      %IF ERR>100 %THEN -> ERR
      %FINISHELSE ->ERR104
%FINISH
RETURN:

      %IF CODE >= 39 %THEN %START
            %IF CODE = 73 %THEN CODE = 74
            ERR=SETFMT(3,CODE,0,1,0,1,1)
      %IF ERR>100 %THEN -> ERR
      %FINISH %ELSE -> ERR104
      -> GETITEM
!*
!*                                                                  NEW RECORD  /
!*
SW(47):

      %IF COUNT >= 0 %THEN -> ERR114
      ITEMPTR = FMTPTR;                 ! POINTS TO CURRENT ITEM
      ERR=SETFMT(0,X'4E',0,1,0,0,0);    !   NEW RECORD
      %IF ERR>100 %THEN -> ERR
      -> GETITEM
!*
!*                                                                            :
!*
SW(58):

      %IF COUNT >= 0 %THEN -> ERR114
      ITEMPTR = FMTPTR
      ERR=SETFMT(0,X'57',0,1,0,0,0)
      %IF ERR>100 %THEN -> ERR
      -> GETITEM
!*
!*                                                                    A FORMAT
!*
SW(65):

      %IF COUNT = 0 %THEN -> ERR107
      %IF COUNT > 0 %THEN SETCNT
      GETNUM(FLAG,NUMBER,ERR)
      %IF ERR > 100 %THEN -> ERR
      %IF NUMBER = 0 %THEN -> ERR106
      %IF NUMBER > LARGESTINT %THEN -> ERR109
      %IF NUMBER > 0 %THEN ERR=SETFMT(0,X'41',NUMBER,1,0,1,0) %C
         %ELSE ERR=SETFMT(0,X'59',0,1,0,1,0) %AND -> MISSGETITEM
      -> GETITEM
!*
!*                                                                BN BZ FORMATS
!*
SW(66):

      %IF COUNT >= 0 %THEN -> ERR114
      GETNUM(FLAG,NUMBER,ERR)
      %IF ERR > 100 %THEN -> ERR
      %UNLESS FLAG = 78 %OR FLAG = 90 %THEN -> ERR114
      %IF FLAG = 78 %THEN ERR=SETFMT(0,X'4D',0,1,0,1,0) %C
         %ELSE ERR=SETFMT(0,X'4D',1,1,0,1,0)
      %IF ERR>100 %THEN -> ERR
      -> GETITEM
!*
!*                                                          D E F G I L FORMATS
!*
SW(68):


SW(69):


SW(70):


SW(71):


SW(73):


SW(76):

      %IF COUNT = 0 %THEN -> ERR107
      %IF COUNT > 0 %THEN SETCNT
      CODE = FLAG
      GETNUM(FLAG,NUMBER,ERR)
      %IF ERR > 100 %THEN -> ERR
      %IF NUMBER > 0 %THEN COUNT = NUMBER %ELSE -> ERR106
      %IF CODE=76 %OR CODE = 90 %THEN %START
      ERR=SETFMT(0,CODE,COUNT,1,1,1,1) 
      %IF ERR>100 %THEN -> ERR
         -> GETITEM
      %FINISH
      GETNUM(FLAG,NUMBER,ERR)
      %IF ERR > 100 %THEN -> ERR
      %IF FLAG # 46 %THEN %START
            %IF (LEVEL > 0 %AND CODE = 71) %OR CODE = 73 %C
               %THEN %START
      ERR=SETFMT(0,CODE,COUNT,1,1,1,1) 
      %IF ERR>100 %THEN -> ERR %ELSE ->MISSGETITEM
      %FINISH
      %FINISH %ELSE -> POINT
!*                                                             ALLOW INTEGER  I 
!*
!*                                                                P FORMAT
!*
SW80:

SW(80):

      %IF COUNT >= 0 %THEN ERR=SETFMT(0,X'50',COUNT,1,1,0,0) %C
         %ELSE ERR=SETFMT(0,X'4F',-COUNT,1,1,0,0)
      %IF ERR>100 %THEN -> ERR
      -> GETITEM
!*
!*                                                             Q FORMAT ON FLAG
!*
SW(81):

      %IF LEVEL = 2 %THEN -> SW(68) %ELSE -> ERR104
!*
!*                                                              S SP SS FORMATS
!*
SW(83):

      %IF COUNT >= 0 %THEN -> ERR114
      GETNUM(FLAG,NUMBER,ERR)
      %IF ERR > 100 %THEN -> ERR
      %IF FLAG = 80 %OR FLAG = 83 %C
         %THEN %START
      ERR=SETFMT(0,X'52',FLAG-80,1,0,1,0) 
      %IF ERR>100 %THEN -> ERR
      %FINISHELSE %START
      ERR=SETFMT(0,X'52',1,1,0,1,0) %AND -> MISSGETITEM
      %IF ERR>100 %THEN -> ERR
      %FINISH
      -> GETITEM
!*
!*                                                          T TL TR FORMATS
!*
SW(84):

      %IF COUNT >= 0 %THEN -> ERR114
      ERR=SETFMT(0,X'54',0,0,0,0,0)
      %IF ERR>100 %THEN -> ERR
GETT:
      GETNUM(FLAG,NUMBER,ERR)
      %IF ERR > 100 %THEN -> ERR
      %IF FLAG = 76 %OR FLAG = 82 %THEN %START
            %IF FLAG = 76 %THEN ERR=SETFMT(0,X'55',0,0,0,0,0) %C
               %ELSE ERR=SETFMT(0,X'56',0,0,0,0,0)
      %IF ERR>100 %THEN -> ERR
            -> GETT
      %FINISH
      %IF NUMBER < 0 %THEN -> ERR104
      %IF NUMBER = 0 %THEN -> ERR106
      ERR=SETFMT(1,0,NUMBER,1,0,1,0)
      %IF ERR>100 %THEN -> ERR
      -> GETITEM
!*
!*                                                                    X FORMAT
!*
SW(88):

      %IF COUNT < 0 %THEN -> ERR104
      %IF COUNT = 0 %THEN -> ERR106
      ERR=SETFMT(0,X'58',COUNT,1,1,1,0)
      %IF ERR>100 %THEN -> ERR
      -> GETITEM
!*
!*                                                          Z FORMAT ON FLAG
!*
SW(90):

      %IF LEVEL=1 %THEN -> SW(68) %ELSE ->ERR104
!*TIDY UP AT END OF FORMAT
END:
      ERR=SETFMT(0,X'53',0,0,0,0,0)
      %IF ERR>100 %THEN -> ERR
      TABLEN = (PTR+1)*4
      %RESULT = 0
!*
!*                                                               ERROR CONDITIONS
!*
!*
ERR:
      %IF RUNCOMP = 0 %THEN %START    ;! COMPILE TIME
            %CYCLE J = 0,1,INLEN-ITEMPTR
                  K = FORMAT(ITEMPTR+J)
                  %IF K = 44 %OR K = 47 %OR K = 58 %THEN %EXIT
                %IF K=41 %AND ITEMPTR+J+1=INLEN %THEN %EXIT
            %REPEAT
            TABLEN = ITEMPTR
            ACTFMTLEN = J
            %RESULT = ERR+50
      %FINISHELSE %RESULT = ERROR(ERR)   ;!RUN TIME
ERR101:

      ERR = 101;  -> ERR
ERR102:

      ERR = 102;  -> ERR
ERR103:

      ERR = 103;  -> ERR
SW(*):
    %IF FLAG>96 %AND FLAG<123 %THEN FLAG=FLAG-32 %AND -> SW(FLAG)
ERR104:

      ERR = 104;  -> ERR
ERR105:

      ERR = 105;  -> ERR
ERR106:

      ERR = 106;  -> ERR
ERR107:

      ERR = 107;  -> ERR
ERR108:

      ERR = 108;  -> ERR
ERR109:

      ERR = 109;  -> ERR
ERR110:

      ERR = 110;  -> ERR
ERR111:

      ERR = 111;  -> ERR
ERR112:

      ERR = 112;  -> ERR
ERR113:

      ERR = 113;  -> ERR
ERR114:

      ERR = 114;  -> ERR
ERR115:
      %IF NUMBER>9 %THENSTART
         %CYCLE I=0,1,10
            NUMBER=NUMBER//10
            %IF NUMBER>0 %THEN -> REP %ELSE %EXIT
      REP: %REPEAT
         ITEMPTR=ITEMPTR-I
      %FINISH

      ERR = 115;  -> ERR
ERR116:

      ERR = 116;  -> ERR
ERR117:
      ERR = 117;  -> ERR
%END
!
%ENDOFFILE