! fcfmt1a ! 15/01/87 - insert %alias for Amdahl routines ! ! fcfmt1 ! 10/10/86 - copied from ftncfmt8 ! !Modified 3/July/86 11:00 !-------------------------------------------! ! ! ! Conditional Compilation Constants ! ! ! !-------------------------------------------! %CONSTINTEGER Compile Time Formats= 1 {= yes} !If switching between Compile-Time and Run-Time then ! expose/comment out the INCLUDE statements below %IF Compile Time Formats= 0 {not reqd} %THENSTART ! ! Define Global Variables ! %OWNINTEGER FMT AD {address of format text } %OWNINTEGER IN LENGTH {length of format text } %OWNINTEGER ITEM PTR {scanning ptr through text} {-used for errrors} %EXTERNALROUTINE PRINT FORMAT2 %ALIAS "S#PRINTFORMAT2" %STRING (255) S %INTEGER END, START, LOOP, I END = 0 START = 0 PRINTSTRING(" Current Format: ") LOOP = (IN LENGTH + (Output Len-1))//Output Len %CYCLE I = 1,1,LOOP NEWLINE %IF I*Output Len < IN LENGTH %THEN END= END+Output Len %C %ELSE END= IN LENGTH COPY(END-START,FMT AD,START,ADDR(S),1) LENGTH(S) = END-START PRINTSTRING(S) %IF START <= ITEMPTR < END %THEN %START NEWLINE %UNLESS ITEMPTR= 0 %THEN SPACES (ITEMPTR-START) PRINT SYMBOL ('!') NEWLINES ( 2 ) %FINISH START = START+Output Len %REPEAT %END; !of PRINT FORMAT2 ! ! %FINISH; !if run-time formats %EXTERNALINTEGERFN FORMATCD %ALIAS "S#FORMATCD" %C (%INTEGER INSTART, DISP, ARYADR, INLEN, OUTLEN, %INTEGER LEVEL, RUNCOMP, %INTEGERNAME TABLEN, ACTFMTLEN) ! !* RUNCOMP=0 FOR COMPILE TIME FORMAT !* RUNCOMP=1 FOR RUN TIME FORMAT AND REPORT ANY ERRORS !* RUNCOMP>1 FOR RUN TIME AND PASS BACK ANY ERRORS !* FORMATCD !* !* %IF Compile Time Formats= 1 {reqd} %THENSTART ! %INCLUDE "ftn_ht" { %INCLUDE "ftn_copy1"} !* modified 23/09/86 !* %routine Copy(%integer Length,Fbase,Fdisp,Tbase,Tdisp) !*********************************************************************** !* copy Length bytes from fbase(fdisp) to tbase(tdisp) * !*********************************************************************** %integer I,From,To %if Length<=0 %then %return From=Fbase+Fdisp To=Tbase+Tdisp %cycle I=0,1,Length-1 byteinteger(To+I)=byteinteger(From+I) %repeat %end;! Copy !* %FINISH %CONSTBYTEINTEGERARRAYFORMAT AF (0:32766 {infinity}) %BYTEINTEGERARRAYNAME FORMAT %OWNINTEGERARRAY LOOP (0:8) %SWITCH SW(0 : 122) %CONSTBYTEINTEGERARRAYFORMAT Form of HOLL (0:32766 {infinity}) %BYTEINTEGERARRAYNAME HOLL ;!%C HOLL is mapped onto the format table and %C is used for analysing a literal %INTEGER HOLL PTR; !postion of next literal value within the format table %INTEGER HOLL LEN; !final length of a literal %INTEGER PTR ; !current position within the format table %INTEGER PTR MAX; !maximum value of PTR %INTEGER CODE, BRACK, FLAG, I, CHAR %INTEGER FMTPTR, TEXTPTR %INTEGER COPYCODE, ERR %INTEGER LARGESTINT, COUNT, NUMBER %INTEGER NOCOMMA, J, COMMAREQD %INTEGER QUOTE CH ;!%C QUOTE CH is set to the character that starts a literal. Normally %C this would be a single quote, but under GOULD double %C quotes may also start a literal. The literal must terminate %C with the same character as started it %CONSTINTEGER Quote= '''' %CONSTINTEGER DQuote= '"' %IF Compile Time Formats= 1 {reqd} %THENSTART ! %INTEGER FMT AD %INTEGER IN LENGTH %INTEGER ITEM PTR %if HOST=PERQPNX %or HOST=ICL2900 %thenstart !* %RECORDFORMAT FMTF(%INTEGER WORD %ORC ((%BYTEINTEGER CODE,SPARE %OR %HALFINTEGER EXP), %HALFINTEGER COUNT)) !* %finishelsestart !* %RECORDFORMAT FMTF(%INTEGER WORD %ORC ((%BYTEINTEGER CODE,SPARE %OR %SHORTINTEGER EXP), %SHORTINTEGER COUNT)) !* %finish %FINISHELSESTART !for run-time formats %IF Halfs= True %THENSTART ! %RECORDFORMAT FMTF(%INTEGER WORD %ORC ((%BYTEINTEGER CODE,SPARE %OR %HALFINTEGER EXP), %HALFINTEGER COUNT)) %FINISHELSESTART ! %RECORDFORMAT FMTF(%INTEGER WORD %ORC ((%BYTEINTEGER CODE,SPARE %OR %SHORTINTEGER EXP), %SHORTINTEGER COUNT)) %FINISH %FINISH %CONSTRECORD (FMTF) %ARRAYFORMAT ARYFMT(0:4000) %RECORD (FMTF) %ARRAYNAME FMT FMTAD = INSTART FORMAT== ARRAY(INSTART,AF) FMT == ARRAY(ARYADR,ARYFMT) HOLL== ARRAY(ARYADR, Form Of HOLL) %IF Compile Time Formats= 0 {No} %THENSTART ! ! %UNLESS (TARGET= EMAS %OR TARGET= IBM) %THENSTART %routine ERROR(%INTEGER NO) %Conststring(30) %Array Messages(1:16)=%c "Missing left bracket", {error 101} "Missing right bracket", {error 102} "Negative sign incorrect", {error 103} "Invalid format", {error 104} "Decimal field > width", {error 105} "Format width 0 invalid", {error 106} "Repetition factor invalid", {error 107} "Null literal invalid", {error 108} "Integer field too large", {error 109} "No width field allowed", {error 110} "Literal in input format", {error 111} "Minimum digits > width", {error 112} "No format item preceding comma", {error 113} "Non-repeatable edit descriptor", {error 114} "Comma required", {error 115} "Decimal point not allowed" {error 116} !* %externalroutinespec Fstop %alias "f_stop" {---if UNIX} (%integer i,j) select output (12) %IF TARGET= PERQ {if ACCENT} printstring(" Format Error") write(no,3) printstring(": ") printstring(messages(no-100)) newline printformat2 Fstop(-255, 1 {for ERROR} %c +1 {for FORMATCD} %c +1 {for RTFMTS} %c +1 {for IOAR} ) {if UNIX-like} !%MONITORSTOP %END; !of ERROR %FINISH; !if Accent or PNX or Perq3 or Whitechapel or Gould %FINISH; !if Run-Time Formats are required !* !* GETNUM !* %ROUTINE GETNUM(%INTEGERNAME FLAG, NUMBER, ERR) %INTEGER 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>= 'a' %AND FLAG<= 'z' %THEN FLAG= FLAG-' ' %UNLESS '0' <= FLAG <= '9' %C %THEN FMTPTR = FMTPTR+1 %AND %RETURN !FLAG=34 Double Quote !FLAG=39 Quote !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 '0' <= FORMAT(FMTPTR) <= '9' %C %THEN %EXIT NUMBER = NUMBER*10+FORMAT(FMTPTR)-'0' %IF FMTPTR = INLEN %AND FORMAT(FMTPTR-1)\= ')' %C %THEN ERR = 102 %AND %RETURN NEXT ITEM: FMTPTR = FMTPTR+1 %REPEAT %END !* !* SETFMT !* %INTEGERFN SETFMT(%INTEGER SWITCH, COD, NO, INCPTR,RESETCNT, SETCOMMA,SETCODE) %SWITCH SW(0 : 3) %IF NO>LARGESTINT %THEN %RESULT=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 %START %IF RUNCOMP#0 %THENSTART %IF PTR>=OUTLEN %THEN %RESULT=184 {Format Text Too Large} %FINISH PTR=PTR+1 %FINISH %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 !* INLEN=INLEN+DISP INLENGTH = INLEN CODE = -1 COUNT = -1 PTR = 0 PTR MAX= OUT LEN>> 2; !maximum value of PTR COMMAREQD = 0 BRACK = 0 !* SET NOCOMMA TO 0 SO AS TO ALLOW !* HOLLERITH WITHOUT A FOLLOWING COMMA !* SET TO 1 FOR RELEASE TO ENFORCE COMMAS NOCOMMA = 0 FMTPTR = DISP COPYCODE = 0 TEXTPTR = 0 LARGESTINT=32767 ITEMPTR = FMTPTR %CYCLE I = 0,1,OUTLEN//4-1 FMT(I)_WORD = 0 %REPEAT FMTPTR = FMTPTR+1 %WHILE FORMAT(FMTPTR) = ' ' FMTPTR = FMTPTR+1 %AND -> ERR101 %IF FORMAT(FMTPTR)\= '(' ACTFMTLEN = FMTPTR FMTPTR = FMTPTR+1 BRACK = BRACK+1 ITEMPTR = FMTPTR FLAG = 0 CHECK FIRST ITEM: GETNUM(FLAG,NUMBER,ERR);!COMMA INVALID AT START OF FORMAT %IF FLAG= ',' %THEN -> ERR113 %IF ERR> 100 %THEN -> ERRLAB %ELSE -> MISSGETITEM GETITEM: GETNUM(FLAG,NUMBER,ERR) %IF ERR > 100 %THEN -> ERRLAB MISSGETITEM: %IF COMMAREQD = 1 %THEN %START %IF FLAG= ')' %ORC FLAG= ',' %ORC (FLAG= Quote %AND TARGET= GOULD) %ORC (FLAG=DQuote %AND TARGET= GOULD) %ORC FLAG= '/' %ORC FLAG= ':' %THEN ITEM PTR= FMT PTR %AND COMMA REQD= 0 %C %ELSE ITEM PTR= FMT PTR-1 %AND -> ERR115 !Note if used for GOULD then we do not ! require a comma to precede a literal %FINISH %IF NUMBER >= 0 %THEN COUNT = NUMBER %AND -> GETITEM CONT: %UNLESS FLAG=44 %THEN COPYCODE=0 -> SW(FLAG) !* !* QUOTE !* DOUBLE QUOTE SW(DQuote): %IF TARGET\= GOULD %THEN -> ERR104 SW( Quote): QUOTE CH= FLAG %IF COUNT>= 0 %THEN -> ERR114 HOLL LEN= (PTR*4) + 4; !initial value of HOLL LEN HOLL PTR= HOLL LEN %WHILE HOLL PTR< OUT LEN %CYCLE %IF FMT PTR= IN LEN %THEN -> ERR102 CHAR= FORMAT (FMT PTR) %IF CHAR= QUOTE CH %THENSTART FMT PTR= FMT PTR + 1 %IF FMT PTR= IN LEN %THEN -> ERR102 CHAR= FORMAT (FMT PTR) %UNLESS CHAR= QUOTE CH %THEN -> OUT %FINISH HOLL (HOLL PTR)= CHAR HOLL PTR = HOLL PTR + 1 FMT PTR = FMT PTR + 1 %REPEAT !if we fall through then the format table is too small ERR= 184 %AND -> ERRLAB OUT: ! ! Finalise Literal ! HOLL LEN= HOLL PTR - HOLL LEN %IF HOLL LEN= 0 %THEN -> ERR108 !* FOR HOLLERITHS WITH LEN>1 %IF HOLL LEN > 1 %THEN %START ERR=SETFMT(0,X'48',HOLL LEN,1,0,NOCOMMA,0) %IF ERR>100 %THEN -> ERRLAB -> SET HOLL LEN %FINISH !* FOR HOLLERITHS OF LEN =1 ERR=SETFMT(0,X'43',HOLL(HOLL PTR - 1),1,0,NOCOMMA,0) %IF ERR>100 %THEN -> ERRLAB ITEM PTR= FMT PTR -> GETITEM !* !* H FORMAT !* SW('H'): %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 -> ERRLAB FMTPTR = FMTPTR+1 -> GETITEM %FINISH !* HOLLERITH OF LENGTH >1 !* SETTING ARRAY HOLL TO HOLD ACTUAL HOLLERITH !* HOLL LEN = COUNT ERR=SETFMT(0,X'48',HOLL LEN,1,0,NOCOMMA,0) %IF ERR>100 %THEN -> ERRLAB COUNT = -1 %IF FMTPTR+HOLL LEN >= INLEN %THEN -> ERR102 COPY(HOLL LEN,ADDR(FORMAT(0)),FMTPTR,ARYADR,PTR*4) FMTPTR = FMTPTR+HOLL LEN SET HOLL LEN: ITEM PTR= FMT PTR PTR= PTR + ((HOLL LEN + 3)>> 2) -> GET ITEM !* !* 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 -> ERRLAB LOOP(BRACK) = PTR*2 {*2 to give PNX word (16 bit) displacement} -> 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 -> ERRLAB 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 -> ERRLAB %UNLESS NUMBER > 0 %THEN -> ERR103 COUNT = -NUMBER GETNUM(FLAG,NUMBER,ERR) %IF ERR > 100 %THEN -> ERRLAB %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 -> ERRLAB GETNUM(FLAG,NUMBER,ERR) %IF ERR > 100 %THEN -> ERRLAB %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 -> ERRLAB !* TO ALLOW Ew.dEe AND Gw.dEe FORMATS GETNUM(FLAG,NUMBER,ERR) %IF ERR > 100 %THEN -> ERRLAB %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 -> ERRLAB %IF NUMBER>0 %AND NUMBER100 %THEN -> ERRLAB %FINISHELSE ->ERR104 %FINISH RETURN: %IF CODE >= 39 %THEN %START %IF CODE=73 %THEN CODE= 74 ;!cIw.m %IF CODE=90 %THEN CODE=X'5F' ;!cZw.m %IF CODE=79 %THEN CODE=X'5D' ;!cOw.m ERR=SETFMT(3,CODE,0,1,0,1,1) %IF ERR>100 %THEN -> ERRLAB %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 -> ERRLAB -> GETITEM !* !* !* SW(58): !: SW(36): !$ %IF COUNT >= 0 %THEN -> ERR114 ITEMPTR = FMTPTR %IF FLAG=58 %THEN I=X'57' %ELSE I=X'5E' ERR=SETFMT(0,I,0,1,0,0,0) %IF ERR>100 %THEN -> ERRLAB -> GETITEM !* !* A FORMAT !* SW(65): %IF COUNT = 0 %THEN -> ERR107 %IF COUNT > 0 %THEN SETCNT GETNUM(FLAG,NUMBER,ERR) %IF ERR > 100 %THEN -> ERRLAB %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 -> ERRLAB %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 -> ERRLAB -> GETITEM !* !* D E F G I L FORMATS !* SW(68): SW(69): SW(70): SW(71): SW(73): SW(76): SW(79): SW(90): %IF COUNT = 0 %THEN -> ERR107 %IF COUNT > 0 %THEN SETCNT CODE = FLAG GETNUM(FLAG,NUMBER,ERR) %IF ERR > 100 %THEN -> ERRLAB %IF Compile Time Formats= 1 {yes} %THENSTART %IF (HOST=PERQPNX %OR HOST=ACCENT %ORC HOST=M68000 %OR HOST=WCW %ORC HOST= GOULD) %AND NUMBER>1024 %THEN ->ERR109 %FINISHELSESTART %IF (TARGET\= EMAS %AND TARGET\= IBM) %AND NUMBER>1024 %THEN ->ERR109 %FINISH %IF NUMBER > 0 %THEN COUNT = NUMBER %ELSE -> ERR106 %IF CODE=76 %THEN %START ERR=SETFMT(0,CODE,COUNT,1,1,1,1) %IF ERR>100 %THEN -> ERRLAB -> GETITEM %FINISH GETNUM(FLAG,NUMBER,ERR) %IF ERR > 100 %THEN -> ERRLAB %IF FLAG # 46 %THEN %START %IF (LEVEL > 0 %AND CODE = 71) %OR CODE = 73 %C %OR CODE=90 %OR CODE=79 %C %THEN %START %IF CODE=79 %THEN CODE=X'5C' ERR=SETFMT(0,CODE,COUNT,1,1,1,1) %IF ERR>100 %THEN -> ERRLAB %ELSE ->MISSGETITEM %FINISH %ELSE -> ERR104 %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 -> ERRLAB -> 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 -> ERRLAB %IF FLAG = 80 %OR FLAG = 83 %C %THEN %START ERR=SETFMT(0,X'52',FLAG-80,1,0,1,0) %IF ERR>100 %THEN -> ERRLAB %FINISHELSE %START ERR=SETFMT(0,X'52',1,1,0,1,0) %AND -> MISSGETITEM %IF ERR>100 %THEN -> ERRLAB %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 -> ERRLAB GETT: GETNUM(FLAG,NUMBER,ERR) %IF ERR > 100 %THEN -> ERRLAB %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 -> ERRLAB -> 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 -> ERRLAB -> GETITEM !* !* X FORMAT !* SW('X'): %IF COUNT < 0 %THEN -> ERR104 %IF COUNT = 0 %THEN -> ERR106 ERR=SETFMT(0,X'58',COUNT,1,1,1,0) %IF TARGET\= Gould ERR=SETFMT(0,X'58',COUNT,1,1,0,0) %IF TARGET = Gould !Note no comma is required after the X format as ! one of our relaxations of ANSI77 if Gould %IF ERR>100 %THEN -> ERRLAB -> GETITEM !* !* !* !*TIDY UP AT END OF FORMAT END: ERR=SETFMT(0,X'53',0,0,0,0,0) %IF ERR>100 %THEN -> ERRLAB TABLEN = (PTR+1)*4 %RESULT = 0 !* !* ERROR CONDITIONS !* !* ERRLAB: %IF Compile Time Formats= 1 %THEN %START ;! COMPILE TIME %CYCLE J = 0,1,INLEN-ITEMPTR I = FORMAT(ITEMPTR+J) %IF I = 44 %OR I = 47 %OR I = 58 %THEN %EXIT %IF I=41 %AND ITEMPTR+J+1=INLEN %THEN %EXIT %REPEAT TABLEN = ITEMPTR ACTFMTLEN = J %RESULT = ERR+50 %FINISHELSESTART %if err=184 %or runcomp>1 %or TARGET=EMAS %or TARGET=IBM %thenresult=err%c %else Error(err) %FINISH ERR101: ERR = 101; -> ERRLAB ERR102: ERR = 102; -> ERRLAB ERR103: ERR = 103; -> ERRLAB SW(*): %IF FLAG>96 %AND FLAG<123 %THEN FLAG=FLAG-32 %AND -> SW(FLAG) ERR104: ERR = 104; -> ERRLAB ERR105: ERR = 105; -> ERRLAB ERR106: ERR = 106; -> ERRLAB ERR107: ERR = 107; -> ERRLAB ERR108: ERR = 108; -> ERRLAB ERR109: ERR = 109; -> ERRLAB ERR110: ERR = 110; -> ERRLAB ERR111: ERR = 111; -> ERRLAB ERR112: ERR = 112; -> ERRLAB ERR113: ERR = 113; -> ERRLAB ERR114: ERR = 114; -> ERRLAB ERR115: %IF NUMBER>9 %THENSTART %CYCLE I=0,1,10 NUMBER=NUMBER//10 %UNLESS NUMBER>0 %THENEXIT %REPEAT ITEMPTR=ITEMPTR-I %FINISH ERR = 115; -> ERRLAB ERR116: ERR = 116; -> ERRLAB ERR117: ERR = 117; -> ERRLAB %END; !of FORMATCD %ENDOFFILE