%CONSTINTEGER PLACEMENT = 130
%CONSTINTEGER CONAD = 133
%CONSTINTEGER CURRENT LENGTH = 134
%CONSTINTEGER NIL = -1
%CONSTINTEGER LENGTH MASK = X'00FFFFFF'
%CONSTLONGINTEGER ADDRESS MASK = X'00000000FFFFFFFF'
!
%OWNINTEGER FILE LENGTH, START ADR, END ADR, ADR, LAST BYTE, ICOMB
%OWNLONGINTEGER FILE ROUTE
%OWNLONGINTEGERARRAY A(0:31) = -1(32)
!
%EXTERNALROUTINESPEC TERMINATE
%EXTERNALROUTINESPEC PROMPT(%STRING(15) PMP)
%SYSTEMROUTINESPEC ETOI(%INTEGER ADDRESS, LENGTH)
%SYSTEMROUTINESPEC MOVE(%INTEGER BYTES, FROM, TO)
%SYSTEMROUTINESPEC ITOE(%INTEGER ADDRESS, LENGTH)
%SYSTEMROUTINESPEC CHANGE FILE SIZE(%STRING(31) FILE,  %C
      %INTEGER SIZE, %INTEGERNAME FLAG)
!
%EXTERNALROUTINESPEC ECTM INHIBIT
%EXTERNALROUTINESPEC ECTM ALLOW
%EXTERNALINTEGERFNSPEC ECTM PROCESS PP(%INTEGER DR0, DR1,  %C
      %LONGINTEGERARRAYNAME A)
%EXTERNALINTEGERFNSPEC ECTM DESC I(%LONGINTEGER ROUTE, %INTEGER ID)
%EXTERNALSTRINGFNSPEC ECTM DESC S(%LONGINTEGER ROUTE, %INTEGER ID)
%EXTERNALROUTINESPEC ECTM REPORT INT(%STRING(63) MESS, %INTEGER I)
%EXTERNALROUTINESPEC ECTM DUMP PPAIRS(%INTEGER DR0, DR1)
!
%EXTERNALINTEGERFN RAM(%LONGINTEGER ROUTE,  %C
      %INTEGER PP DR0, PP DR1)
!
!** ECTM DUMP PPAIRS(PP DR0 & LENGTH MASK, PP DR1)
FILE ROUTE = ROUTE
ICOMB = ECTM PROCESS PP(PP DR0, PP DR1, A)
ECTM REPORT INT("Action combination", ICOMB)
START ADR = ECTM DESC I(FILE ROUTE, CONAD) + 32
FILE LENGTH = ECTM DESC I(FILE ROUTE, CURRENT LENGTH)
LAST BYTE = START ADR + FILE LENGTH - 1
END ADR = LAST BYTE
ADR = START ADR
%IF A(29) = 3 %THEN ADR = END ADR + 1
%RESULT = 0
%END
!
%INTEGERFN DO IO
!
%INTEGER I, J, K, X, RC
%BYTEINTEGERARRAY B(1:133)
%SWITCH CASE(1:31)
!
-> CASE(ICOMB)
!
CASE(1):
!
      RC = -9015
      -> RETURN
!
CASE(2):
      RC = -9015
      -> RETURN
!
CASE(3):
      RC = 9097
      -> RETURN
!
CASE(4):
      RC = 9097
      -> RETURN
!
CASE(5):
!
      RC = 9097
      -> RETURN
!
CASE(6):
      RC = 9097
      -> RETURN
!
CASE(7):
      ECTM INHIBIT
      I = A(7) & ADDRESS MASK
      J = 0
      %CYCLE
         READ SYMBOL(X)
         %IF X = NL %THEN %EXIT
         BYTEINTEGER(I) = X
         J = J + 1
         %REPEAT
      ITOE(A(7)&ADDRESS MASK, J)
      %UNLESS A(9) = -1 %THEN INTEGER(A(9)&ADDRESS MASK) = J
      RC = 0
      ECTM ALLOW
      -> RETURN
!
CASE(10):
      ECTM INHIBIT
      SELECT OUTPUT(0)
      I = A(7) & ADDRESS MASK
      J = INTEGER(A(9)&ADDRESS MASK)
      %IF J > 0 %THEN MOVE(J,I,ADDR(B(1)))
      I = ADDR(B(1))
      %IF J > 0 %THEN ETOI(I,J)
      %CYCLE
         %IF J = 0 %THEN %EXIT
         PRINT SYMBOL(BYTEINTEGER(I))
         I = I + 1
         J = J - 1
         %REPEAT
      NEW LINE
      RC = 0
      ECTM ALLOW
      -> RETURN
!
CASE(16):
      RC = 0
      -> RETURN
!
CASE(17):
      ECTM INHIBIT
      SELECT OUTPUT(0)
      SELECT INPUT(0)
      I = A(7) & ADDRESS MASK
      J = INTEGER(A(9)&ADDRESS MASK)
      ETOI(I,J)
      %CYCLE K = 1, 1, J
         PRINT SYMBOL(BYTEINTEGER(I))
         I = I + 1
         %REPEAT
      TERMINATE
      PROMPT("")
      %CYCLE
         READ SYMBOL(X)
         %IF X = NL %THEN %EXIT
         BYTEINTEGER(I) = X
         I = I + 1
         J = J + 1
         %REPEAT
      ITOE(A(7)&ADDRESS MASK,J)
      INTEGER(A(9)&ADDRESS MASK) = J
      RC = 0
      ECTM ALLOW
      -> RETURN
!
RETURN:
!
ECTM REPORT INT("ACCESS result code:",RC)
%RESULT = RC
%END
!
%EXTERNALINTEGERFN ACCESS1(%INTEGER DR0, DR1)
!
!** ECTM DUMP PPAIRS(DR0 & LENGTH MASK, DR1)
ICOMB = ECTM PROCESS PP(DR0, DR1, A)
ECTM REPORT INT("Action combination", ICOMB)
%IF ICOMB = 25 %THEN %RESULT = 0;  ! NO-OP
%UNLESS 0 < ICOMB < 32 %THEN %RESULT = 9006
%RESULT = DO IO
%END
!
%EXTERNALINTEGERFN ACCESS2
!
%IF ICOMB = 25 %THEN %RESULT = 0
%UNLESS 0 < ICOMB < 32 %THEN %RESULT = 9006
%RESULT = DO IO
%END
!
%ENDOFFILE