Retro1.org codex

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