IDENT FILES,FILES
ABS
SST
SYSCOM B1
ENTRY BKSP
ENTRY BKSPRU
ENTRY COMMON
ENTRY EVICT
ENTRY LOCK
ENTRY PRIMARY
ENTRY RENAME
ENTRY SKIPEI
ENTRY SKIPF
ENTRY SKIPFB
ENTRY SKIPR
ENTRY UNLOCK
ENTRY WRITEF
ENTRY WRITER
ENTRY NPC=
ENTRY RFL=
*COMMENT FILES - LOCAL FILE MANIPULATOR.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
TITLE FILES - LOCAL FILE MANIPULATOR.
SPACE 4
*** FILES - LOCAL FILE MANIPULATOR.
* G. R. MANSFIELD. 70/11/25.
SPACE 4
*** FILES PROCESSES LOCAL FILE FUNCTIONS FOR A JOB AS
* LISTED BELOW. NUMERIC ARGUMENTS, EXCEPT SKIPR EOR LEVEL AND
* SETID ID CODE, ARE ASSUMED DECIMAL, BUT A TRAILING RADIX OF
* *D* OR *B* MAY BE USED.
SPACE 4
*** DAYFILE MESSAGES.
*
*
* * ERROR IN FILE ARGUMENTS.* = AN ARGUMENT TO A FILE
* FUNCTON WAS ILLEGAL.
SPACE 4
*CALL COMCCMD
*CALL COMCMAC
*CALL COMSDSP
*CALL COMSJIO
SPACE 4,10
* SPECIAL ENTRY POINT.
NPC= EQU 0 FORCE OPERATING SYSTEM PARAMETER FORMAT
TITLE MULTI FILE PROCESSOR.
FILES SPACE 4
** FILES - MULTI FILE PROCESSOR.
* ENTRY (B5) = PROCESSOR ADDRESS.
ORG 150B
FILES SA5 2+B6 SET FILE NAME
BX6 X5
SB6 B6+B1
SA6 F
JP B5 PROCESS OPERATION
FIL1 NE B6,B7,FILES LOOP FOR ALL FILES
FIL2 SA1 JOPR CHECK FOR *DIS* CALL
LX1 59-19
NG X1,FIL4 IF *DIS* CALL
CONTROL CCDR,RSS
SA1 PGNR
ZR X1,FIL4 IF NO CONTROL CARD
SA2 FILES-1 FIRST ENTRY NAME
MX0 42
BX1 X0*X1
FIL3 NG X2,FIL4 IF END OF ENTRY NAMES
BX3 X0*X2
BX6 X3-X1
SB2 X2
SA2 A2-B1
NZ X6,FIL3 IF NO MATCH
CONTROL CCDR ADVANCE CONTROL CARD
SA3 PGNR
SA1 F+1 CLEAR FET STATUS
ZR X3,ERR1 IF CONTROL STATEMENT LIMIT
MX2 -24
BX6 -X2*X1
SA6 A1
JP B2 PROCESS CALL
FIL4 ENDRUN
TITLE FUNCTION PROCESSORS.
ASSIGN SPACE 4
BKSP SPACE 4
*** BKSP (F,N,M)
* BACKSPACE N RECORDS ON FILE F
* WITH FILE MODE *M*.
BKSP SB2 -1 PROCESS F,X,M ARGUMENTS
RJ ARG
OPEN F,READNR,R
SKIPB F,X0,R
EQ SKF2 RESET FILE MODE
BKSPRU SPACE 4,5
*** BKSPRU (F,N,M)
*
* BACKSPACE N PHYSICAL RECORD UNITS ON FILE *F*
* WITH FILE MODE *M*.
BKSPRU SB2 -1 PROCESS F,N,M ARGUMENTS
RJ ARG
OPEN F,READNR,R
BKSPRU F,X0,R
EQ SKF2 RESET FILE MODE
COMMON SPACE 4
*** COMMON (F1,F2,...,FN)
* FOR FILES FN, THE FOLLOWING OPERATION IS PERFORMED.
* IF FILE FN IS NOT ASSIGNED TO THE JOB, *COMMON* FILE FN
* IS ASSIGNED TO THE JOB.
* IF FILE FN IS ALREADY ASSIGNED TO THE JOB, NO ACTION IS
* TAKEN.
COMMON SB2 1 CHECK SINGLE ARGUMENTS
RJ ARG
SB5 COM SET COMMON ENTRY
EQ FILES
COM ASSIGN F
EQ FIL1
EVICT SPACE 4
*** EVICT(F1,F2,...,FN)
* EVICT FILES FN.
EVICT SB2 1 CHECK SINGLE ARGUMENTS
RJ ARG
SB5 EVI SET EVICT ENTRY
JP FILES
EVI EVICT A6,R
JP FIL1 PROCESS NEXT FILE
LOCK SPACE 4
*** LOCK (F1,F2,...,FN)
* LOCK FILES FN.
LOCK SB2 1 CHECK SINGLE ARGUMENTS
RJ ARG
SB5 LCK SET LOCK ENTRY
EQ FILES
LCK LOCK A6,R
EQ FIL1 PROCESS NEXT FILE
PRIMARY SPACE 4,2
*** PRIMARY (F)
* MAKE FILE F USER S NEW PRIMARY FILE.
PRIMARY SB2 1 CHECK SINGLE ARGUMENT
RJ ARG
NE B1,B7,ERR IF MORE THAN 1 ARGUMENT SPECIFIED
SB5 PRI
EQ FILES
PRI PRIMARY F
EQ FIL1
RENAME SPACE 4
*** RENAME (N1=F1,N2=F2,...,NI=FI)
* RENAME FILES FN TO NN.
* IF FILE NN WAS PREVIOUSLY DEFINED, THAT FILE WILL BE DROPPED
* FROM THE JOB.
RENAME SB2 2 CHECK EQUIVALENCED ARGUMENTS
RJ ARG
SB6 B1 BEGIN WITH SECOND NAME
SB7 B7+B1
SB5 REN SET RENAME ENTRY
EQ FILES
REN SA4 A6 SAVE OLD NAME
SA1 A5-B1 SET NEW NAME
BX7 X1
SA7 A6
SA1 F SET NEW NAME
BX6 X4 SET OLD NAME
LX7 X1
SA6 A1
SA7 F+6
RENAME A6,,R
SB6 B6+B1
EQ FIL1 PROCESS NEXT FILE
SKIPEI SPACE 4
*** SKIPEI (F)
* SKIP TO END OF INFORMATION ON FILE F (MASS STORAGE ONLY).
SKIPEI SB2 B0 PROCESS F,X ARGUMENTS
RJ ARG
NZ B7,ERR ERROR IF MORE THAN 1 ARGUMENT
OPEN F,READNR,R
SKIPEI F,R
EQ FIL2
SKIPF SPACE 4
*** SKIPF (F,N,M)
* SKIP N FILES FORWARD ON FILE F.
* WITH FILE MODE *M*.
SKIPF SB2 -1 PROCESS F,X,M ARGUMENTS
RJ ARG
OPEN F,READNR,R
SKF1 SKIPFF F,X0,R
SKF2 SA1 F RESET FILE MODE
SX4 3
MX0 42
BX6 X0*X1
BX6 X6+X4
SA6 A1
EQ FIL2
SKIPFB SPACE 4
*** SKIPFB (F,N,M)
* SKIP N FILES BACKWARD ON FILE F.
* WITH FILE MODE *M*.
SKIPFB SB2 -1 PROCESS F,X,M ARGUMENTS
RJ ARG
OPEN F,READNR,R
SKB1 SKIPFB F,X0,R
EQ SKF2
SKIPR SPACE 4
*** SKIPR (F,N,L,M)
* SKIP N RECORDS FORWARD ON FILE F.
* WITH EOR LEVEL *L*, ASSUMED OCTAL, AND/OR FILE MODE *M*.
SKIPR SB2 -2 PROCESS F,X,L,M ARGUMENTS
RJ ARG
BX4 X7 SAVE LEVEL NUMBER
OPEN F,READNR,R
BX7 X4 RESTORE LEVEL NUMBER
SKR1 SX2 F
LX0 18
BX2 X2+X0
LX7 14
SX6 240B
BX7 X7+X6
MX6 60
BX7 X7-X6
RJ =XCIO=
EQ SKF2
UNLOCK SPACE 4
*** UNLOCK (F1,F2,...,FN)
* UNLOCK FILES FN.
UNLOCK SB2 1 CHECK SINGLE ARGUMENTS
RJ ARG
SB5 ULK SET LOCK ENTRY
EQ FILES
ULK UNLOCK A6,R
EQ FIL1 PROCESS NEXT FILE
WRITEF SPACE 4
*** WRITEF(F,N)
* WRITE N FILE MARKS ON FILE F.
WRITEF SB2 B0 PROCESS F,X ARGUMENTS
RJ ARG
WRF1 WRITEF F,R
SX0 X0-1
NZ X0,WRF1 LOOP FOR ALL FILES
EQ FIL2
WRITER SPACE 4
*** WRITER (F,N)
* WRITE N EMPTY RECORDS ON FILE F.
WRITER SB2 B0 PROCESS F,X ARGUMENTS
RJ ARG
WRR1 WRITER F,R
SX0 X0-1
NZ X0,WRR1 LOOP FOR ALL RECORDS
EQ FIL2
TITLE SUBROUTINES.
AMO SPACE 4
ARG SPACE 4
** ARG - PROCESS ARGUMENTS.
*
* ENTRY (B2) = -2 IF F,X,L,M FORM.
* (B2) = -1 IF F,X,M FORM.
* (B2) = 0 IF F,X FORM.
* (B2) = 1 IF SINGLE VALUE ARGUMENT.
* (B2) = 2 IF EQUIVALENCED ARGUMENT.
*
* EXIT (B1) = 1.
* (B6) = 0.
* (B7) = ARGUMENT COUNT.
* (X0) = COUNT OF FILES OR RECORDS.
* (X7) = LEVEL NUMBER.
*
* CALLS DXB.
ARG PS 0 ENTRY/EXIT
SB1 1 (B1) = CONSTANT 1
SA1 ACTR CHECK ARGUMENT COUNT
SB3 X1
ZR B3,ERR IF NO ARGUMENTS
SB7 X1
MX0 42
SA5 ARGR GET FIRST ARGUMENT
SB6 B0
SX2 1
SX6 B2+
ZR B2,ARG1 IF F,X FORM
PL B2,ARG8 IF SINGLE VALUE OR EQUIVALENCED ARGUMENT
* PROCESS F,X OR F,X,M OR F,X,L,M ARGUMENT FORM.
ARG1 SA6 ARGA SAVE ARGUMENT FORM
SX7 X5-1R=
ZR X7,ERR IF EQUIVALENCED ARGUMENT
SX2 3 STORE FILE NAME
BX7 X5+X2
SX0 B1 PRESET COUNT = 1
SA7 F SET FILE NAME IN FET
SB7 B7-B1
BX7 X7-X7 SET LEVEL TO ZERO
ZR B7,ARG RETURN IF 1 ARGUMENT
NZ B2,ARG2 IF NOT F,X FORM
NE B7,B1,ERR IF MORE THAN 2 ARGUMENTS
ARG2 SA5 A5+B1 GET SECOND ARGUMENT
MX0 42 CHECK FOR DEFAULT COUNT
SX6 B1 SET DEFAULT COUNT OF 1
BX2 X0*X5
ZR X2,ARG3 IF COUNT NOT SPECIFIED
SB7 1 ASSUME DECIMAL BASE
RJ DXB
NZ X4,ERR IF CONVERSION ERROR
ZR X6,ERR IF ZERO COUNT
ARG3 BX0 X6 SET COUNT
SA6 ARGB
BX7 X7-X7 SET LEVEL TO ZERO
MX2 42
BX3 X2*X6
NZ X3,ERR IF TOO LARGE
SA3 ARGA
ZR X3,ARG IF F,X FORM
SA1 ACTR
SX3 X3+1
NG X3,ARG4 IF F,X,L,M FORM
SX2 X1-4
PL X2,ERR IF MORE THAN 3 ARGUMENTS
EQ ARG5 CONTINUE TO PROCESS
ARG4 SX2 X1-5
PL X2,ERR IF MORE THAN 4 ARGUMENTS
ARG5 SX2 X1-2
ZR X2,ARG IF ONLY 2 ARGUMENTS
SA5 A5+B1 GET THIRD ARGUMENT
SB7 B0 SET OCTAL MODE
RJ DXB
SA2 ARGB RESET COUNT
SX0 X2+
NZ X4,ARG6 IF CONVERSION ERROR
MX4 -4
BX7 -X4*X6
SA1 ACTR
SX1 X1-4
NG X1,ARG IF ONLY THREE ARGUMENTS
SA5 A5+1 GET FOURTH ARGUMENT
ARG6 SA5 A5+
SX4 1LC
LX4 42
IX4 X5-X4
ZR X4,ARG7 IF CODED
SX4 1LB
LX4 42
IX4 X5-X4
NZ X4,ERR IF NOT BINARY
SX4 B1+ BINARY
ARG7 LX4 1 SET MODE BIT IN FET
SA1 F
SX2 B1+B1
BX6 -X2*X1
BX6 X6+X4
SA6 A1+
EQ ARG
* PROCESS MULTI FILE FORM.
ARG8 EQ B2,B1,ARG9 IF SINGLE ARGUMENT REQUESTED
SX7 X5-1R=
NZ X7,ERR ERROR IF NO EQUIVALENCE
BX6 X0*X5
IX7 X6+X2 ADD COMPLETE BIT
ZR X6,ERR ERROR IF BLANK NAME
SA7 A5+
SB3 B3-1 NEXT ARGUMENT
SA5 A5+B1
BX5 X0*X5
ARG9 ZR X5,ERR IF BLANK NAME
BX7 X5+X2 ADD COMPLETE BIT
SA7 A5
SB3 B3-B1 DECREMENT ARGUMENT COUNT
SA5 A5+B1 NEXT ARGUMENT
NZ B3,ARG8 IF MORE ARGUMENTS TO PROCESS
EQ ARG RETURN
ARGA CON 0 FORM OF ARGUMENTS FLAG
ARGB CON 0 COUNT HOLD
ERR SPACE 4
** ERR - PROCESS ARGUMENT ERROR.
ERR BSS 0
MESSAGE (=C* ERROR IN FILE ARGUMENTS.*)
ERR1 ABORT
FET SPACE 4
ODEBL EQU 20B OPTICAL DISK EXTENSION BUFFER LENGTH
F BSS 0
FILE FILEB BUF,BUFL,(FET=10)
ORG F+11B
VFD 36/,6/ODEBL,18/FODEB POINTER TO *OD* EXT. BUFFER
ORG F+10
* OPTICAL DISK EXTENSION BUFFER.
FODEB BSSZ ODEBL
BUF BSS 0
BUFL EQU 1
SPACE 4
*CALL COMCCIO
*CALL COMCDXB
*CALL COMCLFM
*CALL COMCSYS
USE //
RFL= BSS 0
SPACE 4
END