%EXTRINSICINTEGER ECTM TRACE, ECTM CHECK, ECTM MONITOR
!
%SYSTEMROUTINESPEC MOVE(%INTEGER BYTES, FROM, TO)
%SYSTEMROUTINESPEC ETOI(%INTEGER ADDRESS, BYTES)
%SYSTEMROUTINESPEC ITOE(%INTEGER ADDRESS, BYTES)
%SYSTEMROUTINESPEC PHEX(%INTEGER I)
%EXTERNALINTEGERFNSPEC EXIST(%STRING(31) FILE)
%EXTERNALINTEGERFNSPEC ECTM GET ROUTE(%LONGINTEGER ROUTE)
!
%OWNINTEGER LENGTH MASK = X'00FFFFFF'
%OWNINTEGER STRING DESC = X'58000000'
%OWNINTEGER WORD DESC = X'28000000'
%OWNLONGINTEGER ADDRESS MASK = X'00000000FFFFFFFF'
%OWNLONGINTEGER NIL = -1
!
%RECORDFORMAT AFRFMT(%STRING(63) NAME, %INTEGER ASSIGN ID,  %C
      QAVAILABLE, QTEMP, %LONGINTEGER ROUTE, ACCESS1,  %C
      %INTEGER DESC DR0, DESC DR1, %LONGINTEGER AREA DESC,  %C
      %BYTEINTEGERARRAY DESC AREA(0:1023))
!
%EXTERNALSTRING(31)%FN HEX(%INTEGER I)
!
%STRING(31) S
%INTEGER J, X
!
S = ""
%CYCLE J = 1, 1, 8
      X = I & X'F'
      I = I >> 4
      %IF X < 10 %THEN X = X + '0'  %C
      %ELSE X = X - 10 + 'A'
      S = TOSTRING(X).S
      %REPEAT
%RESULT = "X'".S."'"
%END
!
%EXTERNALSTRING(255)%FN ETOS(%INTEGER DR0, DR1)
!
! Converts an EBCDIC string into an ordinary Imp (ISO) string.
!
%STRING(255) S
%INTEGER L
!
L = DR0&X'FF'
%IF L = 0 %THEN %RESULT = ""
MOVE(L,DR1,ADDR(S)+1)
LENGTH(S) = L
ETOI(ADDR(S)+1,L)
%RESULT = S
%END
!
%EXTERNALSTRING(255)%FN ETON(%INTEGER DR0, DR1)
!
! Converts an EBCDIC string (possibly containing blanks and
! underlines) into an ISO-coded Imp string without blanks etc.
!
%STRING(255) S
%INTEGER L, I, J, X
!
L = DR0&X'FF'
%IF L = 0 %THEN %RESULT = ""
J = 0
%CYCLE I = 1, 1, L
      X = BYTEINTEGER(DR1)
      %IF X # C' ' %AND X # C'_' %THEN %START
         %IF J = 255 %THEN %EXIT
         J = J + 1
         CHARNO(S,J) = X
         %FINISH
      DR1 = DR1 + 1
      %REPEAT
LENGTH(S) = J
%IF J > 0 %THEN ETOI(ADDR(S)+1,J)
%RESULT = S
%END
!
%EXTERNALROUTINE ECTM REPORT STRING(%STRING(63) MESS, %INTEGER DR0, DR1)
!
%IF ECTM TRACE = 0 %THEN %RETURN
SELECT OUTPUT(0)
PRINT STRING(MESS);  SPACE
PRINT STRING(ETOS(DR0,DR1))
NEW LINE
%END
!
%EXTERNALROUTINE ECTM REPORT INT(%STRING(63) MESS, %INTEGER I)
!
%IF ECTM TRACE = 0 %THEN %RETURN
SELECT OUTPUT(0)
PRINT STRING(MESS);  SPACE
WRITE(I,0)
NEW LINE
%END
!
%EXTERNALROUTINE ECTM REPORT LONG(%STRING(63) MESS, %INTEGER DR0, DR1)
!
%IF ECTM TRACE = 0 %THEN %RETURN
SELECT OUTPUT(0)
PRINT STRING(MESS);  SPACE
PRINT STRING(HEX(INTEGER(DR1)));  SPACE
PRINT STRING(HEX(INTEGER(DR1+4)))
NEW LINE
%END
!
%EXTERNALROUTINE ECTM DUMP PPAIRS(%INTEGER DR0, DR1)
!
%INTEGER I, LEN
%INTEGERARRAYFORMAT PP FORM(1:3,1:100)
%INTEGERARRAYNAME PP
%STRING(255) NAME
!
%IF ECTM TRACE = 0 %THEN %RETURN
SELECT OUTPUT(0)
%IF DR0 = -1 %OR DR1 = -1 %OR DR0 & LENGTH MASK = 0 %OR DR1 = 0  %C
      %THEN %START
      PRINT STRING("Parameter list empty")
      NEW LINE
      %RETURN
      %FINISH
!
LEN = (DR0 & LENGTH MASK)//3
      PP == ARRAY(DR1,PP FORM)
      %CYCLE I = 1, 1, LEN
         WRITE(PP(1,I),5);  SPACES(5)
         PHEX(PP(2,I));  SPACES(5);  PHEX(PP(3,I))
         %IF PP(2,I) >> 24 = X'58' %THEN %START
            LENGTH(NAME) = PP(2,I) & LENGTH MASK
            MOVE(LENGTH(NAME),PP(3,I),ADDR(NAME)+1)
            ETOI(ADDR(NAME)+1,LENGTH(NAME))
            SPACES(5);  PRINT SYMBOL('''')
            PRINT STRING(NAME);  PRINT SYMBOL('''')
            %FINISH
         NEW LINE
         %REPEAT
%END
!
%EXTERNALSTRINGFN ECTM NEXT TEMP
!
%OWNSTRING(31) TEMP = "T#CTM0000"
%INTEGER X, I
!
%CYCLE
      I = LENGTH(TEMP)
      %CYCLE
         X = CHARNO(TEMP,I)
         %IF X < '9' %THEN %START
            CHARNO(TEMP,I) = X + 1
            %EXIT
            %FINISH
         CHARNO(TEMP,I) = '0'
         I = I - 1
         %REPEAT
      %IF EXIST(TEMP) = 0 %THEN %EXIT
      %REPEAT
%RESULT = TEMP
%END
!
%EXTERNALSTRINGFN ECTM NEW NAME
!
%OWNSTRING(31) FILE = "CTM#0000"
%INTEGER X, I
!
%CYCLE
      I = LENGTH(FILE)
      %CYCLE
         X = CHARNO(FILE,I)
         %IF X < '9' %THEN %START
            CHARNO(FILE,I) = X + 1
            %EXIT
            %FINISH
         CHARNO(FILE,I) = '0'
         I = I - 1
         %REPEAT
      %IF EXIST(FILE) = 0 %THEN %EXIT
      %REPEAT
%RESULT = FILE
%END
!
%EXTERNALSTRINGFN EMAS NAME(%STRING(255) CTM NAME, %INTEGER QNEW)
!
! Converts a full CTM filename into a full EMAS filename
! (both ISO strings) - may have to cook up a name for
! multi-generation files.
!
%INTEGER FLAG
%STRING(15) GEN
!
%IF CTM NAME -> CTM NAME.("(").GEN.(")") %THEN FLAG = 0
%IF CHARNO(CTM NAME,1) = ':' %THEN CTM NAME -> (":").CTM NAME
%IF QNEW = 0 %THEN %RESULT = CTM NAME
%IF EXIST(CTM NAME) = 0 %THEN %RESULT = CTM NAME  %C
      %ELSE %RESULT = ECTM NEW NAME
%END
!
%EXTERNALSTRING(63) %FN NEXT NAME(%STRING(63) NAME)
!
%STRING(15) GEN
%INTEGER I, X
!
%UNLESS NAME -> NAME.("(").GEN.(")") %THEN %RESULT = NAME."(2)"
GEN = "0".GEN
I = LENGTH(GEN)
%CYCLE
      X = CHARNO(GEN,I)
      %IF X < '9' %THEN CHARNO(GEN,I) = X + 1 %AND %EXIT
      CHARNO(GEN,I) = '0'
      I = I - 1
      %IF I = 0 %THEN %EXIT
      %REPEAT
%WHILE CHARNO(GEN,1) = '0' %THEN GEN = FROMSTRING(GEN,2,LENGTH(GEN))
%RESULT = NAME."(".GEN.")"
%END
!
%EXTERNALINTEGERFN CE CHAN(%STRING(31) NAME)
!
! CHECKS WHETHER A JS-VAR NAME IS OF THE FORM "ICL9CE<N>", WHERE
! <N> IS A CHANNEL NUMBER.  NOTE THAT IS IS IMPORTANT, FOR THE
! SAKE OF CONSISTENCY, TO IGNORE NAMES WITH LEADING ZEROS IN
! THE CHANNEL NUMBER - E.G. "ICL9CE05".
!
%INTEGER CHAN, X, I
!
%UNLESS NAME -> ("ICL9CE").NAME %THEN %RESULT = 0
%IF NAME = "" %THEN %RESULT = 0
%UNLESS '0' < CHARNO(NAME,1) <= '9' %THEN %RESULT = 0
CHAN = 0
%CYCLE I = 1, 1, LENGTH(NAME)
      X = CHARNO(NAME,I)
      %UNLESS '0' <= X <= '9' %THEN %RESULT = 0
      CHAN = CHAN*10 + X - '0'
      %REPEAT
%IF CHAN > 100 %THEN CHAN = 0
%RESULT = CHAN
%END
!
%EXTERNALSTRING(15)%FN ITOS(%LONGINTEGER I)
!
! CONVERTS AN INTEGER INTO A CHARACTER STRING
!
%LONGINTEGER J
%INTEGER K
%STRING(15) S
!
S = ""
%CYCLE
      J = I//10
      K <- I - J*10
      S = TOSTRING(K+'0').S
      %IF J = 0 %THEN %EXIT
      I = J
      %REPEAT
%RESULT = S
%END
!
%EXTERNALINTEGERFN CALL RAM(%INTEGER CALL DR0, CALL DR1,  %C
      DESC DR0, DESC DR1, PP0, PP1)
!
! Calls a 'RAM' routine through the given call
! with the SELECT RAM parameter pairs and the file
! description as parameters.
!
%INTEGER RC
!
*PRCL_   4
*LSS_    DESC DR1
*LUH_    DESC DR0
*ST_     %TOS
*LSS_    PP1
*LUH_    PP0
*ST_     %TOS
*LDTB_   CALL DR0
*LDA_    CALL DR1
*RALN_   9
*CALL_   (%DR)
*ST_     RC
%RESULT = RC
%END
!
%EXTERNALROUTINE CALL ACCESS(%LONGINTEGER ACCESS1,  %C
      %INTEGER PPLEN, PPADDR)
!
! Calls an ACCESS1 RAM entry with given parameters.
!
%INTEGER PP0, PP1, RC
!
PPLEN = PPLEN & LENGTH MASK
%IF PPLEN = 0 %THEN %START
      PP0 = -1
      PP1 = -1
      %FINISH  %C
%ELSE %START
      PP LEN = LENGTH MASK & PPLEN
      PP0 = WORD DESC ! PPLEN
      PP1 = PPADDR
      %FINISH
*PRCL_   4
*LSD_    PP0
*ST_     %TOS
*LD_     ACCESS1
*RALN_   7
*CALL_   (%DR)
*ST_     RC
%END
!
%EXTERNALLONGINTEGERFN ECTM PPL(%INTEGER PPLEN, PPADDR, ID)
!
! Returns the value of a long integer-type parameter pair.
!
%INTEGERARRAYFORMAT PP FORM(1:3,1:100)
%INTEGERARRAYNAME PP
%INTEGER I
%LONGINTEGER L
!
PP == ARRAY(PP ADDR, PP FORM)
PP LEN = (PP LEN & LENGTH MASK)//3
%IF PP LEN = 0 %THEN %RESULT = 0
%CYCLE I = 1, 1, PP LEN
      %IF PP(1,I) = ID %THEN %START
         MOVE(8,ADDR(PP(2,I)),ADDR(L))
         %RESULT = L
         %FINISH
      %REPEAT
%RESULT = 0
%END
!
%EXTERNALINTEGERFN ECTM PPI(%INTEGER PPLEN, PPADDR, ID)
!
! Returns the value of an integer-type parameter pair.
!
%INTEGERARRAYFORMAT PP FORM(1:3,1:100)
%INTEGERARRAYNAME PP
%INTEGER I
!
PP == ARRAY(PP ADDR, PP FORM)
PP LEN = (PP LEN & LENGTH MASK)//3
%IF PP LEN = 0 %THEN %RESULT = 0
%CYCLE I = 1, 1, PP LEN
      %IF PP(1,I) = ID %THEN %START
         %RESULT = PP(2,I)
         %FINISH
      %REPEAT
%RESULT = 0
%END
!
%EXTERNALSTRINGFN ECTM PPS(%INTEGER PPLEN, PPADDR, ID)
!
! Returns the value of a string-type parameter pair.
!
%INTEGERARRAYFORMAT PP FORM(1:3,1:100)
%INTEGERARRAYNAME PP
%INTEGER I
%STRING(255) S
!
PP == ARRAY(PP ADDR, PP FORM)
PP LEN = (PP LEN & LENGTH MASK)//3
%IF PPLEN = 0 %THEN %RESULT = ""
%CYCLE I = 1, 1, PP LEN
      %IF PP(1,I) = ID %THEN %START
         LENGTH(S) = PP(2,I) & LENGTH MASK
         MOVE(LENGTH(S),PP(3,I),ADDR(S)+1)
         ETOI(ADDR(S)+1,LENGTH(S))
         %RESULT = S
         %FINISH
      %REPEAT
%RESULT = ""
%END
!
%EXTERNALROUTINE SET PARAM(%INTEGER ID, PPLEN, PPADDR, DR0, DR1,  %C
      %LONGINTEGERNAME AREA DESC)
!
! Resets the value of an existing parameter pair.
!
%INTEGERARRAYFORMAT PP FORM(1:3,1:100)
%INTEGERARRAYNAME PP
%INTEGER I, LEN
%LONGINTEGER DESC
!
PP == ARRAY(PP ADDR, PP FORM)
PP LEN = (PP LEN & LENGTH MASK)//3
%IF PP LEN <= 0 %THEN %RETURN
%CYCLE I = 1, 1, PP LEN
      %IF PP(1,I) = ID %THEN %START
         %IF DR0 >> 24 = X'58' %AND AREA DESC # NIL   %C
            %AND AREA DESC # 0 %THEN %START
!
! Copy the 'described' string to the 'area' supplied by the caller,
! and update the stored descriptor.
!
            DESC = AREA DESC
            *LSS_    DR1
            *LUH_    DR0
            *LD_     DESC
            *LDTB_   DR0
            *MV_     %L=%DR
            DR1 = DESC & ADDRESS MASK
            LEN = DR0 & LENGTH MASK
            *LD_     DESC
            *MODD_   LEN
            *STD_    DESC
            AREA DESC = DESC
            %FINISH
         PP(2,I) = DR0;  PP(3,I) = DR1
         %RETURN
         %FINISH
      %REPEAT
%END
!
%EXTERNALROUTINE ADD PARAM(%INTEGER ID, %INTEGERNAME PPLEN,  %C
      %INTEGER PPADDR, DR0, DR1, %LONGINTEGERNAME AREA DESC)
!
! Resets value if Ppair found, else adds new one to list
!
%INTEGERARRAYFORMAT PP FORM(1:3,1:100)
%INTEGERARRAYNAME PP
%INTEGER I, LEN
%LONGINTEGER DESC
!
PP == ARRAY(PP ADDR, PP FORM)
LEN = (PP LEN & LENGTH MASK)//3
%IF LEN <= 0 %THEN %RETURN
%CYCLE I = 1, 1, LEN
      %IF PP(1,I) = ID %THEN -> FOUND
      %REPEAT
LEN = LEN + 1
I = LEN
PP LEN = WORD DESC ! (LEN*3)
PP(1,I) = ID
!
FOUND:
!
!%IF BYTEINTEGER(ADDR(DR0)) = X'58' %AND AREA DESC # NIL  %C
!      %AND AREA DESC # 0 %THEN %START
%IF BYTEINTEGER(ADDR(DR0)) # X'58' %THEN -> OUT
%IF AREA DESC = NIL %THEN -> OUT
%IF AREA DESC = 0 %THEN -> OUT
      DESC = AREA DESC
      *LSS_    DR1
      *LUH_    DR0
      *LD_     DESC
      *LDTB_   DR0
      *MV_     %L=%DR
      DR1 = DESC & ADDRESS MASK
      LEN = DR0 & LENGTH MASK
      *LD_     DESC
      *MODD_   LEN
      *STD_    DESC
      AREA DESC = DESC
!      %FINISH
OUT:
PP(2,I) = DR0
PP(3,I) = DR1
%END
!
%EXTERNALINTEGERFN MERGE PP(%INTEGER OLD DR0, OLD DR1,  %C
      %INTEGERNAME NEW DR0, NEW DR1)
!
! Adds the given 'old' parameter pairs to the (existing) 'new'
! list, giving precedence to the 'old' valuES.
!
%INTEGER I, NPP
%INTEGERARRAYFORMAT PP FORM(1:3,1:100)
%INTEGERARRAYNAME PP
!
%IF OLD DR0 = NIL %OR OLD DR0 = 0 %THEN %RESULT = 0
NPP = (OLD DR0 & LENGTH MASK)//3
PP == ARRAY(OLD DR1, PP FORM)
%IF NPP > 0 %THEN %START
      %CYCLE I = 1, 1, NPP
         ADD PARAM(PP(1,I), NEW DR0, NEW DR1, PP(2,I), PP(3,I), NIL)
         %REPEAT
      %FINISH
%RESULT = 0
%END
!
%EXTERNALINTEGERFN ECTM FILE ROUTE(%LONGINTEGER ROUTE,  %C
      %INTEGER OPERATION)
%CONSTINTEGER CREATE = 1, ASSIGN = 2, DESTROY = 3, DEASSIGN = 4
!
! Calls a 'ROUTE' routine through the given call
! descriptor with the operation code and the  file
! description as parameters.
!
%INTEGER RC, AD
%LONGINTEGER CALL DESC
%RECORDNAME AFR(AFRFMT)
!
AD = ECTM GET ROUTE(ROUTE)
%IF AD = 0 %THEN %RESULT = 9723
AFR == RECORD(AD)
CALL DESC = AFR_ROUTE
!
*PRCL_   4
*LSD_    ROUTE
*ST_     %TOS
*LSS_    OPERATION
*ST_     %TOS
*LD_     CALL DESC
*RALN_   8
*CALL_   (%DR)
*ST_     RC
%RESULT = RC
%END
!
%EXTERNALINTEGERFN ECTM PROCESS PP(%INTEGER DR0, DR1,  %C
      %LONGINTEGERARRAYNAME A)
!
%INTEGER I, ADR, NPP, ID, ACT, POS, DIS, CPOS, CDIS
%LONGINTEGER L
%INTEGERNAME L1, L2
L1 == INTEGER(ADDR(L));  L2 == INTEGER(ADDR(L)+4)
!
! Valid parameter pair combinations, from PSD 2.8.19.1 (sheet 186)
! Dashes in columns 2 & 3 (position & displacement) are represented
! by 9, which matches anything.
!
%CONSTINTEGER NCOMB = 31
%CONSTINTEGERARRAY ICOMB(1:93) =  %C
      0, 2, 0,
      0, 1, 0,
      0, 0, 1,
      0, 0,-1,
      0, 3, 0,
      0, 4, 0,
      1, 0, 1,
      1, 0,-1,
      1, 4, 0,
      2, 0, 1,
      2, 4, 0,
      8, 9, 9,
      3, 4, 0,
     10, 9, 9,
      4, 4, 0,
     11, 9, 9,
      5, 0, 1,
      6, 9, 9,
      7, 9, 9,
     18, 0, 1,
     14, 9, 9,
     16, 9, 9,
     19, 0, 1,
     19, 0,-1,
     26, 9, 9,
     99, 9, 9,
     99, 9, 9,
     24, 9, 9,
     23, 9, 9,
     22, 9, 9,
     21, 9, 9
!
! Flags giving the type of each parameter pair - 0 (integer),
! 1 (descriptor), 9 (invalid)
!
%CONSTINTEGER NIDS = 30
%CONSTINTEGERARRAY FLAG(0:30) =  %C
   0, 9, 0, 1, 0, 0, 9, 1, 9, 1, 9,
      9, 0, 1, 9, 9, 1, 9, 9, 1, 9,
      9, 0, 9, 1, 0, 0, 1, 1, 0, 9
!
NPP = (DR0 & LENGTH MASK)//3
%IF DR1 = -1 %OR DR1 = 0 %OR NPP = 0 %THEN %START
!
! NIL parameter list - get 'action' from 'set action'.
!
      A(0) = A(12)
      %FINISH  %C
%ELSE %START
!
! Add the given pairs to the array, but forget any saved 'action'
! from the last call.
!
      A(0) = -1
      ADR = DR1
      %CYCLE I = 1, 1, NPP
         ID = INTEGER(ADR)
         %IF 0 <= ID <= NIDS %THEN %START
            %IF FLAG(ID) = 9 %THEN -> ERR
            %IF FLAG(ID) = 1 %THEN %START
               L1 = INTEGER(ADR+4)
               L2 = INTEGER(ADR+8)
               %FINISH  %C
            %ELSE L = INTEGER(ADR+4)
            A(ID) = L;  ! Note that L == (L1,L2)
            %IF ID = 0 %THEN %EXIT
            %FINISH
         ADR = ADR + 12
         %REPEAT
      %FINISH
!
! Now pick up 'action', 'position', 'displacement' to look
! up the combination table.
!
ACT = A(0)
%IF ACT = -1 %OR ACT = 12 %OR ACT = 13 %OR ACT = 26  %C
      %THEN I = 25 %AND -> FOUND;  ! No action
POS = A(4)
DIS = A(5)
%CYCLE I = 1, 1, NCOMB
      %IF ACT = ICOMB(I*3-2) %THEN %START
         CPOS = ICOMB(I*3-1);  CDIS = ICOMB(I*3)
         %IF (POS = CPOS %OR CPOS = 9)  %C
         %AND (DIS = CDIS %OR CDIS = 9) %THEN -> FOUND
         %FINISH
      %REPEAT
!
! Combination not found - abort.
!
ECTM REPORT INT("Invalid ACCESS1 combination:      Action =", ACT)
ECTM REPORT INT("                                Position =", POS)
ECTM REPORT INT("                            Displacement =", DIS)
%RESULT = 9006
!
FOUND:
%IF (X'80000000' >> (I-1)) & INTEGER(ADDR(A(16))) = 0  %C
      %THEN %RESULT = 9006
!
! If 'action' was given, set 'set action' parameter for next call.
!
%UNLESS A(0) = -1 %THEN A(12) = A(0)
%RESULT = I
!
ERR:
ECTM REPORT INT("Invalid RAM/ACCESS1 parameter ID", ID)
ECTM DUMP PPAIRS(DR0,DR1)
%RESULT = 0
%END
!
%EXTERNALINTEGERFN ECTM DESC I(%LONGINTEGER ROUTE, %INTEGER ID)
!
%INTEGER AD
%RECORDNAME AFR(AFRFMT)
!
AD = ECTM GET ROUTE(ROUTE)
%IF AD = 0 %THEN %RESULT = -1
AFR == RECORD(AD)
%RESULT = ECTM PPI(AFR_DESC DR0, AFR_DESC DR1, ID)
%END
!
%EXTERNALSTRINGFN ECTM DESC S(%LONGINTEGER ROUTE, %INTEGER ID)
!
%INTEGER AD
%RECORDNAME AFR(AFRFMT)
!
AD = ECTM GET ROUTE(ROUTE)
%IF AD = 0 %THEN %RESULT = ""
AFR == RECORD(AD)
%RESULT = ECTM PPS(AFR_DESC DR0, AFR_DESC DR1, ID)
%END
!
%EXTERNALLONGINTEGERFN ECTM DESC L(%LONGINTEGER ROUTE, %INTEGER ID)
!
%INTEGER AD
%RECORDNAME AFR(AFRFMT)
!
AD = ECTM GET ROUTE(ROUTE)
%IF AD = 0 %THEN %RESULT = -1
AFR == RECORD(AD)
%RESULT = ECTM PPL(AFR_DESC DR0, AFR_DESC DR1, ID)
%END
!
%EXTERNALINTEGERFN ECTM SET DESC I(%LONGINTEGER ROUTE,  %C
      %INTEGER ID, VALUE)
!
%INTEGER AD
%RECORDNAME AFR(AFRFMT)
!
AD = ECTM GET ROUTE(ROUTE)
%IF AD = 0 %THEN %RESULT = -1
AFR == RECORD(AD)
ADD PARAM(ID, AFR_DESC DR0, AFR_DESC DR1,  %C
      VALUE, 0, AFR_AREA DESC)
%RESULT = 0
%END
!
%EXTERNALINTEGERFN ECTM SET DESC S(%LONGINTEGER ROUTE,  %C
      %INTEGER ID, %STRING(255) VALUE)
!
%INTEGER AD
%RECORDNAME AFR(AFRFMT)
%INTEGER STR0, STR1
!
%IF VALUE = "" %THEN STR0 = -1 %AND STR1 = -1 %ELSE %START
      STR0 = LENGTH(VALUE)
      STR1 = ADDR(VALUE) + 1
      ITOE(STR1,STR0)
      STR0 = STR0 ! STRING DESC
      %FINISH
!
AD = ECTM GET ROUTE(ROUTE)
%IF AD = 0 %THEN %RESULT = -1
AFR == RECORD(AD)
ADD PARAM(ID, AFR_DESC DR0, AFR_DESC DR1,  %C
      STR0, STR1, AFR_AREA DESC)
%RESULT = 0
%END
!
%EXTERNALINTEGERFN ECTM SET DESC L(%LONGINTEGER ROUTE,  %C
      %INTEGER ID, VALUE0, VALUE1)
!
%INTEGER AD
%RECORDNAME AFR(AFRFMT)
!
AD = ECTM GET ROUTE(ROUTE)
%IF AD = 0 %THEN %RESULT = -1
AFR == RECORD(AD)
ADD PARAM(ID, AFR_DESC DR0, AFR_DESC DR1,  %C
      VALUE0, VALUE1, AFR_AREA DESC)
%RESULT = 0
%END
!
%ENDOFFILE