PERMROUTINESPEC SVC(INTEGER EP, BYTEINTEGERNAME R0, R1)
PERMINTEGERMAPSPEC INTEGER(INTEGER N)
PERMBYTEINTEGERMAPSPEC BYTEINTEGER(INTEGER N)
PERMINTEGERFNSPEC ADDR(INTEGERNAME N)
PERMINTEGERFNSPEC ACC
OWNBYTEINTEGERNAME DUMMY = 0
BEGIN
INTEGERMAPSPEC COM(INTEGER I)
ROUTINESPEC DA(INTEGER MODE, BLOCK, INTEGERNAME ADDRESS)
ROUTINESPEC BLOCKS(BYTEINTEGERARRAYNAME F, INTEGERNAME I)
ROUTINESPEC RENAME(BYTEINTEGERARRAYNAME OLD, NEW)
ROUTINESPEC DESTROY(BYTEINTEGERARRAYNAME FILE)
ROUTINESPEC READ KEY(BYTEINTEGERARRAYNAME KEY)
ROUTINESPEC Q(BYTEINTEGERARRAYNAME FILE, MASK)
ROUTINESPEC GETDIR(BYTEINTEGERARRAYNAME FILE)
ROUTINESPEC ALPHA(BYTEINTEGERARRAYNAME FILE)
ROUTINESPEC PRINTF(BYTEINTEGERARRAYNAME FILE)
BYTEINTEGERARRAY FILE(0:1500)
BYTEINTEGERARRAY OLD(0:5)
BYTEINTEGERARRAY NEW(0:5)
BYTEINTEGERARRAY MASK(0:5)
INTEGER NO, J, NFS, I, K, M, BR
RECORDFORMAT PF(BYTEINTEGER SERVICE, REPLY, C
INTEGER A1, BYTEINTEGERNAME A2, INTEGER A3)
RECORDFORMAT FILEF(BYTEINTEGER UNIT, FSYS, C
BYTEINTEGERARRAY NAME(0:5))
CONSTBYTEINTEGERNAME ID=K'160030'
CONSTBYTEINTEGERNAME OWN FS=K'160055'
LOOP: PROMPT('>')
SKIPSYMBOL WHILE (NEXTSYMBOL<'A' OR NEXTSYMBOL>'Z') AND NEXTSYMBOL#'?'
READKEY(MASK)
IF MASK(1)#' ' THEN ->IMPLY
J=MASK(0)
K=0
!****
!****
!**** B=BLOCKS
IF J='B' START
K=1
GETDIR(FILE)
PRINTSTRING('NAME?:') IF NEXTSYMBOL#' '
PRINTSYMBOL(K'100000')
READKEY(MASK)
Q(FILE, MASK)
IF FILE(0)>0 START
IF FILE(0)>1 THEN ALPHA(FILE)
NFS=FILE(0)*6
CYCLE I=2, 6, NFS-4
CYCLE J=0, 1, 5
MASK(J)=FILE(I+J)
PRINTSYMBOL(MASK(J))
REPEAT
BLOCKS(MASK, NO)
WRITE(NO, 3)
NEWLINE
REPEAT
FINISHELSESTART
PRINTSTRING('NO FILE !
')
FINISH
FINISH
!****
!****
!**** R=RENAME
IF J='R' START
K=1
IF NEXTSYMBOL#' ' START
PROMPT('OLD FILE ?: ')
FINISH
READKEY(OLD)
GETDIR(FILE)
Q(FILE, OLD)
NFS=FILE(0)
IF NFS=0 START
PRINTSTRING('OLD FILE DOES NOT EXIST
')
->LOOP
FINISH
IF NEXTSYMBOL#'/' START
PROMPT('NEW FILE ?: ')
FINISH
READKEY(NEW)
RENAME(OLD, NEW)
FINISH
!****
!****
!**** D=DESTROY
IF J='D' START
K=1
GETDIR(FILE)
PRINTSTRING('NAME : ') IF NEXTSYMBOL#' '
PRINTSYMBOL(K'100000')
READKEY(MASK)
Q(FILE, MASK)
IF FILE(0)>0 START
IF FILE(0)>1 THEN ALPHA(FILE)
NFS=FILE(0)*6
CYCLE I=2, 6, NFS-4
CYCLE M=0, 1, 5
MASK(M)=FILE(I+M)
PRINTSYMBOL(MASK(M))
REPEAT
IF FILE(0)>1 START ; ! MORE THAN ONE FILE
PRINTSTRING('?: ')
PRINTSYMBOL(K'100000')
SKIPSYMBOL WHILE NEXTSYMBOL=' ' OR NEXTSYMBOL=10
READSYMBOL(M)
IF M='Y' THEN DESTROY(MASK)
ELSE
DESTROY(MASK); NEWLINE
FINISH
REPEAT
FINISHELSESTART
PRINTSTRING('NO FILE !
')
FINISH
FINISH
!****
!****
!**** A=ALPHABETIC LIST
IF J='A' START
K=1
GETDIR(FILE)
ALPHA(FILE)
PRINTF(FILE)
FINISH
!****
!****
!**** F=FILE LIST
IF J='F' START
K=1
GETDIR(FILE)
PRINTF(FILE)
FINISH
!****
!****
!**** L=SELECTIVE LIST
IF J='L' START
PRINTSTRING('MASK?:')
PRINTSYMBOL(K'100000')
READ KEY(MASK)
IMPLY: K=1
GETDIR(FILE)
Q(FILE, MASK)
NFS=FILE(0)
IF NFS>0 START
IF NFS>1 THEN ALPHA(FILE)
PRINTF(FILE)
FINISHELSESTART
PRINTSTRING('NO FILE !
')
FINISH
FINISH
!****
!****
!**** S=STOP
IF J='S' THENSTOP
!****
!****
!**** U = USER DIRECTORY
!****
IF J='U' START
K=1; ! MARK COMMAND FOUND
IF NEXTSYMBOL#' ' START
PRINTSTRING('DIR NO?'); PRINTSYMBOL(K'100000')
FINISH
SKIPSYMBOL WHILE NEXTSYMBOL=' ' OR NEXTSYMBOL=10
READSYMBOL(BR); READSYMBOL(I)
BR=(BR-'0')<<3+I-'0'
IF BR<0 OR BR>K'77' START
PRINTSTRING(' ?
')
FINISHELSE OWN FS=BR
FINISH
IF K=0 THEN ->IMPLY
->LOOP
ROUTINE PRINTF(BYTEINTEGERARRAYNAME FILE)
INTEGER N, I, FLS, J
FLS=FILE(0)
N=FLS*6
WRITE(FLS, 1)
PRINTSTRING(' FILES
')
IF FLS>0 START
SPACES(4)
CYCLE I=2, 1, N+1
PRINTSYMBOL(FILE(I))
J=I-1
IF J//30*30=J THEN NEWLINE
IF J//6*6=J THEN SPACES(4)
REPEAT
NEWLINE
FINISH
END
ROUTINE GETDIR(BYTEINTEGERARRAYNAME FILE)
INTEGER DIRBLOCK
INTEGER I, K, J, N, BLOCK, NFS
INTEGERARRAY BUFF(0:255)
NFS=0
K=1
!!! DIRBLOCK=COM(-1)+OWN FS
DIRBLOCK = K'150'
BLOCK=DIRBLOCK-1+OWN FS
UNTIL BLOCK>=DIRBLOCK+3 CYCLE ; ! ONE ONLY IF NOT 0 OR 1
BLOCK=BLOCK+1
DA(0, BLOCK, BUFF(0))
CYCLE I=0, 5, 250
N=ADDR(BUFF(I))
IF INTEGER(N)#0 START
NFS=NFS+1
CYCLE J=0, 1, 5
K=K+1
FILE(K)=BYTEINTEGER(N+J)
REPEAT
FINISH
REPEAT
REPEAT
FILE(0)=NFS
END
ROUTINE Q(BYTEINTEGERARRAYNAME FILE, MASK)
INTEGER N, I, J, CK, P, NFS
N=0
P=-4
NFS=FILE(0)*6
CYCLE I=2, 6, NFS-4
CK=0
CYCLE J=0, 1, 5
IF MASK(J)=X'3F' OR MASK(J)=FILE(I+J) THEN CK=CK+1
REPEAT
IF CK=6 START
N=N+1
P=P+6
CYCLE J=0, 1, 5
FILE(P+J)=FILE(I+J)
REPEAT
FINISH
REPEAT
FILE(0)=N
END
ROUTINE READ KEY(BYTEINTEGERARRAYNAME KEY)
INTEGER I, J, K, N
KEY(I)=' ' FOR I=0, 1, 5
SKIPSYMBOL WHILE NEXTSYMBOL=' ' OR NEXTSYMBOL=NL
CYCLE I=0, 1, 5
N=NEXTSYMBOL
IF (N<'0' OR (N>'9' AND N<'A') OR N>'Z') AND N#'?' START
IF KEY(I-1)='?' START
CYCLE K=I, 1, 5
KEY(K)='?'
REPEAT
FINISH
RETURN
FINISH
READSYMBOL(J)
KEY(I)=J
REPEAT
END
ROUTINE ALPHA(BYTEINTEGERARRAYNAME FILE)
!**** REORDERS FILE LIST IN FILE
!**** FILE(0) CONTAINS NUMBER OF FILES
!**** FILE LIST STARTS AT FILE(2)
!**** EACH FILE CONSISTS OF 6 CHARACTERS
INTEGER NFS, I, J, K, PTR, TT
INTEGER TEMP
NFS=FILE(0)*6
RETURNIF NFS<=6; ! LESS THAN TWO FILES
!**** OUTSIDE LOOP FOR ALPHA ORDERING
CYCLE I=2, 6, NFS-10
!**** POINTER SET UP AT LOWEST MEMBER
PTR=I
!**** NOW FIND LOWEST FILE NAME ON FROM THIS FILE
CYCLE J=I+6, 6, NFS-4
!**** COMPARE FILENAMES
CYCLE K=0, 1, 5
TEMP=FILE(J+K)
TT=FILE(PTR+K)
IF TEMP>TT THEN ->BIGGER
IF TEMP<TT THEN ->SMALLER
REPEAT
SMALLER: PTR=J
BIGGER: REPEAT
!**** PTR NOW POINTS AT RELATIVE LOWEST FILE NAME
!**** SO SWAP FILE NAMES
IF I#PTR THENSTART
CYCLE J=0, 1, 5
TEMP=FILE(I+J)
FILE(I+J)=FILE(PTR+J)
FILE(PTR+J)=TEMP
REPEAT
FINISH
REPEAT
END
ROUTINE DESTROY(BYTEINTEGERARRAYNAME FILE)
RECORD (PF) P
OWNRECORD (FILEF) F
INTEGER I
F_UNIT=0; F_FSYS=OWN FS
F_NAME(I)=FILE(I) FOR I=0, 1, 5
P_SERVICE=4; P_REPLY=ID
P_A1=2; ! DESTROY
P_A2==F_UNIT
PONOFF(P)
END
ROUTINE RENAME(BYTEINTEGERARRAYNAME OLD, NEW)
RECORDFORMAT P3F(BYTEINTEGER SERVICE, REPLY, C
INTEGER A1, BYTEINTEGERNAME A2, A3)
RECORD (P3F) P3
RECORD (FILEF) FO,FN
INTEGER I, J
CYCLE I=0, 1, 5
FO_NAME(I)=OLD(I)
FN_NAME(I)=NEW(I)
REPEAT
FO_FSYS=OWN FS; FN_FSYS=OWN FS
FO_UNIT=0; FN_UNIT=0
P3_SERVICE=4; P3_REPLY=ID
P3_A1=5; ! RENAME
P3_A2==FO_UNIT; P3_A3==FN_UNIT
PONOFF(P3)
IF P3_A1#0 THEN PRINTSTRING( ' NEW FILE EXISTS!
')
END
ROUTINE BLOCKS(BYTEINTEGERARRAYNAME FILE, C
INTEGERNAME NO)
OWNRECORD (FILEF) F
RECORD (PF) P
INTEGER I, N
NO=0
CYCLE I=0, 1, 5
F_NAME(I)=FILE(I)
REPEAT
F_UNIT=0; F_FSYS=OWN FS
P_SERVICE=4; P_REPLY=ID
P_A1=0; P_A2==F_UNIT
PONOFF(P)
N=P_A1
UNTIL N=0 CYCLE
P_SERVICE=4; P_REPLY=ID
P_A1=1; P_A3=N
PONOFF(P)
N=P_A1
NO=NO+1
REPEAT
END
ROUTINE DA(INTEGER MODE, BLOCK, INTEGERNAME ADDRESS)
RECORDFORMAT PF(BYTEINTEGER SERVICE, REPLY, C
INTEGER A1, INTEGERNAME A2, INTEGER A3)
RECORD (PF) P
P_SERVICE=3; P_REPLY=ID
P_A1=0; ! READ
P_A2==ADDRESS; P_A3=BLOCK
PONOFF(P)
IF P_A1#0 START
PRINTSTRING('DISC FAULT
')
STOP
FINISH
END
!!
INTEGERMAP COM(INTEGER I)
OWNINTEGER TEMP=0
RESULT ==TEMP
END
ENDOFPROGRAM