%CONSTSTRING(31) RAM NAME = "Fixed record (direct serial)"
!
%CONSTINTEGER PLACEMENT = 130
%CONSTINTEGER CONAD = 133
%CONSTINTEGER ACTUAL FILE SIZE = 150
%CONSTINTEGER NIL = -1
%CONSTINTEGER LENGTH MASK = X'00FFFFFF'
%CONSTLONGINTEGER ADDRESS MASK = X'00000000FFFFFFFF'
!
%OWNINTEGER FILE LENGTH, START ADR, END ADR, ADR, LAST BYTE, ICOMB
%OWNINTEGER LABEL
%OWNINTEGER LRECL, KEY, LEN
%OWNINTEGER QBEFORE
%OWNLONGINTEGER FILE ROUTE
%OWNLONGINTEGERARRAY A(0:31) = -1(32)
!
%SYSTEMROUTINESPEC MOVE(%INTEGER BYTES, FROM, TO)
%SYSTEMROUTINESPEC CHANGE FILE SIZE(%STRING(31) FILE,  %C
      %INTEGER SIZE, %INTEGERNAME FLAG)
!
%EXTERNALROUTINESPEC ECTM SET DESC I(%LONGINTEGER FILE ROUTE,  %C
      %INTEGER ID, VALUE)
%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)
LABEL = ECTM DESC I(FILE ROUTE, CONAD)
START ADR = LABEL + INTEGER(LABEL+4)
FILE LENGTH = INTEGER(LABEL)
LRECL = INTEGER(LABEL+24) >> 16
LAST BYTE = LABEL + FILE LENGTH - 1
END ADR = START ADR + INTEGER(LABEL+28)*LRECL - 1
ADR = START ADR
KEY = 1
%IF A(29) = 3 %THEN KEY = INTEGER(LABEL+28) + 1  %C
      %AND ADR = END ADR + 1
QBEFORE = 1
%RESULT = 0
%END
!
%INTEGERFN DO IO
!
%INTEGER FROM ADR, TO ADR, FLAG
%OWNINTEGER RC
%SWITCH CASE(1:22)
!
-> CASE(ICOMB)
!
CASE(1):
!
! Select just before first
!
      ADR = START ADR
      KEY = 1
      RC = -9015
      -> RETURN
!
CASE(2):
!
! Select just after last
!
      KEY = INTEGER(LABEL+28) + 1
      ADR = END ADR + 1
      RC = -9015
      -> RETURN
!
CASE(3):
!
! Select next
!
      %UNLESS QBEFORE = 1 %THEN %START
         ADR = ADR + LRECL
         KEY = KEY + 1
         %FINISH
      %IF ADR > END ADR %THEN -> CASE(2)
      RC = 0
      -> RETURN
!
CASE(4):
!
! Select previous
!
      ADR = ADR - LRECL
      KEY = KEY - 1
      %IF ADR < START ADR %THEN -> CASE(1)
      RC = 0
      -> RETURN
!
CASE(5):
!
! Select just before current
!
      RC = -9015
      -> RETURN
!
CASE(6):
!
! Select by key
!
      KEY = INTEGER(A(3)&ADDRESS MASK)
      ADR = START ADR + (KEY-1)*LRECL
      %UNLESS START ADR <= ADR <= END ADR %THEN %START
         ADR = END ADR + 1
         KEY = INTEGER(LABEL+28) + 1
         RC = 9077
         -> RETURN
         %FINISH
      RC = 0
      -> RETURN
!
CASE(7):
!
! Select next and read
!
      %UNLESS QBEFORE = 1 %THEN %START
         ADR = ADR + LRECL
         KEY = KEY + 1
         %FINISH
      %IF ADR > END ADR %THEN %START
         ADR = END ADR + 1
         KEY = INTEGER(LABEL+28) + 1
         RC = 9034
         -> RETURN
         %FINISH
      TO ADR = A(7) & ADDRESS MASK
      MOVE(LRECL,ADR,TO ADR)
      RC = 0
      -> RETURN
!
CASE(8):
!
! Select previous and read
!
      ADR = ADR - LRECL
      KEY = KEY - 1
      %IF ADR < START ADR %THEN -> CASE(1)
      TO ADR = A(7) & ADDRESS MASK
      MOVE(LRECL,ADR,TO ADR)
      RC = 0
      -> RETURN
!
CASE(9):
!
! Select by key and read
!
      KEY = INTEGER(A(3)&ADDRESS MASK)
      ADR = START ADR + (KEY-1)*LRECL
      %UNLESS START ADR <= ADR <= END ADR %THEN %START
         ADR = END ADR + 1
         KEY = INTEGER(LABEL+28) + 1
         RC = 9077
         -> RETURN
         %FINISH
      TO ADR = A(7)&ADDRESS MASK
      MOVE(LRECL,ADR,TO ADR)
      RC = 0
      -> RETURN
!
CASE(10):
!
! New write (at end of file)
!
      %UNLESS ADR = END ADR + 1 %THEN RC = 9043 %AND -> RETURN
      FROM ADR = A(7) & ADDRESS MASK
      %IF ADR + LRECL > LAST BYTE %THEN %START
         FILE LENGTH = FILE LENGTH + 4096
         CHANGE FILE SIZE(ECTM DESC S(FILE ROUTE, PLACEMENT),  %C
            FILE LENGTH, FLAG)
         %IF FLAG > 0 %THEN RC = 9040 %AND -> RETURN
         INTEGER(LABEL) = FILE LENGTH
         LAST BYTE = LAST BYTE + 4096
         %FINISH
      ECTM SET DESC I(FILE ROUTE, ACTUAL FILE SIZE, FILE LENGTH//1024)
      MOVE(LRECL,FROM ADR,ADR)
      ADR = ADR + LRECL
      KEY = KEY + 1
      END ADR = ADR - 1
      INTEGER(LABEL+28) = KEY
      RC = 0
      -> RETURN
!
CASE(11):
!
! Select by key and new write
!
      RC = 9043
      -> RETURN
!
CASE(12):
!
! Overwrite current
!
      %IF RC > 0 %THEN RC = 9034 %AND -> RETURN
      FROM ADR = A(7) & ADDRESS MASK
      MOVE(LRECL,FROM ADR,ADR)
      RC = 0
      -> RETURN
!
CASE(13):
!
! Select by key and overwrite
!
      KEY = INTEGER(A(3)&ADDRESS MASK)
      ADR = START ADR + (KEY-1)*LRECL
      %UNLESS START ADR <= ADR <= END ADR %THEN %START
         ADR = END ADR + 1
         KEY = INTEGER(LABEL+28) + 1
         RC = 9077
         -> RETURN
         %FINISH
      FROM ADR = A(7)&ADDRESS MASK
      MOVE(LRECL,FROM ADR,ADR)
      RC = 0
      -> RETURN
!
CASE(14):
!
! Destroy current
!
      RC = 9006
      -> RETURN
!
CASE(15):
!
! Select by key and destroy
!
      RC = 9006
      -> RETURN
!
CASE(16):
!
! Extended destroy from current
!
      %IF RC > 0 %THEN RC = 9034 %AND -> RETURN
      END ADR = ADR - 1
      INTEGER(LABEL) = END ADR - START ADR + INTEGER(LABEL+4)
      INTEGER(LABEL+28) = KEY - 1
      RC = 0
      -> RETURN
!
CASE(17):; CASE(18):; CASE(19):; CASE(20):; CASE(21):
!
! Various obscure combinations
!
      RC = 9006
      -> RETURN
!
CASE(22):
!
! Read key
!
      %IF RC > 0 %THEN RC = 9034 %AND -> RETURN
      RC = 0
      -> RETURN
!
RETURN:
!
%IF RC = 0 %AND A(3) # NIL %THEN INTEGER(A(3)&ADDRESS MASK) = KEY
QBEFORE = 0
%IF ICOMB = 1 %OR ICOMB = 5 %THEN QBEFORE = 1
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 < 23 %THEN %RESULT = 9006
%RESULT = DO IO
%END
!
%EXTERNALINTEGERFN ACCESS2
!
%IF ICOMB = 25 %THEN %RESULT = 0
%UNLESS 0 < ICOMB < 23 %THEN %RESULT = 9006
%RESULT = DO IO
%END
!
%ENDOFFILE