!* MODIFIED 19/10/76 11.45
!*
!*
SYSTEMROUTINE AMEND(INTEGER INPUT SET)
!* INPUT SET=0 NO INPUT FILE
!* =1 INPUT FILE DEFINED
SYSTEMINTEGERMAPSPEC COMREG(INTEGER I)
ROUTINESPEC EXTRACT NO(INTEGERNAME A,B)
ROUTINESPEC READCARD(BYTEINTEGERARRAYNAME A,INTEGER J)
ROUTINESPEC WRITECARD(BYTEINTEGERARRAYNAME A)
INTEGERFNSPEC INPUTB
ROUTINESPEC OUTPUTA(INTEGER A)
ROUTINESPEC OUTPUTB(INTEGER A)
ROUTINESPEC SIMFAILIN
ROUTINESPEC SIMFAILOUT
BYTEINTEGER ERFLAG
SYSTEMROUTINESPEC SIM2(INTEGER A,B,C,INTEGERNAME D)
SYSTEMROUTINESPEC FILL(INTEGER L,AT,WIDTH)
BYTEINTEGERARRAY CDIN,EDITCD(0:86)
OWNBYTEINTEGER FLAG=0
CONSTSTRING (2) ARRAY SEQNOS(73:80)=C
'73','74','75','76','77','78','79','80'
CONSTBYTEINTEGERARRAY ITOI(0:255)=C
32(10),10,32(14),25,26,32(5),
32,124,34,35,35,37,38,39,40,41,42,43,44,45,46,47,
48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,
64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,
80,81,82,83,84,85,86,87,88,89,90,36,92,33,92,95,
96,97,98,99,100,101,102,103,104,105,106,107,108,109,
110,111,112,113,114,115,116,117,118,119,
120,121,122,123,92,125,126,32,
26(5),10,26(10),
26(16),
26,91,93,123,125,26(9),92,38,
26(11),35,26(4),
26(16),
26(9),35,26(5),94,
26(32);
INTEGER EOF
INTEGER I,CDNUM,CARDNO,N1,N2,FLNUM,L,SEQ,SQNO,K,J,KK,NUM,LSEQ,C
RSEQ,N,SEQBEG,ENDMARK,CNT,ADR1,ADR2,STEP,EXOPT,IBMFL,SQBRFL,C
CARDHELD,LFLAG,RFLAG,OPTION,LENTH,INFL,OUTFL,CCARD
INTEGER LISTINP
SWITCH SW(0:9),SSW(3:18)
ROUTINE ICARD(BYTEINTEGERARRAYNAME A)
INTEGER I,J,L
BYTEINTEGERARRAY TEMP(1:9)
! %IF SEQBEG=2 %THEN SEQBEG=1 %AND -> NR3
FILL(80,ADDR(A(1)),' ')
SIM2(0,ADDR(A(1)),0,I)
IF A(1)=25 THENSTART
ENDMARK=1
RETURN
FINISH
A(I)=' '
RETURN
!NR3: %IF A(1)='*' %AND A(2)='*' %THEN %RETURN
! %IF SEQBEG=1 %THENSTART
! %CYCLE I=1,1,9
! %UNLESS X'30'<=A(I)<=X'39' %THEN -> NR2
! TEMP(I)=A(I)
! %REPEAT
!NR2: %IF I=1 %THEN %RETURN
! I=I-1
! %CYCLE J=1,1,72
! A(J)=A(I+J+1)
! %REPEAT
! %IF (RSEQ-LSEQ+1) < I %THEN RSEQ=80 %AND LSEQ=73
! %CYCLE J=LSEQ,1,RSEQ
! A(J)='0'
! %REPEAT
! L=0
! %CYCLE J=I,-1,1
! A(RSEQ-L)=TEMP(J)
! L=L+1
! %REPEAT
! %FINISH
END ;! ICARD
!*
!*
NEWLINES(3)
LFLAG=0; RFLAG=0; OPTION=0; LENTH=0; CARDHELD=0;LISTINP=0
ERFLAG=0; IBMFL=0; SQBRFL=0
OPTION=5
CCARD=0
EOF=0
STEP=100; INFL=1; OUTFL=0; SQNO=1
LSEQ=73; RSEQ=80; SEQBEG=0; ENDMARK=0
EXOPT=0;N1=0;CARDNO=0;K=0;CDNUM=0;FLNUM=0
ADR1=ADDR(EDITCD(0)); ADR2=ADDR(CDIN(0));
EDITCD(0)=10;CDIN(0)=10
CYCLE I=80,1,86
EDITCD(I)=' '
CDIN(I)=' '
REPEAT
SW(0):
READCARD(EDITCD,0)
IF ENDMARK=1 THEN -> CLOSEFILE
IF CCARD=0 THEN ->NR502
NR101: EDITCD(0)=10
OUTPUTA(ADR1)
->SW(OPTION)
!*
!****** FILE
SW(2): INFL=0
NR200: ICARD(EDITCD)
IF ENDMARK=1 THEN -> FILEND
IF (EDITCD(1)='*' AND EDITCD(2)='*' AND EDITCD(3)='E' ANDC
EDITCD(4)='N' AND EDITCD(5)='D' ) THEN -> FILEND
CYCLE I=1,1,72
-> NR300 UNLESS EDITCD(I)=' '
REPEAT
-> NR200
NR300: IF IBMFL#0 THEN START
CYCLE I=1,1,72
EDITCD(I)=ITOI(EDITCD(I))
REPEAT
FINISH
IF SQBRFL#0 THEN START
CYCLE I=1,1,72
IF EDITCD(I)='/' THEN START
IF I>1 AND EDITCD(I-1)='(' THEN EDITCD(I-1)=' ' C
AND EDITCD(I)='['
IF I<72 AND EDITCD(I+1)=')' THEN EDITCD(I)=']' C
AND EDITCD(I+1)=' '
FINISH
REPEAT
FINISH
IF RFLAG=1 THENSTART
CDNUM=CDNUM+STEP
J=CDNUM
KK=-1
CYCLE I=RSEQ,-1,LSEQ
IF KK=0 THEN N=0 ELSE START
KK = J//10
N=J-KK*10
FINISH
EDITCD(I)='0'+N
J=KK
REPEAT
FINISH
OUTPUTB(ADR1)
IF LFLAG=1 THEN OUTPUTA(ADR1)
->NR200
!*
!****** INSERT
SW(7): ->FAIL IF K>N1 OR (K=N1 AND EXOPT#8)
CARDNO=N1
SW(5):
SW(9):
NR500: READCARD(EDITCD,0)
IF ENDMARK=1 THEN -> CLOSEFILE
->NR101 IF CCARD=1
!*
!****** DELETE
SW(8): IF EXOPT=4 THEN EXOPT=0 AND -> NR502
->FAIL IF N1<=K AND (OPTION=8 OR OPTION=5)
NR502: IF CARDHELD=0 THENSTART
CARDHELD=1; IF EXOPT=8 THEN EXOPT=0
IF INPUTB#0 THEN RETURN
IF CDIN(1)=25 THENSTART
EOF=10; ->SSW(OPTION+10)
FINISH
SEQ=0
KK=1
CYCLE I=RSEQ,-1,LSEQ
J=BYTEINTEGER(ADR2+I)-X'30'
NUM=J*KK+SEQ
KK=KK*10
SEQ=NUM
REPEAT
FINISH
->FAIL IF OPTION=7 AND EXOPT#8 AND N1=SEQ
->SSW(OPTION+10) IF EOF#0
IF N1<=SEQ THEN ->SSW(OPTION)
K=SEQ
WRITECARD(CDIN)
IF LFLAG=1 THENSTART
OUTPUTA(ADR2)
FINISH
CARDHELD=0 UNLESS CDIN(1)=25; ->NR502
SSW(5): IF N1=SEQ THENSTART
EDITCD(86)='R'; CARDHELD=0; ->NR506
FINISH
SSW(15):
EDITCD(86)='I'
NR506: WRITECARD(EDITCD)
IF FLAG=1 THEN ->INSERTFAIL
OUTPUTA(ADR1)
->NR500
SSW(17):
SSW(7): IF RFLAG=1 THEN ->SSW(5+EOF)
CDNUM=CARDNO; CARDNO=CARDNO+STEP; !INSERT NOT SEQUENCED
->SSW(5+EOF)
SSW(18):
IF EOF#0 THEN ->FAIL
SSW(8): !DELETE: PRINTCARDS DELETED
IF N2>=SEQ THENSTART
CARDNO=CDNUM
IF LFLAG=0 THENSTART
CDIN(86)='D'
OUTPUTA(ADR2)
CDNUM=CARDNO
FINISH
IF INPUTB#0 THEN RETURN
IF CDIN(1)=25 THENSTART
EOF=10; ->NR500
FINISH
SEQ=0
KK=1
CYCLE I=RSEQ,-1,LSEQ
J=BYTEINTEGER(ADR2+I)-X'30'
NUM=J*KK+SEQ
KK=KK*10
SEQ=NUM
REPEAT
->SSW(8)
FINISH
->NR500
!***********LISTON N1
SW(3): -> NR502
SSW(3): LFLAG=1
-> NR500
!***********LISTOFF N1
SW(4): -> NR502
SSW(4): LFLAG=0
EXOPT=4
-> NR500
!*
!*
CLOSEFILE: IF OPTION=2 THEN ->FILEND
SELECT OUTPUT(102) IF OUTFL=0
IF CARDHELD=1 THEN ->NR901
NR900: IF INPUTB#0 THEN RETURN
NR901: ->FILEND IF CDIN(1)=25
IF RFLAG=1 THENSTART
CDNUM=CDNUM+STEP
KK=-1
J=CDNUM
CYCLE I=RSEQ,-1,LSEQ
IF KK=0 THEN N=0 ELSESTART
KK=J//10
N=J-KK*10
FINISH
CDIN(I)='0'+N
J=KK
REPEAT
FINISH
OUTPUTB(ADR2)
IF LFLAG=1 THEN OUTPUTA(ADR2); ->NR900
FAIL: SELECT OUTPUT(99);OUTFL=0
SPACES(30)
PRINTSTRING('***CARD OUT OF SEQUENCE*** ')
ERFLAG=1
IF OPTION=5 THENSTART
WRITE(N1,8)
IF EXOPT=7 THEN OPTION=7
EXOPT=0
->NR500
FINISH
NEWLINE
IF OPTION=8 THEN ->NR500
NR903: READCARD(EDITCD,0)
IF ENDMARK=1 THEN -> CLOSEFILE
->NR903 UNLESS CCARD=1 OR OPTION=5
IF CCARD=1 THEN ->NR101
->SW(8)
!*
INSERTFAIL:FLAG=0
SELECT OUTPUT (99); OUTFL=0
SPACES(30)
PRINTSTRING('***ATTEMPT TO INSERT TOO MANY CARDS***')
NEWLINE
ERFLAG=1
->NR903
!*
!----------------------------------------------------------------------
ROUTINE READCARD(BYTEINTEGERARRAYNAME A,INTEGER J)
STRING (50) P,W,R,RIGHT,LEFT
INTEGER ERR,X,PTR,RESULT,I,L,NUM,KK,LOOP
CDNUM=CDNUM//STEP*STEP
IF J=1 THEN ->SW1
SELECT INPUT(108) IF INFL=1; INFL=0
!*
SW0: ICARD(A)
IF ENDMARK=1 THEN RETURN
CYCLE I=1,1,72
-> NR310 UNLESS A(I)=' '
REPEAT
NR310: IF A(1)='*'AND A(2)='*' THEN -> SW1
SW01: CNT=0
CYCLE I=LSEQ,1,RSEQ
IF A(I)=' ' THEN CNT=CNT+1 ELSESTART
UNLESS '0'<=A(I)<='9' THEN ->NR100
FINISH
REPEAT
NR400: IF CNT=RSEQ-LSEQ+1 THEN START
X=0
IF OPTION#7 THEN -> FAIL1
CCARD=0
RETURN
FINISH
KK=1
X=0
CYCLE I=RSEQ,-1,LSEQ
L=A(I)-'0'
NUM=L*KK+X
KK=KK*10
X=NUM
REPEAT
CCARD=0
RETURN IF X=0
N1=X
IF OPTION=7 OR OPTION=8 THEN EXOPT=OPTION
OPTION=5
RETURN
!*
SW1: A(0)=50; P=STRING(ADDR(A(0)))
CCARD=1
->SW2 IF P->('**FILE').W
->SW3 IF P->('**ALTER').W
->SW4 IF P->('**INSERT').W
->SW5 IF P->('**DELETE').W
->SW6 IF P->('**LISTON').W
->SW7 IF P->('**LISTOFF').W
->SW8 IF P->('**LIST').W
->SW9 IF P->('**SEQ').W
->SW10 IF P->('**SSEQ').W
->SW11 IF P->('**ESEQ').W
->SW12 IF P->('**END').W
->SW01
!*
!****** **FILE
SW2: OPTION=2
RFLAG=1
RFLAG=0 IF P->R.("N").W
LFLAG=1 IF P->R.(' L').W
IBMFL=1 IF P->R.('IBM').W
SQBRFL=1 IF P->R.('1900').W
RETURN
!*
!****** **ALTER
SW3: EXOPT=OPTION; OPTION=5; N1=0
IF P->R.(',R').W THEN RFLAG=1
IF P->R.(' R').W THEN RFLAG=1
IF P->R.(',L').W THEN LFLAG=1
IF P->R.(' L').W THEN LFLAG=1
RETURN
!*
!****** **INSERT
SW4: EXOPT=OPTION; OPTION=7
SW41: IF OPTION=4 THEN LOOP=10 ELSE LOOP=9
CYCLE I=LOOP,1,LOOP+12; !12 SPACES
IF A(I)#' ' THEN ->SW42
REPEAT
IF OPTION=3 THEN -> SW61
IF OPTION=4 THEN -> SW71
->FAIL1
SW42: PTR=ADDR(A(I)); EXTRACT NO(PTR,N1)
->FAIL1 IF N1<0
IF OPTION=3 OR OPTION=4 THENRETURN
CARDNO=N1//STEP*STEP
IF BYTEINTEGER(PTR)=',' THENSTART
CYCLE I=1,1,12
IF BYTEINTEGER(PTR+I)#' ' THEN ->SW43
REPEAT
SW43: PTR=PTR+I; EXTRACT NO(PTR,N2);
->FAIL1 IF N2<0
IF OPTION=7 AND RFLAG#1 THEN STEP=N2
IF CARDNO=N1 THEN CARDNO=CARDNO-STEP
RETURN
FINISH
IF OPTION=8 THEN N2=N1 ELSE STEP=100
RETURN
!*
!****** **DELETE
SW5: OPTION=8; ->SW41
!*
!****** **LISTON
SW6: OPTION=3
-> SW41
SW61: LFLAG=1
RETURN
!*
!****** **LISTOFF
SW7: OPTION=4
-> SW41
SW71: LFLAG=0
RETURN
!*
!****** **LIST
SW8: OPTION=9
IF LISTINP=0 THEN OUTPUTA(ADR2)
LISTINP=1
RETURN
!*
!****** **SEQ
SW9: OPTION=5
B0: IF W->(" ").W THEN -> B0
UNLESS W->LEFT.(",").W THEN -> FAIL1
B1: IF W->(" ").W THEN -> B1
UNLESS W->RIGHT.(" ").W THEN -> FAIL1
CYCLE I=73,1,80
IF LEFT=SEQNOS(I) THEN LSEQ=I
IF RIGHT=SEQNOS(I) THEN RSEQ=I
REPEAT
IF RSEQ-LSEQ<5 THEN STEP=10
RFLAG=1
RETURN
!*
!****** **SSEQ
SW10: SEQBEG=1; OPTION=5; RETURN
!*
!****** **ESEQ
SW11: SEQBEG=0; OPTION=5; RETURN
!*
!****** **END
SW12: ENDMARK=1; RETURN
FAIL1: SELECT OUTPUT(99) IF OUTFL=1; OUTFL=0
SPACES(26)
PRINTSTRING('***INVALID CONTROL CARD***')
NEWLINE
ERFLAG=1
->SW0
NR100: CYCLE I=LSEQ,1,RSEQ
UNLESS A(I)=' ' THEN -> NR200
REPEAT
-> NR300
NR200: SELECT OUTPUT(99) IF OUTFL=1; OUTFL=0
SPACES(30)
PRINTSTRING('***INVALID SEQ NUMBER***'); NEWLINE
ERFLAG=1
->SW0
NR300: IF OPTION=7 THEN ->NR400; ->FAIL1
END
!***********************************************************************
ROUTINE EXTRACT NO(INTEGERNAME PTR,RESULT)
INTEGER X
INTEGER I
RESULT=0
CYCLE PTR=PTR,1,PTR+8
X=BYTEINTEGER(PTR)
RETURN IF X=',' OR X=' '
RESULT=RESULT*10+(X-'0')
REPEAT
RESULT=-1
END
!---------------------------------------WRITECARD----------------------
ROUTINE WRITECARD(BYTEINTEGERARRAYNAME A)
INTEGER I,KK,J,NUM,N
IF RFLAG=1 THENSTART
KK=0
K=1
CYCLE I=RSEQ,-1,LSEQ
J=A(I)-'0'
NUM=J*KK+K
KK=KK*10
K=NUM
REPEAT
CDNUM=CDNUM+STEP; ->NR1
FINISH
IF OPTION=7 AND (N1<=SEQ OR EOF#0) THEN ->NR1 ELSE ->NR4
NR1: KK=-1
J=CDNUM
CYCLE I=RSEQ,-1,LSEQ
IF KK=0 THEN N=0 ELSESTART
KK=J//10
N=J-KK*10
FINISH
A(I)='0'+N
J=KK
REPEAT
NR4: IF OPTION#7 THEN ->NR6
IF RFLAG=1 THEN ->NR5
IF SEQ<=CDNUM AND EOF=0 THENSTART
FLAG=1; CDNUM=CDNUM-STEP
RETURN
FINISH
NR5: K=N1
NR6: OUTPUTB(ADDR(A(0)))
K=N1 IF RFLAG=0
END
!*
ROUTINE SIMFAILIN
SELECT OUTPUT(99); NEWLINE
PRINTSTRING('***INPUT FILE DOES NOT EXIST***'); NEWLINES(2)
END
!*
!******************************************************************
ROUTINE OUTPUTA(INTEGER A)
SELECT OUTPUT(99) IF OUTFL=1; OUTFL=0
L=0
SIM2(1,A,87,L)
IF L<0 THEN SIMFAILOUT
BYTEINTEGER(A+86)=' '
END
!-----------------------------------------------------------------------
ROUTINE OUTPUTB(INTEGER A)
!OUTPUT TO STREAM2
SELECT OUTPUT(102) IF OUTFL=0; OUTFL=1
L=0
SIM2(1,A,81,L)
IF L<0 THEN SIMFAILOUT
END
!-----------------------------------------------------------------------
ROUTINE SIMFAILOUT
SELECT OUTPUT(99)
PRINTSTRING('***OUTPUT FILE CAPACITY EXCEEDED***')
NEWLINES(2)
STOP
END
!-----------------------------------------------------------------------
INTEGERFN INPUTB
INTEGER I,L
!INPUT FROM DISC
IF INFL=0 THENSTART
IF INPUT SET=0 THEN SIMFAILIN AND RESULT =1
SELECTINPUT(101)
INFL=1
FINISH
FILL(80,ADDR(CDIN(1)),' ')
SIM2(0,ADDR(CDIN(1)),0,I)
CDIN(I)=' '
IF LISTINP=1 THEN START
SELECT OUTPUT(99) IF OUTFL=1; OUTFL=0
SIM2(1,ADDR(CDIN(0)),I,L)
FINISH
! SEQBEG=2
! ICARD(CDIN)
RESULT =0
END
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
FILEND: SELECT OUTPUT(99)
NEWLINES(4)
PRINTSTRING('END OF AMEND RUN')
END
ENDOFFILE