IDENT CPUPFM,FWA
ABS
SST
ENTRY CPF
ENTRY DMP=
ENTRY LIB=
ENTRY MFL=
ENTRY SSJ=
ENTRY UTL=
SYSCOM B1
TITLE CPUPFM - COPY INDIRECT ACCESS FILES.
*COMMENT CPUPFM - COPY INDIRECT ACCESS FILES.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
CPF SPACE 4,10
*** CPUPFM - COPY INDIRECT ACCESS FILES.
*
* R. C. SCHMITTER. 84/03/28.
SPACE 4,10
*** *CPUPFM* IS CALLED BY *PFM* TO PERFORM THE COPY OF AN
* INDIRECT ACCESS FILE FOR *GET*, *OLD*, *SAVE*, *REPLACE*
* AND *APPEND* OPERATIONS IF THE FILE LENGTH IS GREATER
* THAN THE THREHOLD DEFINED IN *COMSPFM*. THE ONLY ENTRY
* IS BY *DMP=* CALL TO *CPF*. *CPUPFM* CANNOT BE CALLED
* AT THE COMMAND LEVEL.
SPACE 4,10
*** COMMAND FORMAT.
*
* *SPCW* FORMAT FROM *PFM*.
*
*T 18/ *CPF*,6/ 30B,18/ 0,18/ COMMAND CODE
*
* *CPUPFM* REPLY TO *PFM*.
*
*T 24/ 0,3/ 1,1/E ,8/ EC,24/ 0
*
* E = ERROR IDLE FLAG. IF SET, ERROR IDLE STATUS IS
* TO BE SET FOR THE MASTER DEVICE BY *PFM*.
*
* THIS FLAG IS SET WHEN THE FILE TRANSFER IS
* INCOMPLETE FOR *APPEND*, *REPLACE*, AND *SAVE*
* COMMANDS. THIS CONDITION CAN OCCUR WITH
* *TRACK LIMIT*, *PFM ABORTED*, AND *MASS STORAGE
* ERROR* ERROR CODES .
*
* THIS FLAG IS SET WITH *FILE LENGTH ERROR* ERROR
* CODE WHEN THERE IS A LOGICAL ERROR IN THE LENGTH
* OF THE FILE.
*
* EC = *PFM* ERROR CODE.
* DTE(17) - DATA TRANSFER ERROR.
* TKL(31) - TRACK LIMIT.
* FLE(32) - FILE LENGTH ERROR.
* ABT(36) - PFM ABORTED.
* MSE(37) - MASS STORAGE ERROR.
* RTR(127) - RETRY REQUEST.
*
*
* THE *DMPN* BLOCK IN NFL IS SET BY *PFM* WITH THE FOLLOWING
* FORMAT.
*
*T 42/ LFN,18/ FLAGS
*T, 12/ ,24/ APFL, 24/ LF
*T, 36/ ,24/ RANDOM ADDRESS
*T, 60/ SRB (WORD 0)
*T, 60/ SRB (WORD 1)
*T, 60/ SRB (WORD 2)
*T, 60/ SRB (WORD 3)
*
* LFN = LOCAL FILE NAME.
* FLAGS = 17/ ,1/ FGIA
* FGIA = INDIRECT ALLOCATION INTERLOCK HELD.
* LF = TOTAL LENGTH OF FILE TO BE TRANSFERRED (BOTH PERMANENT
* AND LOCAL FOR *APPEND*).
* APFL = LENGTH OF THE LOCAL FILE FOR *APPEND*.
* = 0, IF NOT *APPEND*.
* SRB = SPECIAL REQUEST BLOCK FOR THE ORIGINAL FILE FOR
* *APPEND*.
*
* IF *APFL* = *LF*, THEN THE *APPEND* IS AT THE END OF
* THE INDIRECT CHAIN.
SPACE 4,10
* COMMON DECKS.
*CALL COMCMAC
*CALL COMCCMD
*CALL COMSMLS
*CALL COMSPFM
*CALL COMSPFU
*CALL COMSPRD
*CALL COMSRPV
*CALL COMSSSD
*CALL COMSSSJ
SPACE 4,10
* MACROS.
DELPFC MACRO LFN,SRB
MACREF DELPFC
=4 LFN,,,,SRB,,,,,,,,27B
DELPFC ENDM
SPACE 4,10
**** ASSEMBLY CONSTANTS.
BUFL EQU 10030B BUFFER LENGTH FOR SINGLE BUFFER COPY
EIDF EQU 400B ERROR IDLE FLAG
****
TITLE FETS AND STORAGE LOCATIONS.
ORG 120B
SPACE 4,10
FWA BSS 0
* FETS.
I BSS 0 INPUT FILE
INPUT FILEB BUF,BUFL,FET=10D,EPR
O BSS 0 OUTPUT FILE
OUTPUT FILEB BUF,BUFL,FET=16D,EPR,UPR
SPACE 4,10
* STORAGE LOCATIONS.
APFL CON 0 APPEND ORIGINAL FILE LENGTH
ERRF CON 0 ERROR FLAG
FTCF CON 0 FILE TRANSFER COMPLETE FLAG
LENG CON 0 FILE LENGTH
LFAL CON 0 LOCAL FILE ACCESS LEVEL
LFNM CON 0 LOCAL FILE NAME
PFMC CON 0 *PFM* COMMAND CODE
SPACE 4,10
* SPECIAL *PFM* COMMUNICATION FILE NAMES.
APFN VFD 42/7L"APF",18/3 APPEND FILE NAME
ILKN VFD 42/7L"ILK",18/3 INTERLOCK FILE NAME
PFNM VFD 42/7L"PFN",18/3 PERMANENT FILE NAME
SPACE 4,10
* *SSJ=* SPECIAL ENTRY POINT PARAMETER BLOCK.
SSJ= VFD 12/0,24/-0,12/PFCS,12/IRSI
BSSZ SSJL-1
LIB= EQU 0 ALLOW WRITE ON EXECUTE-ONLY FILE
UTL= EQU 0 ALLOW ACCESS TO SUSPECT DEVICE
TITLE MAIN PROGRAM.
* MAIN PROGRAM.
CPF SB1 1 ENTRY
RJ PRS PRESET
SA1 APFL
SA5 LENG GET FILE LENGTH
ZR X1,CPF2 IF NOT *APPEND*
IX5 X5-X1 SET ORIGINAL FILE LENGTH
ZR X5,CPF1 IF *APPEND* AT END OF CHAIN
* PROCESS COPY OF ORIGINAL FILE (*APPEND* ONLY).
SA1 APFN SET INPUT FILE NAME
BX6 X1
SA6 I
RJ SBC COPY PERMANENT FILE
NZ X1,CPF4 IF ERROR DETECTED
SA1 I+FTFT RESET BUFFER POINTERS
SX6 X1
SA6 A1+B1
SA6 A6+B1
SA1 O+FTFT
SX6 X1
SA6 A1+B1
SA6 A6+B1
SA1 LFNM SET LOCAL FILE NAME
BX6 X1
SA6 I
CPF1 SA5 APFL GET FILE LENGTH
* PROCESS FILE COPY (ALL FUNCTIONS).
CPF2 RJ SBC COPY FILE
NZ X1,CPF4 IF ERROR DETECTED
SX6 B1 SET FILE TRANSFER COMPLETE
SA6 FTCF
SA1 O+FTFT CLEAR USER PROCESSING IN OUTPUT FET
MX0 59
LX0 45
BX6 X0*X1
SA6 A1
SA1 LFNM REWIND LOCAL FILE
BX6 X1
SA6 O
REWIND O,R
RJ COS CHECK OUTPUT FET STATUS
NZ X1,CPF4 IF ERROR DETECTED
RJ DOF DELETE ORIGINAL FILE
SA1 ERRF
NZ X1,CPF4 IF ERROR DETECTED
* RETURN ALL *PFM* FILES.
CPF3 RECALL I
RECALL O
SA1 PFNM RETURN PERMANENT FILE
BX6 X1
SA6 O
RETURN O,R
SA1 ILKN RETURN INTERLOCK FILE
BX6 X1
SA6 O
RETURN O,R
SA1 APFL
ZR X1,CPF4 IF NOT *APPEND*
SA5 LENG
IX5 X5-X1
ZR X5,CPF4 IF *APPEND* TO END OF CHAIN
SA1 APFN RETURN APPEND FILE
BX6 X1
SA6 O
RETURN O,R
* SET REPLY TO *PFM*.
CPF4 SA1 ERRF GET ERROR FLAG
SX6 B1
LX6 33
ZR X1,CPF6 IF NO ERROR DETECTED
SA2 FTCF CHECK FILE TRANSFER COMPLETE FLAG
SA3 PFMC CHECK COMMAND CODE
NZ X2,CPF5 IF FILE TRANSFER COMPLETE
SX2 X3-CCGT
ZR X2,CPF5 IF *GET* COMMAND
SX2 X3-CCOD
ZR X2,CPF5 IF *OLD* COMMAND
SX1 X1+EIDF SET ERROR IDLE FLAG
CPF5 LX1 24 ADD ERROR FLAG TO REPLY
BX6 X1+X6
CPF6 SA6 SPPR SET *SPCW*
ENDRUN
TITLE SUBROUTINES.
COS SPACE 4,20
** COS - CHECK OUTPUT FET STATUS,
*
* ENTRY (O) = OUTPUT FET.
* (PFMC) = *PFM* FUNCTION.
*
* EXIT (X1) = 0 IF NO ERROR STATUS IN FET.
* .NE. 0 IF ERROR SET IN FET.
* (ERRF) = ERROR FLAG SET IF ERROR SET IN FET.
* SET TO *RETRY REQUEST* FOR WRITE ERROR
* ON *GET* AND *OLD* REQUESTS AND TO
* *MASS STORAGE ERROR* FOR WRITE ERROR
* ON OTHER REQUESTS.
* SET TO *TRACK LIMIT* FOR FULL DISK ERROR.
* SET TO *PFM ABORTED* FOR ANY OTHER ERROR.
*
* USES X - 0, 1, 2, 6, 7.
* A - 1, 2, 6, 7.
COS SUBR ENTRY/EXIT
SA2 O OUTPUT FET
BX1 X1-X1
LX2 59-0
PL X2,COSX IF FET BUSY
LX2 59-13-59+0
NG X2,COS1 IF FATAL ERROR
LX2 59-11-59+13
NG X2,COS2 IF PARITY ERROR
LX2 59-10-59+11
PL X2,COSX IF NO ERROR
* PROCESS TRACK LIMIT ERROR.
SX6 /ERRMSG/TKL *EQXXX,DNYY, TRACK LIMIT.*
EQ COS3 SET ERROR FLAG
* PROCESS FATAL ERROR.
COS1 SX6 /ERRMSG/ABT *PFM ABORTED.*
EQ COS3 SET ERROR FLAG
* PROCESS PARITY ERROR.
COS2 SA1 PFMC CHECK *PFM* FUNCTION
SX6 /ERRMSG/RTR RETRY REQUEST
SX2 X1-CCGT
ZR X2,COS3 IF *GET*
SX2 X1-CCOD
ZR X2,COS3 IF *OLD*
SX6 /ERRMSG/MSE *EQXXX,DNYY, MASS STORAGE ERROR.*
* SET ERROR FLAG AND CLEAR ERROR CODE FROM FET.
COS3 SA6 ERRF SET ERROR FLAG
SA2 O CLEAR ERROR CODE FROM FET
MX0 56
LX0 10
BX7 X0*X2
SA7 A2
BX1 X6
EQ COSX RETURN WITH (X1) .NE. 0
ERR SPACE 4,10
** ERR - *REPRIEVE* ERROR PROCESSOR.
*
*
* EXIT (ERRF) = ERROR FLAG.
* TO *CPF3* TO RETURN *PFM* COMMUNICATION FILES.
ERR BSS 0 ENTRY
SX6 /ERRMSG/ABT *PFM ABORTED.*
SA6 ERRF SET ERROR FLAG
EQ CPF3 RETURN COMMUNICATION FILES
ERRA RPVBLK ERR REPRIEVE PARAMETER BLOCK
DOF SPACE 4,10
** DOF - DELETE ORIGINAL FILE.
*
* EXIT *PFM* CALLED TO DELETE PFC ENTRY FOR ORIGINAL
* FILE ON *APPEND* OPERATION.
* (ERRF) = ERROR RETURNED FROM *PFM*.
*
* USES X - 0, 1, 2, 6, 7.
* A - 1, 2, 6, 7.
*
* MACROS DELPFC.
DOF SUBR ENTRY/EXIT
SA1 APFL
ZR X1,DOFX IF NOT *APPEND*
SA2 LENG
IX6 X1-X2
ZR X6,DOFX IF *APPEND* AT END OF CHAIN
DELPFC O,SPPR+4
SA1 O CHECK FOR ERROR
MX0 -8
LX0 10
BX6 -X0*X1
ZR X6,DOFX IF NO ERROR
BX7 X0*X1 CLEAR ERROR CODE FROM FET
SA7 A1
LX6 0-10
SA6 ERRF SAVE ERROR CODE
EQ DOFX RETURN
SBC SPACE 4,30
** SBC - SINGLE BUFFER COPY.
*
* ENTRY (X5) = LENGTH OF FILE.
*
* EXIT (X1) = 0 IF FILE COPY COMPLETE.
* .NE. 0 IF FILE COPY INCOMPLETE.
* (ERRF) = ERROR FLAG.
*
* ERROR WHEN READ PARITY ERROR DETECTED -
* IF CORRECT SECTOR WAS READ, SET *DATA TRANSFER ERROR*
* AND CONTINUE TRANSFER.
* IF INCORRECT SECTOR WAS READ, SET *FILE LENGTH
* ERROR* AND PAD OUTPUT FILE WITH EOF-S.
*
* USES X - ALL.
* A - 0, 1, 2, 3, 4, 6.
*
* CALLS COS.
*
* MACROS READCW, RECALL, WRITECW, WRITEW.
*
* PROGRAMMER-S NOTE - WHEN CHECKING FOR FET COMPLETE AND
* DATA IN THE BUFFER, THE FET STATUS MUST BE PICKED UP
* BEFORE THE BUFFER POINTER.
*
* THIS ROUTINE IS ADAPTED FROM *SBC* IN *COPYB*.
SBC SUBR ENTRY/EXIT
RECALL O
WRITECW O,* PRESET CONTROL WORD WRITE
SA2 I+FTOT
SA0 X2+ INITIALIZE INPUT PSEUDO OUT POINTER
BX0 X0-X0 INDICATE NO BLOCKS AVAILABLE OR COMPLETE
EQ SBC9 INITIATE CONTROL WORD READ
* CHECK FOR INPUT BLOCK AVAILABLE.
SBC1 SA2 I CHECK INPUT FILE STATUS
SA3 I+FTIN CHECK INPUT IN = PSEUDO OUT POINTER
BX0 X0-X0 INDICATE NO BLOCKS AVAILABLE OR COMPLETE
SX1 A0
IX1 X3-X1
LX2 59-0
NZ X1,SBC2 IF INPUT BLOCK AVAILABLE
PL X2,SBC4 IF BUFFER BUSY
LX2 59-9-59+0
NG X2,SBC11 IF EOI
LX2 59-13-59+9
PL X2,SBC1.1 IF NO FATAL ERROR
SX1 /ERRMSG/ABT *PFM ABORTED.*
BX6 X1
SA6 ERRF SET ERROR FLAG
EQ SBCX RETURN WITH (X1) .NE. 0
SBC1.1 LX2 59-11-59+13
PL X2,SBC4 IF NO READ PARITY ERROR STATUS IN FET
SX7 /ERRMSG/DTE *DATA TRANSFER ERROR*
SA7 ERRF
SA1 I+6 CHECK DETAILED ERROR CODE
LX1 59-11
PL X1,SBC1.2 IF CORRECT SECTOR READ
SX6 B1 SET LENGTH ERROR DUE TO HARDWARE FAILURE
SA6 SBCC
EQ SBC11 PAD FILE WITH EOF-S
SBC1.2 MX6 1 CLEAR PARITY ERROR BIT IN FET
BX6 X2-X6
LX6 59-59-59+11
SA6 A2
EQ SBC4 CONTINUE TRANSFER
* PROCESS INPUT BLOCK.
SBC2 SX0 B1 INDICATE INPUT BLOCK TRANSFERRED
SA3 SBCB INCREMENT BLOCK COUNT
SX4 B1 INDICATE DATA TRANSFERRED
IX6 X3+X4
SA4 A0 CRACK CONTROL WORD HEADER
MX7 -24
SA6 A3
BX7 -X7*X4 BYTE COUNT
SX2 4 CALCULATE WORD COUNT
IX7 X7+X2
SX2 X2+B1
IX7 X7/X2
SA2 I+FTLM
SX3 X7+2 ADVANCE OVER BLOCK AND CONTROL WORDS
SX1 A0
SX2 X2+
IX2 X2-X1
IX6 X3-X2
NG X6,SBC3 IF NO WRAP AROUND
SA2 I+FTFT FIRST
BX3 X6
SX1 X2
SBC3 IX6 X1+X3
SA1 A0 GET CONTROL WORD HEADER
PL X1,SBC3.1 IF NO READ ERROR OCCURRED ON THIS BLOCK
SX7 /ERRMSG/DTE *DATA TRANSFER ERROR*
SA7 ERRF
* TRANSFER BLOCK TO OUTPUT.
SBC3.1 ZR X5,SBC13 IF SUPPLIED PRU COUNT NOT ALREADY WRITTEN
SX1 B1 DECREMENT PRU COUNT
IX5 X5-X1
SA6 O+FTIN ADVANCE OUTPUT IN POINTER
SA0 X6 ADVANCE INPUT PSEUDO OUT POINTER
* CHECK FOR REINITIATE CONTROL WORD WRITE.
SBC4 SA1 O
LX1 59-0
PL X1,SBC6 IF BUFFER BUSY
RJ COS CHECK OUTPUT FILE STATUS
NZ X1,SBCX IF ERROR OCCURRED
SA1 O+FTIN
SA2 A1+B1
SX3 BUFL/3
IX1 X1-X2 (IN-OUT)
IX2 X1-X3 (IN-OUT) - 1/3(BUFFER SIZE)
ZR X1,SBC6 IF BUFFER EMPTY
PL X1,SBC5 IF IN .GT. OUT
LX3 1
IX2 X3+X1 2/3(BUFFER SIZE) - (OUT-IN)
SBC5 NG X2,SBC6 IF BUFFER THRESHOLD NOT REACHED
WRITECW O REINITIATE CONTROL WORD WRITE
* CHECK FOR OUTPUT BLOCK WRITTEN.
SBC6 SA1 O+FTOT CHECK OUTPUT OUT = INPUT OUT
SA2 I+FTOT
IX3 X1-X2
ZR X3,SBC7 IF BLOCK NOT WRITTEN
BX6 X1
SX0 X0+1 INDICATE OUTPUT BLOCK COMPLETE
SA6 A2+ UPDATE INPUT OUT = OUTPUT OUT
* CHECK FOR REINITIATE CONTROL WORD READ.
SBC7 SA4 I CHECK INPUT FILE STATUS
LX4 59-0
PL X4,SBC10 IF BUFFER BUSY
SA1 I+FTIN
LX4 59-11-59+0
NG X4,SBC10 IF PARITY ERROR STATUS IN FET
LX4 59-3-59+11
NG X4,SBC10 IF EOF/EOI ENCOUNTERED
LX4 59-13-59+3
NG X4,SBC10 IF FATAL ERROR STATUS IN FET
SX3 BUFL/3 CHECK BUFFER THRESHOLD
SA2 A1+B1
IX1 X1-X2 (IN-OUT)
IX2 X3+X1 1/3(BUFFER SIZE) + (IN-OUT)
ZR X1,SBC9 IF BUFFER EMPTY
NG X1,SBC8 IF OUT .GT. IN
LX3 1
IX2 X1-X3 (IN-OUT) - 2/3(BUFFER SIZE)
SBC8 PL X2,SBC10 IF BUFFER THRESHOLD NOT REACHED
SBC9 READCW I,0 INITIATE CONTROL WORD READ TO EOI
* CHECK FOR RECALL.
SBC10 NZ X0,SBC1 IF INPUT AND/OR OUTPUT BLOCKS TRANSFERRED
RECALL WAIT FOR DATA TRANSFER
EQ SBC1 CHECK FOR INPUT BLOCKS
* PROCESS EOI.
SBC11 ZR X5,SBC14 IF NO FILE LENGTH ERROR
* PROCESS INPUT FILE TOO SHORT.
SBC12 WRITEW O,SBCA,B1+B1 PAD FILE WITH EOF
SX1 B1
IX5 X5-X1
NZ X5,SBC12 IF FILE NOT YET CORRECT LENGTH
* PROCESS INPUT FILE TOO LONG.
SBC13 SX5 -1
* FLUSH OUTPUT BUFFER.
SBC14 RECALL O
RJ COS CHECK OUTPUT FILE STATUS
NZ X1,SBCX IF ERROR OCCURRED
SA1 O+FTIN CHECK IN = OUT
SA2 A1+B1
IX1 X1-X2
ZR X1,SBC15 IF OUTPUT BUFFER EMPTY
WRITECW O,R FLUSH OUTPUT BUFFER
RJ COS CHECK OUTPUT FILE STATUS
NZ X1,SBCX IF ERROR OCCURRED
* PROCESS FILE LENGTH ERROR.
SBC15 ZR X5,SBCX IF NO FILE LENGTH ERROR
SA2 SBCC
SX6 /ERRMSG/FLE *FILE LENGTH ERROR*
NZ X2,SBC16 IF ERROR DUE TO HARDWARE FAILURE
SX6 X6+EIDF SET ERROR IDLE FLAG
SBC16 SA6 ERRF SET ERROR FLAG
BX1 X6
EQ SBCX RETURN WITH (X1) = 0
SBCA VFD 60/0 CONTROL WORD EOF
VFD 12/17B,48/0
SBCB CON 0 BLOCK COUNT
SBCC CON 0 LENGTH ERROR DUE TO HARDWARE FAILURE
SPACE 4,10
* COMMON DECKS.
*CALL COMCCIO
*CALL COMCCPM
*CALL COMCPFM
*CALL COMCSYS
*CALL COMCWTW
TITLE BUFFERS.
* BUFFERS.
USE LITERALS
BUF EQU * BUFFER FOR SINGLE BUFFER COPY
BUFLWA EQU BUF+BUFL+4 END OF BUFFERS
PRS TITLE PRESET.
** PRESET.
*
* ENTRY PARAMETER BLOCK FROM *PFM* AT *SPPR*.
*
* EXIT INPUT AND OUTPUT FILE NAMES SET.
* RANDOM BITS SET IN OUTPUT FET.
* (APFL) = APPEND FILE LENGTH.
* (LENG) = TOTAL FILE LENGTH TO COPY.
* (SPPR) PRESET WITH ERROR REPLAY FOR *PFM*.
* (LFNM) = LOCAL FILE NAME.
*
* USES X - ALL.
* A - 1, 2, 6, 7.
*
* MACROS ABORT, MESSAGE, REPRIEVE.
PRS SUBR ENTRY/EXIT
SA1 ACTR
ZR X1,PRS1 IF NOT COMMAND CALL
MESSAGE (=C*INCORRECT COMMAND.*),,R
ABORT
PRS1 REPRIEVE ERRA,SET,277B SET EXTENDED REPRIEVE
SA1 SPPR GET COMMAND CODE
MX0 -18
BX6 -X0*X1
SA6 PFMC SAVE COMMAND CODE
SA1 A1+B1 GET LOCAL FILE NAME
BX5 -X0*X1 SAVE INTERLOCK FLAG
BX1 X0*X1
SX6 3
BX6 X1+X6
BX1 X6
SA6 LFNM
* SET FILE NAMES IN FETS.
SA2 PFNM GET PERMANENT FILE NAME
SA4 PFMC CHECK COMMAND CODE
SX3 X4-CCGT
ZR X3,PRS2 IF *GET*
SX3 X4-CCOD
ZR X3,PRS2 IF *OLD*
BX1 X2 SWITCH FILE NAMES
BX2 X6
PRS2 BX6 X2 SET FILE NAMES
BX7 X1
SA6 I
SA7 O
SA1 SPPR+2 GET FILE LENGTHS
MX0 -24
BX6 -X0*X1
AX1 24
BX7 -X0*X1
SA6 LENG
SA7 APFL
SA1 PRSA PRESET ERROR REPLY
BX6 X1
SA6 SPPR
SA4 PFMC CHECK COMMAND CODE
SX2 X4-CCGT
ZR X2,PRSX IF *GET*
SX2 X4-CCOD
ZR X2,PRSX IF *OLD*
SX1 EIDF SET ERROR IDLE FLAG IN ERROR REPLY
LX1 24
BX6 X1+X6
SA6 A6
* SET RANDOM REWRITE BITS.
R= X6,FGIA
BX5 X6*X5
NZ X5,PRSX IF SEQUENTIAL WRITE (AT END OF CHAIN)
SX6 B1 SET RANDOM ACCESS BIT
LX6 47-0
SA1 O+1
BX6 X6+X1
SA6 A1
SX6 B1 SET RANDOM REWRITE REQUEST
LX6 29-0
SA1 O+6
BX6 X1+X6
SA2 SPPR+3 GET RANDOM ADDRESS
BX6 X2+X6
SA6 A1
EQ PRSX RETURN
PRSA VFD 24/0,3/1,1/0,8//ERRMSG/ABT,24/0 ERROR REPLY
SPACE 4,10
ERRNG MFL=-* OVERFLOW PAST END OF BUFFERS
SPACE 4,10
IDENT
.1 SET BUFLWA+77B CALCULATE FIELD LENGTH
* SET IGNORE RESOURCE LIMITS FOR PROGRAM EXECUTION.
* FORCE *OVERRIDE REQUIRED* BIT TO BE SET.
* PREVENT *DMP=* ON COMMAND CALL.
* DO NOT RELEASE EXTRA FIELD LENGTH ON LOAD.
DMP= EQU .1/100B+320000B
MFL= EQU .1/100B*100B
SPACE 4
END