CMPIPIO
* /--- FILE TYPE = E
* /--- BLOCK CMPIPIO 00 000 82/01/10 14.09
IDENT CMPIPIO
CMPIPIO TITLE CMPIPIO - CMP PLATO I/O.
*COMMENT CMP PLATO I/O.
*** CMPIPIO - CMP PLATO I/O.
*
* ALL PLATO FILE I/O ROUTINES USED BY THE CENTRAL
* MICRO PLATO TRANSLATOR ARE IN THIS IDENT.
*
* INPUT IS DONE USING THE STANDARD CONDENSOR
* *GETLINE* ROUTINE. TO USE *GETLINE* REL RECORDS
* CONDC1, LEX, LEXERR, MCOND, MCOND2, AND MGET2 ARE
* LOADED WITH THE CMP OVERLAY.
*
* THE CODE FOR PLATO FILE OUTPUT IS ALL PART OF THIS
* IDENT. THE TRANSLATED OUTPUT IS WRITTEN TO PLATO FILE
* *S0CMPN* WHERE N = THE CONDENSOR ORDINAL.
CST
LIST X
*CALL ZPXIDEF
LIST *
EXT CMPIF,CMPBS,CMPBN,CMPSB,CMPFD,CMPNB
CMPA5B5 BSS 1 24/0, 18/(A5), 18/(B5)
CMPB2B3 BSS 1 24/0, 18/(B2), 18/(B3)
* /--- BLOCK CMPIPIO 00 000 81/12/14 13.03
MPP$CLS TITLE CLOSE PLATO FILES.
*** MPP$CLS - CLOSE PLATO FILES.
*
* ENTRY (B1) = 1.
* (B2) = CYBIL STACK FRAME POINTER.
* (B3) = CYBIL STACK LIMIT.
* (X1) = ADDRESS OF RETURN STATUS.
* (X7) = RETURN ADDRESS.
*
* EXIT (B1) = 1.
* (B2) = AS ON ENTRY.
* (B3) = AS ON ENTRY.
*
* THE RETURN STATUS IS STORED AT ((X1)).
ENTRY MPO$CLS
MPO$CLS ENTR ENTRY
* SAVE CYBIL REGISTERS B2 AND B3.
SX6 B2
SX7 B3
LX6 18
BX6 X6+X7
SA6 CMPB2B3
* SAVE RETURN STATUS ADDRESS.
BX6 X1
SA6 CLSA
* CLOSE THE INPUT FILE.
RJ =XCLOSE
* WRITE THE CURRENT SOURCE BLOCK TO DISK.
RJ WSB
SX7 CMP.IOE I/O ERROR CODE
NZ X6,CLS1 IF ERRORS
* WRITE THE DIRECTORY TO DISK.
RJ WFD
SX7 CMP.IOE I/O ERROR CODE
NZ X6,CLS1 IF ERRORS
* CLOSE THE OUTPUT FILE.
SX6 MS.CPF
RJ MAS
SX7 CMP.OK NO ERROR CODE
* SET RETURN STATUS. (X7) = STATUS.
CLS1 SA1 CLSA
SA7 X1
* RESTORE CYBIL REGISTERS B2 AND B3.
SA1 CMPB2B3
SB3 X1
AX1 18
SB2 X1
DONE RETURN
CLSA BSS 1
* /--- BLOCK CMPIPIO 00 000 81/12/14 13.02
MPP$GTL TITLE MPP$GTL - GET PLATO SOURCE LINE.
*** MPP$GTL - GET PLATO SOURCE LINE.
*
* GET THE NEXT LINE OF PLATO SOURCE CODE.
*
* THE NEXT NON-COMMENT SOURCE LINE IS READ FROM THE
* PLATO FILE. -USE- COMMANDS ARE HANDLED TRANSPARENTLY.
* THE END OF FILE IS SIGNALLED BY RETURNING A -CSTOP*-
* COMMAND.
*
* ENTRY (B1) = 1.
* (B2) = CYBIL STACK FRAME POINTER.
* (B3) = CYBIL STACK LIMIT.
* ((B5)) = COMMAND NAME POINTER ADDRESS.
* (X1) = INDENTATION LEVEL POINTER ADDRESS.
* (X2) = TAG POINTER ADDRESS.
* (X3) = TAG LENGTH POINTER ADDRESS.
* (X4) = BLOCK NUMBER POINTER ADDRESS.
* (X5) = LINE NUMBER POINTER ADDRESS.
* (X7) = RETURN ADDRESS.
*
* EXIT (B1) = 1.
* (B2) = AS ON ENTRY.
* (B3) = AS ON ENTRY.
* /--- BLOCK CMPIPIO 00 000 81/12/09 15.40
ENTRY MPO$GTL
MPO$GTL ENTR ENTRY
* SAVE CYBIL REGISTERS B2 AND B3.
SX6 B2
SX7 B3
LX6 18
BX6 X6+X7
SA6 CMPB2B3
* STORE POINTER ARGUMENTS.
SX6 INDENT
SX7 TAG
SA6 X1
SA7 X2
SX6 TAGCNT
SX7 BLKNUM
SA6 X3
SA7 X4
SX6 LINENUM
SA6 X5
SA1 B5
SX6 COMMAND
SA6 X1
* RESTORE (A5), THE SOURCE WORD POINTER, AND
* (B5), THE END OF BLOCK POINTER.
SA1 CMPA5B5
SB5 X1
AX1 18
SA5 X1
* READ THE NEXT SOURCE LINE.
RJ =XGETLINE
* PRESERVE (A5), THE SOURCE WORD POINTER, AND
* (B5), THE END OF BLOCK POINTER.
SX6 A5
SX7 B5
LX6 18
BX6 X6+X7
SA6 CMPA5B5
* RESTORE CYBIL REGISTERS B2 AND B3.
SA1 CMPB2B3
SB3 X1
AX1 18
SB2 X1
DONE EXIT
* /--- BLOCK CMPIPIO 00 000 81/12/14 13.03
MPP$OPN TITLE MPP$OPN - OPEN PLATO FILES.
*** MPP$OPN - OPEN PLATO FILES.
*
* ENTRY (B1) = 1.
* (B2) = CYBIL STACK FRAME POINTER.
* (B3) = CYBIL STACK LIMIT.
* (X1) = ADDRESS OF RETURN STATUS.
* (X7) = RETURN ADDRESS.
*
* EXIT (B1) = 1.
* (B2) = AS ON ENTRY.
* (B3) = AS ON ENTRY.
*
* THE RETURN STATUS IS STORED AT ((X1)).
ENTRY MPO$OPN
MPO$OPN ENTR ENTRY
* SAVE CYBIL REGISTERS B2 AND B3.
SX6 B2
SX7 B3
LX6 18
BX6 X6+X7
SA6 CMPB2B3
* SAVE RETURN STATUS ADDRESS.
BX6 X1
SA6 OPNA
* INITIALIZE THE OUTPUT FILE.
RJ IOF
SX7 CMP.OIE OUTPUT INITIALIZATION ERROR CODE
NZ X6,OPN1 IF ERRORS
* INITIALIZE THE INPUT FILE.
RJ IIF
SX7 CMP.IIE INPUT INITIALIZATION ERROR CODE
NZ X6,OPN1 IF ERRORS
SX7 CMP.OK NO ERROR CODE
* SET RETURN STATUS. (X7) = STATUS.
OPN1 SA1 OPNA
SA7 X1
* RESTORE CYBIL REGISTERS B2 AND B3.
SA1 CMPB2B3
SB3 X1
AX1 18
SB2 X1
DONE RETURN
OPNA BSS 1
* /--- BLOCK CMPIPIO 00 000 81/12/14 13.02
MPP$PTL TITLE MPP$PTL - PUT PLATO SOURCE LINE.
*** MPP$PTL - PUT PLATO SOURCE LINE.
*
* WRITE A SOURCE LINE TO A PLATO FILE.
*
* ENTRY (B1) = 1.
* (B2) = CYBIL STACK FRAME POINTER.
* (B3) = CYBIL STACK LIMIT.
* (X1) = SOURCE LINE FWA.
* (X2) = SOURCE LINE WORD LENGTH.
* (X3) = ADDRESS OF TERMINATION CONDITION.
* (X7) = RETURN ADDRESS.
*
* EXIT (B1) = 1.
* (B2) = AS ON ENTRY.
* (B3) = AS ON ENTRY.
* /--- BLOCK CMPIPIO 00 000 81/12/11 14.17
ENTRY MPO$PTL
MPO$PTL ENTR ENTRY
* TEST LINE LENGTH.
SX7 CMP.ILL ILLEGAL LINE LENGTH ERROR CODE
NG X2,PTLX IF NEGATIVE LENGTH
ZR X2,PTLX IF ZERO LENGTH
SX0 X2-13-1
PL X0,PTLX IF LONGER THAN 13 WORDS
* TEST FOR END OF LINE.
IX6 X1+X2
MX0 -12
SA5 X6-1
BX0 -X0*X5
SX7 CMP.NEL NO END OF LINE ERROR CODE
NZ X0,PTLX IF NO END OF LINE
* COMPUTE NEW SPACE IN CURRENT BLOCK.
PTL1 SA4 CMPBS
IX6 X4-X2
NG X6,PUTL3 IF BLOCK FULL
SX0 BLKLTH
SA6 A4
* MOVE LINE TO SOURCE BLOCK.
IX0 X0-X4
SA4 CMPSB
IX0 X0+X4
SA0 X1
SB4 X2+
+ WE B4
RJ =XECSPRTY
* RETURN WITH NO ERRORS.
PUTL2 SX7 CMP.OK NO ERROR CODE
* RETURN TO CALLER. (X7) = TERMINATION CONDITION.
PTLX SA7 X3
DONE EXIT
* SAVE THE ARGUMENTS.
PUTL3 BX6 X1
BX7 X2
SA6 PTLA
SA7 A6+B1
BX6 X3
SA6 A7+1
* SAVE CYBIL REGISTERS B2 AND B3.
SX6 B2
SX7 B3
LX6 18
BX6 X6+X7
SA6 CMPB2B3
* WRITE THE SOURCE BLOCK.
RJ WSB
* RESTORE CYBIL REGISTERS B2 AND B3.
SA1 CMPB2B3
SB3 X1+
AX1 18
SB2 X1
* RESTORE THE ARGUMENTS.
SA1 PTLA
SA2 A1+B1
SA3 A2+B1
* TEST FOR I/O ERRORS.
SX7 CMP.IOE I/O ERROR CODE
NZ X6,PTLX RETURN IF I/O ERRORS
* INCREMENT THE BLOCK NUMBER.
SA4 CMPBN
SX6 X4+B1
SA5 CMPNB
IX5 X6-X5
SX7 CMP.OFO OUTPUT FILE OVERFLOW ERROR CODE
PL X5,PTLX RETURN IF FILE OVERFLOW
SA6 A4
* RESET THE SPACE REMAINING.
SX7 BLKLTH
SA7 CMPBS
EQ PTL1 WRITE THE SOURCE LINE
PTLA BSS 3 60/(X1), 60/(X2), 60/(X3)
* /--- BLOCK CMPIPIO 00 000 81/12/05 19.46
CMPIOS TITLE CMPIOS - CMP I/O SUBROUTINES.
* /--- BLOCK CMPIPIO 00 000 81/12/05 17.17
GLI SPACE 4,10
** GLI - GETLINE INITIALIZATIONS.
*
* INITIALIZE LINE BY LINE I/O BY READING THE FIRST
* LINE. THIS IS THE NORMAL CONDENSOR TECHNIQUE.
*
* ENTRY (B1) = 1.
*
* EXIT (B1) = 1.
* (ICX) = COMMAND STORAGE POINTER.
* (INX) = EXTRA STORAGE POINTER.
* (IST) = LOCATION OF NEXT COMMAND WORD.
* (CMPA5B5) = SAVED (A5) AND (B5) FOR GETLINE.
*
* USES A - 5, 6, 7.
* B - 5.
* X - 5, 6, 7.
*
* CALLS GETCMD.
*
* MACROS NONE.
GLI PS ENTRY/EXIT
* SETUP EXTRA STORAGE AND COMMAND STORAGE POINTERS.
SX6 INFOLTH
SA6 ICX
SX7 B0
SA7 INX
* READ THE FIRST LINE.
SB5 CBUF+1
SA5 B5-B1
RJ =XGETCMD
SX6 A5
* SETUP POINTER TO NEXT COMMAND WORD.
SX6 A5
SA6 IST
* PRESERVE (A5), THE SOURCE WORD POINTER, AND
* (B5), THE END OF BLOCK POINTER.
SX6 A5
SX7 B5
LX6 18
BX6 X6+X7
SA6 CMPA5B5
EQ GLI RETURN
* /--- BLOCK CMPIPIO 00 000 81/12/05 17.27
IFD SPACE 4,10
** IFD - INITIALIZE FILE DIRECTORY.
*
* INITIALIZE THE FILE DIRECTORY SUCH THAT
* ALL BLOCKS ARE EMPTY, PARTIALED IN, AND THE
* BLOCK NUMBERS EQUAL THE PHYSICAL BLOCK NUMBERS.
*
* ENTRY (B1) = 1.
* (CMPFD) = DIRECTORY EM FWA.
*
* EXIT (B1) = 1.
*
* USES A - 1, 2, 4.
* B - NONE.
* X - ALL.
*
* MACROS RX, WX.
IFD PS ENTRY/EXIT
* WRITE THE BLOCK INFORMATION WORDS.
SA1 CMPFD
SX0 D.BINFO
SX7 D.BNAME-D.BINFO (X7) = OFFSET FROM INFO TO NAME WORD
IX1 X0+X1 (X1) = BLOCK INFO WORDS FWA
SX5 B1 (X5) = 1 (DECREMENT)
SA2 CMPNB (X2) = BLOCK NUMBER
IX2 X2-X5
IX0 X1+X2
SA4 IFDA (X4) = MASK
IFD1 RX3 X0 READ BLOCK INFO WORD
BX6 -X4*X3 CLEAR SELECTED FIELDS
BX6 X2+X6 INSERT BLOCK NUMBER
WX6 X0 REWRITE THE INFO WORD
MX6 0
IX0 X0+X7
WX6 X0 CLEAR THE BLOCK NAME
IX2 X2-X5
IX0 X1+X2
NZ X2,IFD1 LOOP
EQ IFD RETURN
IFDA VFD BI.PW/-0 PARTIAL FLAG
VFD BI.TW/-0 BLOCK TYPE
VFD BI.UNW/0 UNUSED
VFD BI.DW/0 EDIT DATE
VFD BI.BW/-0 BLOCKS
VFD BI.BLW/-0 BLOCK LENGTH
VFD BI.BNW/-0 BLOCK NUMBER
* /--- BLOCK CMPIPIO 00 000 81/12/05 17.53
IIF SPACE 4,10
** IIF - INITIALIZE THE INPUT FILE.
*
* OPEN THE INPUT SOURCE FILE AND PERFORM INITIALIZAIONS
* FOR GETLINE.
*
* NORMAL CONDENSOR I/O IS USED.
*
* ENTRY (B1) = 1.
*
* EXIT (B1) = 1.
* (CMPIF) = INPUT FILE NAME (2 WORDS).
* (X6) = 0 IF NO ERRORS.
* (X6) .NE. IF ERRORS.
*
* USES A - 0, 1, 6, 7.
* B - NONE.
* X - 0, 1, 6, 7.
*
* CALLS GLI, OIF.
*
* MACROS NONE.
IIF PS ENTRY/EXIT
* GET THE FILE NAME.
SA1 APLACOM
SX0 PC.SRCA
SA0 CMPIF
IX0 X0+X1
+ RE 2
RJ =XECSPRTY
* OPEN THE INPUT FILE.
RJ OIF
NZ X6,IIF RETURN IF ERRORS
* PERFORM GETLINE INITIALIZATIONS.
RJ GLI
MX6 0
EQ IIF RETURN
* /--- BLOCK CMPIPIO 00 000 82/01/10 11.51
IOF SPACE 4,10
** IOF - INITIALIZE THE OUTPUT FILE.
*
* OPEN THE CMP OUTPUT FILE *S0CMP*, INITIALIZE AS AN
* EMPTY FILE.
*
* THE EM BINARY BUFFER IS USED AS THE I/O BUFFER.
*
* ENTRY (B1) = 1.
* (CONBUFF) = BINARY BUFFER EM FWA.
*
* EXIT (B1) = 1.
* (X6) = 0 IF NO ERRORS.
* (X6) .NE. 0 IF ERRORS.
* (CMPFD) = DIRECTORY EM FWA.
* (CMPSB) = SOURCE BLOCK EM FWA.
* (CMPNB) = NUMBER OF BLOCKS IN THE FILE.
* (CMPBN) = 1 (CURRENT BLOCK NUMBER).
* (CMPBS) = *BLKLTH* (SPACE IN BLOCK).
*
* USES A - 0, 1, 6, 7.
* B - NONE.
* X - 0, 1, 6, 7.
*
* CALLS ECSPRTY, IFD, OOF, RFD.
*
* MACROS RX.
IOF PS ENTRY/EXIT
* SET DIRECTORY AND SOURCE BLOCKS EM FWAS. THE
* LESSON BINARY BUFFER IS USED FOR OUTPUT I/O.
SA1 CONBUFF
SX7 BLKLTH ADVANCE BEYOND THE HEADER
IX6 X1+X7
SA6 CMPFD
IX6 X6+X7
SA6 CMPSB
* SETUP THE BLOCK NUMBER AND SPACE IN BLOCK.
SX6 B1+
SA7 CMPBS
SA6 CMPBN
* OPEN THE OUTPUT FILE.
RJ OOF
NZ X6,IOF RETURN IF ERRORS
* READ THE FILE DIRECTORY.
RJ RFD
NZ X6,IOF RETURN IF ERRORS
* GET THE NUMBER OF BLOCKS IN THE FILE.
SA0 CMPNB
SA1 CMPFD
SX0 D.BLKS
IX0 X0+X1
+ RE 1
RJ =XECSPRTY
* VERIFY THAT THE NUMBER OF BLOCKS IS REASONABLE.
SA1 A0
SX6 DSBLKS*MAXPART
IX6 X6-X1
NG X6,IOF RETURN IF TOO MANY BLOCKS
SX6 X1-DSBLKS
NG X6,IOF RETURN IF TOO FEW BLOCKS
* INITIALIZE THE FILE DIRECTORY.
RJ IFD
MX6 0
EQ IOF RETURN
* /--- BLOCK CMPIPIO 00 000 82/01/10 14.10
MAS SPACE 4,10
** MAS - MASTOR REQUEST.
*
* ENTRY (B1) = 1.
* (X6) = MASTOR REQUEST CODE.
* (CMP.OF) = OUTPUT FILE NAME (1ST ARGUMENT).
* (X1) = 2ND MASTOR ARGUMENT.
* (X2) = 3RD MASTOR ARGUMENT.
*
* EXIT (B1) = 1.
* (X6) = MASTOR ERROR CODE.
*
* USES A - 1, 3, 6, 7.
* B - NONE.
* X - 1, 3, 6, 7.
*
* CALLS MASREQ, MASWAIT.
*
* MACROS NONE.
MAS PS ENTRY/EXIT
SA3 CMP.OF
SA6 MASA
BX6 X3
BX7 X1
SA6 A6+2
SA7 A6+B1
BX7 X2
SA7 A7+1
SX1 MASA
RJ =XMASREQ
SX1 MASA
RJ =XMASWAIT
SB1 1 RESTORE (B1)
SA1 MASA
MX6 -5
AX1 6
BX6 -X6*X1
EQ MAS RETURN
MASA BSS MS.RDIM
* /--- BLOCK CMPIPIO 00 000 81/12/09 15.57
OIF SPACE 4,10
** OIF - OPEN INPUT FILE.
*
* USE NORMAL CONDENSOR I/O ROUTINES TO OPEN
* THE INPUT FILE.
*
* ENTRY (B1) = 1.
*
* EXIT (B1) = 1.
* (X6) = 0 IF NO ERRORS.
* (X6) .NE. 0 IF ERRORS.
*
* USES A - 0, 1, 2, 3, 5.
* B - 2.
* X - 0, 1, 2, 3, 5.
*
* CALLS ECSPRTY, OPEN.
*
* MACROS NONE.
OIF PS ENTRY/EXIT
* SET UP FILE POINTERS.
SA2 CMPIF
SB2 FREQ
SA3 A2+1
SA0 CBUF
SA1 AFILEBF
* OPEN THE FILE.
RJ =XOPEN
EQ OIF RETURN
* /--- BLOCK CMPIPIO 00 000 82/01/10 14.18
OOF SPACE 4,10
** OOF - OPEN OUTPUT FILE.
*
* THE OUTPUT FILE NAME IS SET TO *S0CMPN* WHERE N = THE
* CONDENSOR ORDINAL.
* 10 ATTEMPTS ARE MADE BEFORE GIVING UP.
*
* ENTRY (B1) = 1.
* (CONDN) = CONDENSOR ORDINAL (BITS 0-17).
*
* EXIT (B1) = 1.
* (CMP.OF) = OUTPUT FILE NAME.
* (X6) = 0, IF NO ERRORS.
* (X6) .NE. 0, IF UNABLE TO OPEN THE FILE.
*
* USES A - 1.
* B - 1.
* X - 1, 5, 6.
*
* CALLS MAS, S=WAIT.
*
* MACROS NONE.
OOF PS ENTRY/EXIT
* BUILD THE OUTPUT FILE NAME.
SA1 CONDN
SA2 =0LS0CMP
SX6 X1+1R0
LX6 29-5
BX6 X2+X6
SA6 CMP.OF
* REQUEST MASTOR TO OPEN THE FILE.
SX5 9 (X5) = RETRY COUNTER
OOF1 SA1 OOFA
SX6 MS.OPF
RJ MAS
* CHECK FOR ERRORS.
ZR X6,OOF IF NO ERRORS
BX1 X6
SX6 X1-8
ZR X6,OOF OKAY IF FILE ALREADY OPEN
SX6 X1-6
NZ X6,OOF ERROR IF TABLES NOT FULL
SX5 X5-1
NG X5,OOF ERROR IF 10 FAILURES
* WAIT FOR TABLES TO CLEAR.
SB1 1000
RJ =XS=WAIT
SB1 1 RESET (B1)
EQ OOF1 TRY AGAIN
OOFA DATA 0LWRITE
* /--- BLOCK CMPIPIO 00 000 81/12/05 19.51
RFD SPACE 4,10
** RFD - READ FILE DIRECTORY.
*
* ENTRY (B1) = 1.
* (CMPFD) = DIRECTORY EM FWA.
*
* EXIT (B1) = 1.
* (X6) = 0 IF NO ERRORS.
* (X6) .NE. 0 IF ERRORS.
*
* USES A - 2.
* B - NONE.
* X - 1, 2, 6.
*
* CALLS MAS.
*
* MACROS NONE.
RFD PS ENTRY/EXIT
SX6 MS.RPF
SA2 CMPFD
SX1 B0
RJ MAS
EQ RFD RETURN
WFD SPACE 4,10
** WFD - WRITE FILE DIRECTORY.
*
* ENTRY (B1) = 1.
* (CMPFD) = DIRECTORY EM FWA.
*
* EXIT (B1) = 1.
* (X6) = 0 IF NO ERRORS.
* (X6) .NE. 0 IF ERRORS.
*
* USES A - 2.
* B - NONE.
* X - 1, 2, 6.
*
* CALLS MAS.
*
* MACROS NONE.
WFD PS ENTRY/EXIT
SX6 MS.WPF
SA2 CMPFD
SX1 B0
RJ MAS
EQ WFD RETURN
* /--- BLOCK CMPIPIO 00 000 81/12/05 17.44
WPF SPACE 4,10
** WPF - WRITE PLATO FILE.
*
* WRITE A BLOCK TO A PLATO FILE.
*
* ENTRY (B1) = 1.
* (X1) = BLOCK NUMBER.
* (X2) = EM FWA OF BLOCK.
*
* EXIT (B1) = 1.
* (X6) = 0 IF NO ERRORS.
* (X6) .NE. 0 IF ERRORS.
*
* USES A - NONE.
* B - NONE.
* X - 6.
*
* CALLS MAS.
*
* MACROS NONE.
WPF PS ENTRY/EXIT
SX6 MS.WPF
RJ MAS
EQ WPF RETURN
* /--- BLOCK CMPIPIO 00 000 82/01/07 15.29
WSB SPACE 4,10
** WSB - WRITE SOURCE BLOCK.
*
* WRITE A PLATO SOURCE BLOCK.
*
* ENTRY (CMPBN) = BLOCK NUMBER.
* (CMPBS) = SPACE IN BLOCK.
* (CMPSB) = EM FWA OF BLOCK.
* (CMPFD) = EM FWA OF DIRECTORY.
*
* EXIT (X6) = 0, IF NO ERRORS.
* (X6) .NE. 0 IF ERRORS.
*
* USES A - 1, 4, 5.
* B - NONE.
* X - 0, 1, 4, 5, 6, 7.
*
* CALLS WPF.
*
* MACROS RX, WX.
WSB PS ENTRY/EXIT
* RETURN IF NO DATA IN BLOCK.
SX6 B0 PRESET ERROR RETURN
SA1 CMPBS
SX1 X1-BLKLTH
ZR X1,WSB IF NO DATA IN BLOCK
* UPDATE LAST PHYSICAL BLOCK NUMBER IN THE DIRECTORY.
SA1 CMPBN (X1) = BLOCK NUMBER
SA5 CMPFD (X5) = DIRECTORY EM FWA
MX6 1 (X6) = NEW FILE FORMAT FLAG
SX0 D.LPBLK
BX6 X1+X6
IX0 X0+X5
WX6 X0
* SET THE BLOCK LENGTH IN THE DIRECTORY.
SA4 CMPBS
SX7 BLKLTH
IX6 X7-X4 (X6) = BLOCK LENGTH
SX0 D.BINFO
IX0 X0+X5
IX0 X0+X1
RX5 X0 (X5) = BLOCK INFO WORD
LX6 BI.BLF
BX6 X5+X6
WX6 X0
* SET BLOCK NAME TO INPUT FILE NAME.
SA5 CMPIF+1
SX7 D.BNAME-D.BINFO
IX0 X0+X7
BX6 X5
WX6 X0
* WRITE THE SOURCE BLOCK TO DISK.
SA2 CMPSB
RJ WPF
EQ WSB RETURN
* /--- BLOCK CMPIPIO 00 000 81/12/09 15.59
END