Retro1.org codex

BINARYX 
* /---   FILE TYPE = E
* /---   BLOCK      BINARY     00 000   78/12/18  20.48 
          IDENT  BINARYX
          TITLE  LESSON BINARY SUBROUTINES
* 
          CST 
* 
          EXT    ECSPRTY,PROLIST,DEVSYS 
          EXT    PROCESS
          EXT    NOECS
          EXT    SLIBERR     (ERROR ON WAY TO SYSLIB) 
* 
          LIST   F
* 
* /---   BLOCK      DEFINES    00 000   80/01/18  21.27 
 
*         TEMPORARY STORAGE DEFINES 
 
 TBSCHK   EQU    TCONDEN     SUMCHECK OF BINARY 
 TBLKS    EQU    TCONBUF     NUMBER OF BINARY BLOCKS
 
*         DEFINITION OF BINARY DIRECTORY
* 
*         IF YOU CHANGE THE DIRECTORY DEFINITIONS, BE SURE
*         YOU MAKE A CORRESPONDING CHANGE IN TUTOR LESSONS
*         (IE., LESSON BINARY). 
 
 DIRCTRY  EQU    WORK 
 EXTRAI   EQU    DIRCTRY+4   START OF EXTRA INFO
 BTIME    EQU    EXTRAI+1    CREATION TIME OF PLATO 
 BDATE    EQU    EXTRAI+2    CREATION DATE OF PLATO 
 BSUMCHK  EQU    EXTRAI+3    SUMCHECK OF BINARY 
 BCDATE   EQU    EXTRAI+4    CREATION DATE OF BINARY
 BJDATE   EQU    EXTRAI+5    CREATION JULIAN DATE OF BINARY 
 BSYSCHK  EQU    EXTRAI+6    SUMCHECK OF SYS VARIABLES
 BUSEINF  EQU    EXTRAI+7    USE FILE INFORMATION 
                             (USEINFL WORDS)
* /---   BLOCK      TESTBIN    00 000   80/01/25  21.27 
          TITLE  -TESTBIN- COMMAND
* 
* 
* 
*         -TESTBIN- COMMAND 
*         CHECKS IF THERE IS A BINARY FOR THE INDICATED FILE
* 
*         RETURNS *ERROR* = 0 OR BINARY FILE NAME 
* 
* 
          ENTRY  TSTBINX
 TSTBINX  SX6    3           UNPACK 3 ARGUMENTS 
          CALL   GETARGS
          MX7    0           DEFAULT FOR 3RD ARGUMENT 
          SX6    X6-3        SEE IF 3RD ARG PRESENT 
          NG     X6,TSTBX2   --- IF 3RD ARG ABSENT
* 
          SA1    VARBUF+2    LOAD 3RD GETVAR CODE 
          BX5    X1 
          NGETVAR 
          BX7    X1 
* 
 TSTBX2   SA7    TBINTSV     SAVE FLAG
* 
          CALL   ACCFILE,VARBUF,VARBUF,0   GET FILE NAME
          SA1    TBINTSV     RETRIEVE N-VERSION FLAG
          CALL   TESTBIN,VARBUF,X1
          SA6    TERROR      RETURN IN *TERROR* 
          ZR     X6,PROCESS 
          BX1    X6          BINARY FILE NAME 
          CALL   FINDFN 
          PL     X7,PROCESS  EXIT IF BINARY DOES EXIST
          MX6    0
          SA6    TERROR      MARK NO BINARY FILE
          EQ     PROCESS
* 
* 
* /---   BLOCK      TESTBIN    00 000   78/01/27  10.18 
          TITLE  TESTBIN   CHECK IF BINARY SHOULD EXIST 
* 
*         -TESTBIN- 
*         CHECK IF THERE SHOULD BE A BINARY FOR THIS LESSON 
* 
*         ON ENTRY - B1 = ADDRESS OF TWO-WORD FILE NAME (ACCOUNT, FILE) 
*                    B2 = 0 IF N-VERSION SUBSTITUTION DESIRED 
*                        -1 IF NOT
* 
*         ON RETURN -  X6 = 0 IF NO BINARY SHOULD EXIST 
*                         = BINARY FILE NAME
* 
*         BINARY FILE NAME = BPPPPXXXXX 
*         B    = B
*         PPPP = FIRST 4 CHARACTERS OF PACKNAME ON WHICH
*                THE LESSON SOURCE RESIDES. 
*         XXXXX= FILE SPACE NUMBER FROM FILE INFO WORD OF 
*                SOURE FILE, CONVERTED TO DISPLAY CODE. 
* 
* 
*         ** NOTE ** THE FIRST 4 CHARACTERS OF EACH SOURCE
*         PACK MUST BE A UNIQUE SET OF CHARARCTERS FOR THIS 
*         PROCESS TO WORK CORRECTLY.
* 
* /---   BLOCK      TESTBIN    00 000   79/07/23  21.37 
* 
          ENTRY  TESTBIN
 TESTBIN  EQ     *
          SA1    B1+1        GET FILE NAME
          SA2    BINFLAG
          NZ     X2,TNOBIN
          SA2    KS0LANG+1   (MUST BE CONDENSED EACH RELOAD)
          BX2    X1-X2       DO NOT CREATE A BINARY FOR 
          ZR     X2,TNOBIN   LESSON SYSLIB
          NG     B2,TSTBN2   CHECK IF NVERSION SUBST DESIRED
          SB2    TBNV        WHERE TO STORE CONVERTED NAME
          CALL   NVERSC      CHECK/CONVERT FOR N-VERSION
          SA1    TBNV+1      (X1) = CONVERTED FILE NAME 
 TSTBN2   BSS    0
* 
*         CHECK IF FILE EXISTS AND OBTAIN FILE INFO WORD
* 
          CALL   FINDFN 
          NG     X7,TNOBIN   --- EXIT IF NOT FOUND
          SA1    FITS+X7
          IX0    X1+X6       INDEX TO FILE INFO WORD
          RX2    X0          (-RXX- 1 WD READ, MAY CHG *A2*)
* 
* * *     SAVE TOP 4 CHARACTERS OF PACK NAME ON WHICH 
*         THE LESSON SOURCE RESIDES.
          SA1    X7+PNAMES   LOAD PACK NAME 
          MX0    24 
          BX6    X0*X1       SAVE TOP 4 CHAR. OF PACKNAME 
          SA6    ITEMP1      SAVE FOR LATER USE 
* 
* * *     ISOLATE FILE SPACE NUMBER OF SOURCE FILE
          MX0    -15
          BX6    -X0*X2      EXTRACT FILE SPACE NUMBER
          SA6    ITEMP
* 
* * *     CONVERT FILE SPACE NUMBER TO DISPLAY CODE 
          CALL   TITOA,ITEMP,ITEMP
* 
* * *     LEFT JUSTIFY CONVERTED FILE SPACE NUMBER
          SA1    ITEMP
          CALL   LJUST,(1R ),0
* 
* * *     MERGE SPACE NUMBER AND 4 CHARACTERS OF PACKNAME 
          AX1    30 
          MX6    30 
          BX6    -X6*X1      BE SURE TOP 5 CHARS CLEAR
          SA1    ITEMP1      GET 4 PACKNAME CHARACTERS
          LX1    54 
          SA2    =1LB 
          BX2    X1+X2       MERGE B AND PACKNAME CHARS 
          BX6    X2+X6       MERGE WITH FILE SPACE NUMBER 
          EQ     TESTBIN
* 
 TNOBIN   MX6    0           MARK NO BINARY 
          EQ     TESTBIN
 
 TBNV     BSS    2           BUFFER FOR N-VERSION NAME
* 
* 
          ENTRY  BINFLAG
* 
 BINFLAG  DATA   0
* /---   BLOCK      +NVERSC    00 000   78/11/14  14.33 
          TITLE  NVERSC      N-VERSION CONVERSION 
          TITLE  NVERSC     CHECK FOR N-VERSION SUBSTITUTION
**        NVERSC - N-VERSION SUBSTITUTION CHECKS
* 
*         CONVERT INPUT FILE NAME TO N-VERSION FILE NAME IF 
*         1) THE CURRENT SYSTEM IS A DEVELOPENT SYSTEM
*         2) THE FILE IS FOUND IN THE N-VER SUBST. LIST AND 
*         3) SUBSTITUTION IS NOT INHIBITED FOR THE FILE.
* 
*         EMPLOYS A BINARY CHOP SEARCH IN A SORTED LIST 
*         WITH MULTIPLE WORD ENTRIES WHICH MAY BE POSITIVE
*         OR NEGATIVE (COMPRESSED PLATO FILE NAMES).
* 
*         SEE LESSON *PSCM* FOR ADDITIONAL INFORMATION. 
* 
*         ENTRY  (B1) = ADDR OF 2-WORD FILE NAME (INPUT). 
*                (B2) = ADDR OF 2-WORD FILE NAME (OUTPUT).
* 
*         EXIT   OUTPUT FILE NAME IN ADDR SPECIFIED BY (B2) 
*                (SAME AS INPUT FILE IF NO SUBSTITUTION). 
* 
*         USES   X - 0, 1, 2, 3, 4, 6, 7. 
*                A - 0, 1, 2, 3, 6. 
*                B - 1, 2.
* 
*         CALLS  FSQUISH, FEXPAND.
* 
          ENTRY  NVERSC 
 NVERSC   EQ     *
*  COPY ORIGINAL NAME TO OUTPUT FOR NO SUBSTITUTION COND. 
          SA2    B1          (X2) = ACCOUNT NAME
          SA1    B1+1        (X1) = FILE NAME 
          BX6    X2 
          SA6    B2 
          BX6    X1 
          SA6    B2+1 
 
          SA2    DEVSYS      CHECK IF DEVELOPMENT SYSTEM
          ZR     X2,NVERSC   -- NOT DEV SYSTEM, NO SUBST. 
          SX2    NVERS       *NVERS* FLAG 
          ZR     X2,NVERSC   -- *NVERS* OFF, NO SUBST.
          SX6    B2+0        SAVE RETURN BUFFER ADDRESS 
          SA6    NVRB 
* 
          CALL   FSQUISH     (X1) = 1-WORD FILE NAME
          SA2    ASCMTAB     (X2) = EM ADDR OF N-VERS TABLE 
          ZR     X2,NVERSC   -- NO N-VERS TABLE 
          SX0    SCM.B-1     OFFSET TO LIST LENGTH IN HEADER
          IX0    X2+X0       COMPUTE EM ADDR
          SX4    SCM.L       MAXIMUM LENGTH OF LIST 
          RX3    X0          (-RXX- 1 WD READ, MAY CHG *A3*)
          IX4    X4-X3       COMPARE WITH CURRENT 
          NG     X4,NVERSC   -- ERROR IN LIST LENGTH
          SB1    1           (B1) = CONSTANT 1
          SX6    B1+0        INCR EM ADDR PAST LIST LTH CELL
          IX2    X0+X6       (X2) = EM ADDR OF N-VERS LIST
          BX6    X2          (X6) = COPY OF X2 INITIALLY
          EQ     HALF1       -- START SEARCH
* 
* /---   BLOCK      +NVERSC    00 000   78/11/13  18.41 
*  BINARY CHOP SEARCH FOR MULTI-WORD ENTRIES
*         X1 = TARGET 
*         X2 = EM ADDR OF SORTED LIST 
*         X3 = LENGTH OF LIST (IN ENTRIES)
*         COULD KEEP LTH IN X4 IF X5 USED FOR COMPARE 
* 
 HALF2    SX4    3           X4 = ENTRY SIZE
          IX6    X0+X4       ADVANCE BASE POINTER 
          SX7    B1          X7 = 1 
          NG     B2,HALF1    CONTINUE SEARCH IF LTH IS ODD
          IX3    X3-X7       REDUCE LENGTH BY 1 IF EVEN 
* 
 HALF1    ZR     X3,NVERSC   -- NO MORE TO SEARCH, NOT FOUND
          SX4    3           X4 = ENTRY SIZE
          AX7    X3,B1       DIVIDE LENGTH BY 2 
          IX0    X7*X4       INDEX * ENTRY SIZE 
          IX0    X6+X0       COMPUTE EM ADDRESS 
          LX3    17          MOVE ODD/EVEN TO 18TH BIT
          RX3    X0          (-RXX- 1 WD READ, MAY CHG *A3*)
          SB2    X3          B2 IS NEG IF LTH WAS ODD 
          IX4    X1-X3       TEST AGAINST TARGET WORD 
          BX3    X7          X3 = LENGTH REMAINING
          NG     X4,HALF1    -- JUMP, IN FIRST HALF 
          NZ     X4,HALF2    -- JUMP, IN SECOND HALF
* 
*  X0 = ECS ADDR OF ENTRY 
* 
          SX2    2
          IX0    X0+X2       EM ADDR OF SUBST INFO WORD 
          MX2    2           MASK INHIBIT-SUBST. BITS 
          RX3    X0          (-RXX- 1 WD READ, MAY CHG *A3*)
          BX2    X2*X3       MASK OFF INHI-BITS 
          NZ     X2,NVERSC   -- IF EITHER INHIBIT BIT SET 
          SX2    B1          (X2) = 1 
          IX0    X0-X2       EM ADDR OF N-VERS FILE NAME
          RX1    X0          (-RXX- 1 WD READ, MAY CHG *A1*)
          BX6    X1 
          SA2    NVRB        GET RETURN BUFFER ADDRESS
          SA6    X2+B1       STORE FILE NAME IN RETURN BUFF 
          SB1    X2          (B1) = RETURN BUFFER ADDRESS 
          CALL   FEXPAND     CONVERT TO 2-WORD NAME 
          EQ     NVERSC      -- EXIT
* 
 TEMP     BSSZ   1           EM READ BUFFER 
 
 NVRB     BSS    1           SAVED RETURN BUFFER ADDRESS
* 
* 
* /---   BLOCK      BINSUM     00 000   85/03/31  09.54 
          TITLE  -BINSUM-    SUM-CHECK FOR BINARY 
* 
* 
* 
*         -BINSUM-           FORMS SUM-CHECK OF BINARY
* 
*         ON ENTRY -  B1 = ADDRESS OF ECS ADDRESS OF BINARY 
*                     B2 = ADDRESS OF NUMBER OF BLOCKS
*                          (WITH NEW FORMAT FLAG IN SIGNBIT)
* 
*         ON RETURN -  X6 = SUM 
* 
* 
 BINSUM   EQ     *
          SA1    B1          BEGINNING ADDRESS OF BINARY
          BX0    X1 
          SA1    B2          NUMBER OF BLOCKS TO PROCESS
          SB1    X1-1 
          SX3    BLKLTH      INCREMENT TO NEXT BLOCK
          RX1    X0          (-RXX- 1 WD READ, MAY CHG *A1*)
          SX6    X1          LENGTH OF LESSON 
          AX1    18 
          SX1    X1          LENGTH OF *ULOC* TABLE 
          IX6    X6+X1
          SX1    B1          COMPUTE LENGTH OF LAST (PARTIAL) BLOCK 
          IX1    X1*X3
          IX6    X6-X1
          SA6    BINSUMA
          SA1    66B         (X1) = LWA OF TABLES (FL)
          SX6    X1 
          NG     B1,BINSUM
* 
          SA0    INFO 
 BLP      SB1    B1-1        END TEST 
          NG     B1,BINSUM
+         RE     BLKLTH      READ NEXT BLOCK OF BINARY
          RJ     ECSPRTY
          SB2    BLKLTH-1 
          NZ     B1,BLP10    IF NOT LAST BLOCK
          SA1    BINSUMA     GET PARTIAL BLOCK LENGTH 
          SB2    X1-1 
          NG     B2,BINSUM   IF NOTHING IN LAST BLOCK 
* 
 BLP10    SA2    B2+INFO     LOAD NEXT WORD OF BLOCK
          SB2    B2-4 
          IX6    X2+X6       ADD TO SUM 
          PL     B2,BLP10    LOOP THROUGH ENTIRE BLOCK
* 
          IX0    X0+X3       ADVANCE ECS ADDR TO NEXT BLOCK 
          EQ     BLP         PROCESS NEXT BLOCK 
 
 BINSUMA  BSS    1           LENGTH OF LAST (PARTIAL) BLOCK 
* 
* 
* /---   BLOCK      LOADBIN    00 000   80/01/18  21.27 
          TITLE  -LOADBIN-   LOAD BINARY FROM DISK
* 
* 
* 
*         -LOADBIN- 
*         LOAD BINARY OF LESSON FROM DISK 
* 
*         ON ENTRY -
*         IODATA + 0  = BINARY FILE NAME
*         DACT IS ASSUMED ALREADY RESERVED
* 
*         ON RETURN -  *NERROR* = 0  IF NO ERROR
*                                -1  IF BINARY NOT LOADED 
* 
* 
          ENTRY  LOADBIN
 LOADBIN  EQ     *
          CALL   BSLICE      CHECK FOR END OF TIME-SLICE
* 
*         LOCATE FILE AND SET DISK UNIT AND FILE INFO WORD
* 
          SA1    IODATA 
          CALL   FINDFN      CHECK IF FILE EXISTS 
          NG     X7,NOGO
          SA7    SDISKU      SET DISK UNIT NUMBER 
          SA7    TDISKU 
          SA1    X7+FITS
          IX0    X1+X6       INDEX TO FILE INFO WORD
          SA0    SFINF
+         RE     1           READ FILE INFO WORD
          RJ     ECSPRTY
          SA1    A0          SAVE FILE INFO WORD
          MX0    -6 
          BX6    X1 
          AX1    30 
          SA6    BFINF
          BX1    -X0*X1      MASK OFF FILE TYPE CODE
          SX0    X1-2 
          NZ     X0,NOGO     MUST BE = 2 = BINARY FILE
* 
*         READ DIRECTORY BLOCK OF BINARY
* 
          SA1    ADISKEC
          BX6    X1          SET ECS ADDRESS FOR DISK READ
          SA6    SECS 
          MX1    0           SET FOR DIRECTORY BLOCK
          SX2    1           SET NUMBER OF BLOCKS TO READ 
          SX3    1           SET TO READ DISK 
          CALL   ODISKIO,SDBATTS      READ DIRECTORY BLOCK
          SA1    NERROR 
          NZ     X1,BINERR1  EXIT IF DISK ERROR 
* 
* /---   BLOCK      LOADBIN    00 000   80/01/18  21.27 
* 
*         BRING DIRECTORY BLOCK TO CM AND CHECK VALIDITY
* 
          SA1    ADISKEC     ECS ADDRESS OF DIRECTORY 
          BX0    X1 
          SA0    DIRCTRY
+         RE     BLKLTH      READ DIRECTORY TO CM 
          RJ     ECSPRTY
          SA1    DIRCTRY     CHECK THAT FILE NAME CORRECT 
          SA2    IODATA 
          BX0    X1-X2
          NZ     X0,BINERR3  EXIT IF FILE NAME BAD
          SA1    DIRCTRY+1
          SA2    =10LBINARY   B 
          BX0    X1-X2       CHECK THAT FILE TYPE CORRECT 
          NZ     X0,BINERR3 
          SA1    BDATE       DATE OF PLATO VERSION OF BINARY
          SA2    EDDATE      DATE OF THIS VERSION OF PLATO
          BX1    X1-X2
          NZ     X1,LBAD     EXIT IF WRONG DATE 
          SA1    BTIME
          SA2    EDTIME      CHECK TIME ALSO
          BX1    X1-X2
          NZ     X1,LBAD
          SA1    SYSCHK      CHECK FOR CONFIG FILE CHANGES
          SA2    BSYSCHK
          BX1    X1-X2       VERIFY NO SYS VARIABLES CHANGED
          NZ     X1,LBAD     IF SYS VARIABLES CHANGED 
 
*         SAVE USE FILE INFORMATION 
 
          SA1    ATEMPEC
          SA0    BUSEINF
          BX0    X1 
          WE     USEINFL
          RJ     ECSPRTY
          SA0    USEINF2
          RE     USEINFL
          RJ     ECSPRTY
          SA1    BSUMCHK     SAVE SUMCHECK / BLOCKS NEEDED
          SA2    DIRCTRY+3
          BX6    X1 
          BX7    X2 
          SA6    TBSCHK 
          SA7    TBLKS
          CALL   ACCUSE,A0   ISSUE ACCOUTING MESSAGES 
* /---   BLOCK      LOADBIN    00 000   80/01/18  21.27 
 
*         VERIFY USE FILES HAVE NOT BEEN EDITED 
 
 LBN1     SA1    USEINF2
          ZR     X1,LBN10    IF NO MORE USE FILES 
          SX6    X1-1 
          SA6    A1          UPDATE COUNT OF FILES LEFT 
* 
*         LOCATE USE FILE AND SET DISK INFO WORDS 
* 
          LX6    2           MULTIPLY BY 4
          SA1    USEINF2+1+1+X6 
          CALL   FINDFN      CHECK IF FILE EXISTS 
          NG     X7,LBAD
          SA7    SDISKU      SET DISK UNIT NUMBER 
          SA1    X7+FITS
          IX0    X1+X6       INDEX TO FILE INFO WORD
          SA0    SFINF
+         RE     1           READ FILE INFO WORD
          RJ     ECSPRTY
* 
*         READ DIRECTORY BLOCK OF USE FILE
* 
          SA1    ADISKEC
          BX6    X1          SET ECS ADDRESS FOR DISK READ
          SA6    SECS 
          MX1    0           SET FOR DIRECTORY BLOCK
          SX2    1           SET NUMBER OF BLOCKS TO READ 
          SX3    X2          SET TO READ DISK  (1)
          CALL   ODISKIO,SDBATTS      READ DIRECTORY BLOCK
          SA1    NERROR 
          NZ     X1,BINERR1  EXIT IF DISK ERROR 
* 
*         CHECK LAST EDIT DATE AND TIME OF USE FILE 
* 
          SA1    ADISKEC     ECS ADDRESS OF DIRECTORY 
          BX0    X1 
          SA0    DIRCTRY
          RE     BLKLTH      READ DIRECTORY BLOCK TO CM 
          RJ     ECSPRTY
* 
          SX1    DIRCTRY+4   X1 = BIAS TO BASE OF INFO
          SA2    X1+O.LDATE  X2 = LAST EDIT DATE
          SA3    X1+O.LTIME  X3 = LAST EDIT TIME
          SA1    USEINF2
          LX1    2           MULTIPLY BY 4
          SA4    USEINF2+1+2+X1 LAST EDIT DATE
          BX4    X4-X2
          NZ     X4,LBAD     IF USE FILE EDITED 
          SA4    USEINF2+1+3+X1 LAST EDIT TIME
          BX4    X4-X3
          NZ     X4,LBAD     IF USE FILE EDITED 
          EQ     LBN1        CHECK NEXT USE FILE
* /---   BLOCK      LOADBIN    00 000   80/01/18  21.27 
* 
*         READ REST OF BINARY FILE TO ECS 
* 
 LBN10    SA1    TBLKS       NUMBER OF BLOCKS USED
          PL     X1,BINERR3  MUST BE NEW FORMAT FILE
          SX2    X1 
          NG     X2,BINERR3  CHECK NUMBER BLOCKS REASONABLE 
          ZR     X2,BINERR3 
          SX1    X2-BMAXB-1  CHECK IF BINARY TOO LONG 
          PL     X1,BINERR3 
          SX6    X2          SAVE NUMBER OF BLOCKS
          SA6    I1 
          CALL   GECS        GET ECS FOR BINARY 
          NG     X6,LBNOEM   -- IF NOT ENOUGH EM
          NZ     X6,NOGO     IF LESSON JUST CONDENSED 
          SA1    TDISKU      SET TO BINARY FILE 
          SA2    BFINF
          BX6    X1 
          BX7    X2 
          SA6    SDISKU 
          SA7    SFINF
          SA1    ABINBUF
          SX6    LPRMLTH
          IX6    X1+X6       (X6) = FWA TO LOAD BINARY
          SA6    I2 
          SA6    SECS 
          SX1    1           SET TO BEGIN READ AT BLOCK 1 
          SA2    I1          (X2) = NUMBER OF BLOCKS TO READ
          SX3    1           SET FOR DISK READ
          CALL   ODISKIO,SDBATTS     BRING IN REST OF BINARY
          SA1    NERROR 
          NZ     X1,BINERR1  EXIT IF DISK ERROR 
* 
*         PERFORM SUM-CHECK ON BINARY 
* 
          CALL   BINSUM,I2,TBLKS
          SA1    TBSCHK 
          BX0    X1-X6
          NZ     X0,BINERR2 
          CALL   CBL         COMPLETE BINARY LOAD 
 
*         VERIFY LESSON NAME IN LESSON HEADER 
 
          SA1    ABINBUF
          SX0    LLESNAM
          IX0    X1+X0
          RX1    X0          READ LESSON NAME 
          SA2    TBLESSN
          BX2    X1-X2
          NZ     X2,BINERR3 
* /---   BLOCK      LOADBIN    00 000   80/01/18  21.27 
* 
 LOADOK   SA1    BINST3 
          SX6    X1+1        NUMBER OF BINARIES LOADED
          SA6    A1 
          EQ     LOADBIN
* 
 LBNOEM   BSS    0
          SA1    OPTION      CONDENSE TYPE
          SX1    X1-4        CHECK FOR SYSLIB CALL
          ZR     X1,SLIBERR  -- RETURN TO SYSLIB ERR PROC 
          EQ     NOECS       -- ELSE, FATAL LESSON ERROR
* 
 BINERR1  SB1    B1ERR       *BINARY READ ERROR*
          EQ     BINERR 
* 
 BINERR2  BX1    X6          X1 = BAD SUM-CHECK 
          CALL   FSTOTOA
          SA6    B2ERR3      STORE 1ST 10 DIGITS
          SA7    A6+1        STORE 2ND 10 DIGITS
          CALL   S=MSG,B2ERR1 
          SA1    TBLESSN
          CALL   LJUST,(0),(1R )
          BX6    X1          SET LESSON NAME
          SA6    B2ERR2 
          SA1    IODATA 
          CALL   LJUST,(0),(1R )
          BX6    X1          SET BINARY FILE NAME 
          SA6    B2ERR2+1 
          CALL   S=MSG,B2ERR2 
          SA1    TBSCHK      (X1) = ORIGINAL SUMCHECK 
          CALL   FSTOTOA
          SA6    B2ERR2      STORE 1ST 10 DIGITS
          SA7    A6+1        STORE 2ND 10 DIGITS
          CALL   S=MSG,B2ERR2 
          CALL   S=MSG,B2ERR3 
          EQ     LBAD 
* 
 BINERR3  SB1    B3ERR       *BINARY DIRECTORY BAD* 
 
 BINERR   SA1    TBLESSN     SET LESSON NAME IN MESSAGE 
          BX6    X1 
          SA6    B1+2 
          CALL   S=MSG,B1 
* 
 LBAD     CALL   BSLICE      CHECK FOR END OF TIME-SLICE
          CALL   DELBIN,IODATA
 
*         RELEASE ECS 
 
          SA1    ABINBUF     CHECK IF ANY BUFFER
          ZR     X1,NOGO     IF NO BUFFER 
          SA0    LHBUFF      CLEAR UP LESSON HEADER 
          BX0    X1 
          MX6    0
          RE     LESHEAD     READ THE LESSON HEADER 
          RJ     ECSPRTY
          SA6    LHBUFF+LCOMUSE 
          WE     LESHEAD
          RJ     ECSPRTY
          SA6    ABINBUF     CLEAR BUFFER ADDRESS 
          SA1    ILESUN 
          CALL   DELETE      DELETE THE LESSON
* 
 NOGO     MX6    -1          MARK BINARY NOT LOADED 
          SA6    NERROR 
          EQ     LOADBIN
* 
 BINERR4  SB1    B4ERR       *BINARY TRUNCATED* 
          EQ     BINERR 
* 
* 
 B1ERR    DATA   20HBINARY READ ERROR - 
          DATA   0,0
 
 B2ERR1   DIS    ,*BINARY SUMCHECK ERROR* 
 B2ERR2   BSSZ   3
 B2ERR3   BSSZ   3
 
 I1       EQU    B2ERR2      TEMPORARY
 I2       EQU    B2ERR2+1 
 BFINF    EQU    B2ERR2+2    BINARY FILE INFO WORD
* 
 B3ERR    DATA   20HBINARY DIRECT BAD - 
          DATA   0,0
* 
 B4ERR    DATA   20HBINARY TRUNCATED -- 
          DATA   0,0
 
 
          ENTRY  USEINF1,USEINF2
 USEINF1  BSS    USEINFL     USE FILE INFO FROM CONDENSOR 
* /---   BLOCK      LOADBIN    00 000   80/01/18  21.27 
 USEINF2  BSS    USEINFL     USE FILE INFO FROM BINARY
 
* /---   BLOCK      GECS       00 000   80/01/18  21.27 
 GECS     SPACE  5,11 
***       GECS - GET ECS FOR BINARY LOAD
* 
*         ENTRY - (X2) - LENGTH OF BINARY IN BLOCKS 
* 
*         EXIT  - (X6) - 0 IF ECS ACQUIRED
*                        1 IF LESSON JUST CONDENSED 
*                       -1 IF NO ECS AVAILABLE
*                 (ABINBUF) - ADDRESS OF BUFFER 
 
 
 GECS1    SX6    1           LESSON JUST CONDENSED
 
 GECS     PS
          SX6    5           INITIALIZE ECS ATTEMPT COUNTER 
          SA6    GECSA
          SX7    BLKLTH      COMPUTE AMOUNT OF ECS NEEDED 
          IX7    X2*X7
          SX7    X7+LPRMLTH  ACCOUNT FOR LESSON HEADER
          SA7    GECSB
* 
*         CHECK IF LESSON HAS JUST BEEN CONDENSED 
* 
 GECS2    CALL   FINDLES,TBLESUN,ILESUN 
          SA1    ILESUN 
          PL     X1,GECS1    IF LESSON NOW CONDENSED
          ZR     X6,GECS1    IF NOW CONDENSING
* 
*         SET UP ECS AREA FOR LESSON
* 
          INTLOK X,I.SIGN,W  INTERLOCK CREATION OF LESSON 
          SA1    GECSB
          BX6    X1          SET UP LESSON LENGTH WORD
          SA6    LESINF 
          CALL   GETECS      TRY TO GET THE ECS 
          PL     X7,GECS3 
          SA1    GECSA
          SX6    X1-1        CHECK IF SHOULD GIVE UP
          NG     X6,GECS     EXIT IF NO ECS 
          SA6    A1 
          INTCLR X,I.SIGN 
          TUTIM  1000        PAUSE FOR A WHILE
          EQ     GECS2
* 
 GECS3    CALL   ADDLES,TBLESUN,ILESUN
          CALL   IOLESSN,ILESUN,2000B 
          INTCLR X,I.ADDL    RELEASE LESNAM INTERLOCK 
          INTCLR X,I.SIGN 
          SA1    LESLOC      (X1) = ADDRESS OF ECS BUFFER 
          BX7    X1 
          BX6    X6-X6       SHOW ECS ACQUIRED
          SA7    ABINBUF
          EQ     GECS        EXIT 
 
 GECSA    DATA   0           RE-TRY COUNT TO GET ECS
 GECSB    DATA   0           LENGTH OF ECS GOTTEN 
* /---   BLOCK      CBL        00 000   78/12/18  20.48 
 CBL      SPACE  5,11 
***       CBL - COMPLETE BINARY LOAD
* 
*         MOVE BINARY UP TO ACTUAL BEGINNING OF LESSON
*         RELEASE UNUSED ECS AT END OF LESSON 
*         SET UP LESSON HEADER
 
 
 CBL      PS
          INTLOK X,I.SIGN,W  INTERLOCK CREATION OF LESSON 
          INTLOK X,I.ADDL,W 
          GETX   EMAVL
          GETX   NLESSIN
 
*         MOVE LESSON UP TWO WORDS OVER ACTUAL LESSON HEADER
 
          SA1    ABINBUF     (X1) = TO ADDRESS FOR MOVE 
          SX2    LPRMLTH
          IX2    X1+X2       (X2) = FROM ADDRESS FOR MOVE 
          BX0    X2 
          SA0    LHBUFF      READ LESSON HEADER 
          RE     LESHEAD
          RJ     ECSPRTY
          SA3    A0 
          SX4    X3          (X4) = LENGTH OF LESSON
          AX3    18 
          SX3    X3          (X3) = NO. OF UNITS (ULOC LTH) 
          IX3    X3+X4       (X3) = TOTAL LTH = WDS TO MOVE 
          BX7    X7-X7       (X7) = NO ECS ERROR RECOVERY 
          CALL   MVECS
 
*         SET UP LESSON HEADER
 
          SA1    LHBUFF      SET LESSON NUMBER
          MX6    12 
          LX6    -12
          BX6    -X6*X1      CLEAR LESSON NUMBER FIELD
          SA2    ILESUN      (X2) = LESSON NUMBER 
          LX2    2*18 
          BX6    X2+X6       RESTORE CORRECT LESSON NUMBER
          SA6    A1 
          SA1    LHBUFF+1    SET I/O FLAGS
          MX6    12 
          BX6    -X6*X1      CLEAR ALL I/O FLAGS
          MX1    1
          LX1    -1 
          BX6    X1+X6       SET LESSON CONDENSING I/O FLAG 
          SA6    A1 
 
          MX6    0
          SA6    LHBUFF+LINTLOK   CLEAR LESSON INTERLOCK
 
          ZERO   LHBUFF+LBITTAB,LBITLTH   ZERO STATN BIT TBL
 
          SA0    LHBUFF 
          SA1    ABINBUF
          BX0    X1 
          WE     LESHEAD     WRITE HEADER TO ECS
          RJ     ECSPRTY
 
*         REDUCE LENGTH OF LESSON 
 
          SA1    ABINBUF     SEARCH FOR LESTAB ENTRY
          SA2    ALESTAB
          SA3    NLESSIN
          MX4    -24
          BX4    -X4         (X4) = MASK
* /---   BLOCK      CBL        00 000   79/12/05  11.54 
          CALL   BINCHOP
          PL     X7,*+1S17   IF NOT FOUND 
          SA1    ALESTAB     READ LESTAB ENTRY
          IX0    X1+X6
          RX1    X0          (-RXX- 1 WD READ, MAY CHG *A1*)
          BX6    X1 
          SA6    ITEMP       SAVE *LESTAB* ENTRY FOR LATER
          SA1    LHBUFF      COMPUTE LENGTH OF LESSON 
          SX7    X1          (X7) = LENGTH OF LESSON
          AX1    18 
          SX1    X1          (X1) = NO. OF UNITS = ULOC LTH 
          IX7    X1+X7       (X7) = TOTAL LENGTH OF LESSON
          SA2    GECSB       (X2) = OLD LENGTH OF LESSON
          IX2    X2-X7       (X2) = AMOUNT TO REDUCE
          SX3    X7-LESHEAD 
          NG     X2,BINERR4  IF NOT REASONABLE
          NG     X3,*+1S17
          SA4    EMAVL       (X4) = AVAILABLE ECS 
          IX6    X4+X2
          SA6    A4 
          SA1    ITEMP       (X1) = LESTAB ENTRY
          LX2    24          INCREMENT AMOUNT OF FREE SPACE 
          IX6    X2+X1
          WX6    X0         (-WXX- 1 WD WRITE, MAY CHG *A6*)
          REPLAX EMAVL
          INTCLR X,I.SIGN 
          INTCLR X,I.ADDL 
          BX6    X6-X6       CLEAR ORIGINAL ECS LENGTH
          SA6    GECSB
          EQ     CBL         EXIT 
* 
* /---   BLOCK      BSLICE     00 000   80/04/22  01.12 
* 
* 
*         BSLICE             CHECK FOR END OF TIME-SLICE
*         CHECK IF TIME-SLICE UP - INTERRUPT IF SO
*         ASSUMES RJ TRAIL PROTECTED BY *DACT*
* 
 BSLICE   EQ     *
          SA1    XSLCLOK     GET RUNNING MSEC CLOCK 
          SA2    MAXCLOK     GET END OF TIME-SLICE
          IX2    X1-X2
          NG     X2,BSLICE   CHECK IF TIME-SLICE OVER 
          TUTIM  10          INTERRUPT BRIEFLY
          EQ     BSLICE 
* 
* /---   BLOCK      MAKEBIN    00 000   79/01/04  23.58 
          TITLE  MAKEBIN   CREATE A BINARY FILE 
* 
*         MAKEBIN 
* 
*         CREATES A BINARY FILE AND WRITES OUT LESSON BINARY
* 
*         ON ENTRY -
*         IODATA + 0  = BINARY FILE NAME
*                + 1  = ECS ADDRESS OF BINARY 
*         DACT IS ASSUMED ALREADY RESERVED
* 
*         ON RETURN - 
*         NERROR  = 1  BINARY ALREADY EXISTS
*                   0  BINARY CREATED 
*                  -1  BINARY NOT CREATED 
* 
* 
          ENTRY  MAKEBIN
 MAKEBIN  EQ     *
          CALL   BSLICE      CHECK FOR END OF TIME-SLICE
* 
 MB120    SA1    IODATA      CHECK IF FILE ALREADY EXISTS 
          CALL   FINDFN 
          PL     X7,ISBIN    EXIT IF ALREADY A BINARY 
* 
*         COMPUTE NUMBER OF BLOCKS REQUIRED FOR BINARY
* 
          SA1    IODATA+1    ECS ADDRESS OF BINARY
          BX0    X1 
          SA0    LHBUFF 
+         RE     LESHEAD     READ LESSON HEADER 
          RJ     ECSPRTY
          SA1    A0 
          SB1    X1          COMPUTE TOTAL LENGTH OF BINARY 
          AX1    18 
          SX1    X1+B1
          SX1    X1-1        LENGTH-1 
          NG     X1,NOBIN    EXIT IF NOTHING THERE
          PX2    X1 
          SX3    BLKLTH      LENGTH OF A BLOCK
          PX3    X3 
          NX3    X3 
          FX1    X2/X3       (NUMBER OF BLOCKS - 1) NEEDED
          UX1    X1,B1
          LX1    X1,B1
          SX2    X1-BMAXB    CHECK AGAINST MAXIMUM
          PL     X2,NOBIN    EXIT IF TOO MANY NEEDED
          SX6    X1+1 
          SA6    BNBLKS      SAVE NUMBER OF BLOCKS NEEDED 
* /---   BLOCK      MAKEBIN    00 000   76/10/10  13.30 
* 
*         COMPUTE NUMBER OF FILE SPACES REQUIRED
* 
          PX1    X6          BLOCKS - 1 (DIRECTORY BLOCK NOT COUNTED) 
          SX2    DSBLKS      BLOCKS PER FILE SPACE
          PX2    X2 
          NX2    X2 
          FX1    X1/X2       (FILE SPACES - 1) NEEDED 
          UX1    X1,B1
          LX1    X1,B1
          SX6    X1+1 
          SA6    BNSPACE     SAVE NUMBER OF SPACES NEEDED 
* 
*         FIND DISK FOR BINARY
* 
          CALL   PCHOOSE     PICK A PACK TO PUT BINARY ON 
          NG     X6,NOBIN    EXIT IF NOWHERE TO PUT IT
          SA6    TDISKU      SET DISK UNIT NUMBER 
          SA6    SDISKU 
          SA1    PNAMES+X6
          BX7    X1          SET PACK NAME
          SA7    TPNAME 
* /---   BLOCK      MAKEBIN    00 000   79/01/05  00.55 
* 
*         CREATE DISK FILE FOR BINARY 
* 
          SA1    IODATA 
          BX6    X1          SET FILE NAME
          SA6    OVARG1 
          SA1    BNSPACE
          SX6    200B        SET FILE TYPE AND LENGTH 
          BX6    X1+X6
          SA6    OVARG2 
          INTLOK X,I.DDIR,W  INTERLOCK DISK DIRECTORIES 
          CALL   S=UDSKR     READ  DISK SYSTEM PARAMETERS 
          EXEC   EXEC4,ALLOCOV
          CALL   S=UDSKW     WRITE DISK SYSTEM PARAMETERS 
          INTCLR X,I.DDIR    RELEASE INTERLOCK
          SA1    TERROR 
          PL     X1,NOBIN    EXIT IF UNABLE TO ALLOCATE 
          SA1    IODATA      LOAD FILE NAME 
          CALL   FINDFN 
          NG     X7,NOBIN    EXIT IF NO FILE
          SA7    SDISKU      RE-SET UNIT NUMBER 
          SA1    FITS+X7
          IX0    X1+X6       INDEX TO FILE INFO WORD
          SA0    SFINF
+         RE     1           READ FILE INFO WORD
          RJ     ECSPRTY
          SA1    A0 
          BX6    X1          SET FILE INFO WORD 
          SA6    TFINFO 
          TUTIM  10          FORCE END OF TIME-SLICE
          CALL   PACKWRT     CHECKPOINT PACK DIRECTORY
* 
* /---   BLOCK      MAKEBIN    00 000   78/12/18  20.49 
* 
*         INITIALIZE DIRECTORY BLOCK
* 
          ZERO   DIRCTRY,BLKLTH   PRE-ZERO DIRECTORY
          SA1    IODATA 
          BX6    X1 
          SA6    DIRCTRY     SET BINARY FILE NAME 
          SA1    =10LBINARY   B 
          BX6    X1 
          SA6    DIRCTRY+1   SET FILE TYPE
          SA1    BNSPACE     FILE SPACES NEEDED 
          SX2    DSBLKS      BLOCKS PER DISK FILE SPACE 
          IX6    X1*X2
          SA6    DIRCTRY+2   SET TOTAL NUMBER OF BLOCKS 
          SA1    BNBLKS 
          MX6    1           FLAG FOR NEW FORMAT FILE 
          BX6    X1+X6       MERGE WITH BLOCK COUNT 
          SA6    DIRCTRY+3   SET LAST BLOCK USED
          CALL   BINSUM,(IODATA+1),BNBLKS 
          SA6    BSUMCHK     SET SUM CHECK
          SA1    EDDATE 
          BX6    X1          SET DATE OF THIS PLATO VERSION 
          SA6    BDATE
          SA1    EDTIME 
          BX6    X1          SET TIME OF THIS PLATO VERSION 
          SA6    BTIME
          CALL   S=TDATE,ITEMP   GET DATE BINARY CREATED
          SA1    ITEMP+1
          BX6    X1          SET DATE 
          SA6    BCDATE 
          CALL   JULIAN      JULIAN DATE BINARY CREATED 
          SA6    BJDATE 
          SA1    SYSCHK      SAVE CHECKSUM OF SYS VARIABLES 
          SA2    ATEMPEC     SET USE FILE INFORMATION 
          BX6    X1 
          BX0    X2 
          SA6    BSYSCHK
          SA0    USEINF1
          WE     USEINFL
          RJ     ECSPRTY
          SA0    BUSEINF
          RE     USEINFL
          RJ     ECSPRTY
* 
*         INITIALIZE DIRECTORY BLOCK
* 
          SA4    DIRCTRY+2   BLOCK COUNT
          SX5    BLKLTH 
          LX5    9           POSITION LENGTH OF BLOCK 
          SA1    =6LBINARY
          BX7    X1          SET UP BLOCK NAME
* 
 MAKB100  SX4    X4-1        END TEST 
          NG     X4,MAKB200 
          BX6    X4+X5       MERGE BLOCK NUMBER / LENGTH
          SA6    X4+DIRCTRY+64   SET BLOCK INFO WORD
          SA7    X4+DIRCTRY+192  AND BLOCK NAME 
          EQ     MAKB100
* 
 MAKB200  SA1    ADISKEC     ECS ADDRESS OF DISK BUFFER 
          BX0    X1 
          SA0    DIRCTRY
+         WE     BLKLTH      WRITE DIRECTORY TO ECS 
          RJ     ECSPRTY
* /---   BLOCK      MAKEBIN    00 000   77/06/22  21.22 
* 
*         WRITE BINARY FILE TO DISK 
* 
          SA1    IODATA+1 
          BX6    X1          SET ECS ADDRESS OF BINARY
          SA6    SECS 
          SX1    1           STARTING BLOCK NUMBER
          SA2    BNBLKS      NUMBER OF BLOCKS TO WRITE
          SX3    2           2 = DISK WRITE 
          CALL   ODISKIO,SDBATTS      WRITE BINARY TO DISK
          SA1    NERROR 
          NZ     X1,BFAIL    EXIT IF DISK ERROR 
* 
*         WRITE DIRECTORY BLOCK TO DISK 
* 
          SA1    ADISKEC
          BX6    X1          SET ECS ADDRESS
          SA6    SECS 
          SX1    0           STARTING BLOCK NUMBER
          SX2    1           NUMBER OF BLOCKS TO WRITE
          SX3    2           2 = DISK WRITE 
          CALL   ODISKIO,SDBATTS
          SA1    NERROR 
          NZ     X1,BFAIL    EXIT IF DISK ERROR 
          SA1    BINST1 
          SX6    X1+1        NUMBER OF BINARIES CREATED 
          SA6    A1 
          EQ     MAKEBIN     EXIT 
* 
 ISBIN    SX6    1           MARK ALREADY A BINARY
          SA6    NERROR 
          EQ     MAKEBIN     ERROR EXIT 
* 
 BFAIL    CALL   DESTROY,IODATA 
 NOBIN    SX6    -1          MARK BINARY NOT CREATED
          SA6    NERROR 
          EQ     MAKEBIN     ERROR EXIT 
* 
* 
 BNBLKS   BSS    1           BLOCKS NEEDED FOR BINARY 
 BNSPACE  BSS    1           FILE SPACES
* 
* /---   BLOCK      DELBIN     00 000   77/10/13  05.49 
          TITLE  -DELBIN-    DESTROY BINARY FILE
* 
* 
* 
*         -DELBIN-
*         DESTROYS INDICATED FILE IF IT IS A LESSON BINARY
* 
*         ON ENTRY -  IODATA + 0 = FILE NAME
* 
*         DACT IS ASSUMED ALREADY RESERVED
* 
* 
          ENTRY  DELBIN 
 DELBIN   EQ     *
          SA1    IODATA 
          CALL   FINDFN      CHECK IF FILE EXISTS 
          NG     X7,DELBIN
          SA1    X7+FITS
          IX0    X1+X6       INDEX TO FILE INFO WORD
          SA0    ITEMP
+         RE     1           READ FILE INFO WORD
          RJ     ECSPRTY
          MX0    -6 
          SA1    A0          LOAD FILE INFO WORD
          AX1    30 
          BX1    -X0*X1      MASK OFF FILE TYPE CODE
          SX0    X1-2 
          NZ     X0,DELBIN   MUST BE = 2 = BINARY FILE
          CALL   DESTROY,IODATA 
          SA1    BINST2 
          SX6    X1+1        NUMBER OF BINARIES DESTROYED 
          SA6    A1 
          EQ     DELBIN 
* 
* 
* /---   BLOCK      DESTROY    00 000   77/10/18  02.45 
          TITLE  -DESTROY-   DESTROY A FILE 
* 
* 
* 
*         -DESTROY- 
*         DESTROYS SPECIFIED FILE 
* 
*         ON ENTRY -  B1 = ADDRESS OF FILE NAME 
* 
*         DACT IS ASSUMED ALREADY RESERVED
* 
* 
 DESTROY  EQ     *
          SA1    B1          LOAD FILE NAME 
          BX6    X1 
          SA6    OVARG1 
          CALL   FINDFN      CHECK IF FILE EXISTS 
          NG     X7,DESTROY 
          SA7    TDISKU      SET DISK UNIT NUMBER 
          SA1    X7+FITS
          IX0    X1+X6       INDEX TO FILE INFO WORD
          SA0    TFINFO 
+         RE     1           READ FILE INFO WORD
          RJ     ECSPRTY
          SA1    X7+PNAMES
          BX6    X1          SET PACK NAME
          SA6    TPNAME 
          INTLOK X,I.DDIR,W  INTERLOCK DISK DIRECTORIES 
          CALL   S=UDSKR     READ  DISK SYSTEM PARAMETERS 
          EXEC   EXEC4,DEALLOV
          CALL   S=UDSKW     WRITE DISK SYSTEM PARAMETERS 
          INTCLR X,I.DDIR    RELEASE INTERLOCK
          SA1    TERROR      SEE IF ANY ERROR OCCURRED
          PL     X1,DESTROY 
          CALL   PACKWRT     WRITE PACK DIRECTORY TO DISK 
          EQ     DESTROY
* 
* 
* /---   BLOCK      PACKWRT    00 000   85/11/15  10.19 
          TITLE  PACKWRT   WRITE PACK DIRECTORY TO DISK 
* 
*         PACKWRT 
* 
*         WRITES PACK DIRECTORY SPECIFIED BY *TDISKU* 
* 
*         ON ENTRY -  TDISKU = DISK UNIT NUMBER 
* 
*         DACT IS ASSUMED ALREADY RESERVED
* 
*         ON RETURN -  NERROR = 0  IF ALL OK
*                              -1  IF AN ERROR OCCURRED 
* 
* 
          ENTRY  PACKWRT
 PACKWRT  EQ     *
          MX6    0           INITIALIZE WRITE RE-TRY FLAG 
          SA6    PRETRY 
* 
*         CHECK FOR IMPENDING *MASTOR* REQUEST BUFF OVERFLOW
* 
 PWRT1    CALL   S=MTST      CHECK FOR IMPENDING OVERFLOW 
          NG     X6,PWRT10
          TUTIM  100         ALLOW MASTOR TO CATCH UP 
          EQ     PWRT1
* 
*         SET-UP FOR DISK REQUEST 
* 
 PWRT10   BSS    0
          SA1    TDISKU      (X1) = MASTERFILE NUMBER 
          CALL   SNMFBLK     DETERMINE NUMBER OF DIR BLKS 
          BX2    X1          (X2) = NUMBER OF DIR BLKS IN MF
          SA1    TDISKU      LOAD DISK UNIT 
          SA3    X1+PNAMES
          ZR     X3,PERRX    EXIT IF PACK NOT ACTIVE
          SA3    PDADDR      LOAD DISK ADDRESS OF DIRECTORY 
          SA4    PITS+X1     LOAD ECS ADDRESS OF DIRECTORY
          LX4    36          POSITION ECS ADDRESS 
          LX1    24          POSITION DISK UNIT 
          BX6    X4+X1
          BX6    X6+X3
          SA6    DISKINF     STORE DISK INFORMATION WORD
* 
          SX1    4           4 = NEW DISK WRITE I/O CODE
          SX7    BLKLTH      WORDS PER DISK BLOCK 
          IX7    X2*X7       MULTIPLY BY NUMBER OF BLOCKS 
          LX7    12          POSITION WORD COUNT
          BX7    X7+X1
          SA7    IOSW        SET DISK I/O REQUEST SWITCH
* 
* *       COLLECT DISK STATISTICS 
* 
          CALL   DSKSTAT,IOSW,SDPATTS,=0
* /---   BLOCK      PACKWRT    00 000   85/11/15  10.25 
* 
*         POST DISK REQUEST TO *MASTOR* 
* 
          SA1    DISKINF
          SA2    IOSW 
          CALL   SAVEDI      SAVE INFO IN CASE OF ERROR 
          DISKRQ DISKINF,IOSW 
          SX7    X6+NPPUERR 
          SA7    PIORET      SAVE POSSIBLE ERROR CODE 
          PL     X6,PERRX 
          SA1    POSTED      INCREMENT REQUESTS PENDING 
          SX6    X1+1 
          SA6    A1 
* 
 PWT      TUTIM  -1,,IOKEY   WAIT FOR KEY 
          SA1    KEY
          SX1    X1-IOKEY    CHECK IF I/O COMPLETE
          NZ     X1,PWT 
          SA1    POSTED 
          SX6    X1-1        DECREMENT REQUESTS PENDING 
          SA6    A1 
          SA1    IORET       LOAD I/O RETURN CODE 
          BX6    X1 
          SA6    PIORET      SAVE I/O RETURN CODE 
          SX6    X1-1 
          ZR     X6,PUNLOD   EXIT IF PACK DISMOUNTED
          PL     X6,PERR1    EXIT IF ERROR OCCURRED 
          MX6    0
          SA6    NERROR      MARK NO ERROR
          EQ     PACKWRT
* 
 PERR1    SA1    PRETRY      CHECK IF 1ST OR 2ND TRY
          NZ     X1,PNOGO 
          MX6    -1          MARK SECOND TRY
          SA6    A1 
          EQ     PWRT1       GO TRY TO WRITE DIRECTORY AGAIN
* 
* /---   BLOCK      PACKWRT    00 000   85/11/15  10.25 
* 
*         OUTPUT DAYFILE MESSAGE FOR DISMOUNTED PACK
* 
 PUNLOD   SA1    TDISKU      GET DISK UNIT NUMBER 
          SA2    X1+PTYPES   GET PACK TYPE
          SA3    PDTYPES+3   BINARY 
          IX3    X2-X3       CHECK IF BINARY PACK 
          ZR     X3,PUNL10
          SA3    PDTYPES+1   BACKUP 
          IX3    X2-X3       CHECK IF BACKUP PACK 
          NZ     X3,PNOGO 
* 
 PUNL10   SA1    X1+PNAMES   GET PACK NAME
          BX6    X1 
          SA6    PMSG4+2     PLANT PACK NAME
          CALL   S=MSG,PMSG4       OUTPUT DAYFILE MESSAGE 
          INTLOK X,I.DDIR,W  INTERLOCK DISK PARAMETERS
          CALL   S=UDSKR     READ DISK SYSTEM PARAMETERS
          SA1    TDISKU      GET DISK UNIT NUMBER 
          MX6    0
          SA6    X1+PNAMES   CLEAR PACK NAME
          SA6    X1+PTYPES   CLEAR PACK TYPE
          SA6    X1+PCLOKS   CLEAR TIME OF LAST ORDER CHANGE
          SA6    X1+PMODELS  CLEAR PACK MODEL 
          CALL   S=UDSKW     WRITE DISK SYSTEM PARAMETERS 
          INTCLR X,I.DDIR    RELEASE INTERLOCK
* 
 PERRX    MX6    -1 
          SA6    NERROR      MARK ERROR OCCURRED
          EQ     PACKWRT
* 
* /---   BLOCK      PACKWRT    00 000   85/11/15  10.27 
* 
*         OUTPUT DAYFILE MESSAGE FOR ERROR IN PACK DIRECTORY
* 
 PNOGO    INTLOK X,I.DDIR,W  INTERLOCK DISK PARAMETERS
          CALL   S=WAIT,1000  ALLOW FOR DISK ERR DAYFILE MSG
          CALL   S=MSG,PMSG1
          CALL   S=MSG,PMSG2
          SA1    TDISKU      GET DISK UNIT NUMBER 
          SA1    X1+PNAMES   GET PACK NAME
          CALL   LJUST,0,(1R )   SPACE FILL PACK NAME 
          BX6    X1 
          SA6    PMSG3       STORE PACK NAME
          CALL   TITOA,TDISKU,ITEMP 
          SA1    ITEMP       UNIT NUMBER IN ALPHA FORMAT
          CALL   LJUST,0,(1R )    SPACE FILL UNIT NUMBER
          LX1    60-12       POSITION UNIT NUMBER 
          MX0    -18
          BX6    X0*X1       CLEAR OUT BOTTOM CHARS 
          SA6    PMSG3+1
          CALL   S=MSG,PMSG3
          CALL   S=MSG,PMSG1
          CALL   S=ABORT     ABORT PLATO
* 
* 
 PMSG1    DIS    0,*++++++++++++++++++++++++++* 
* 
 PMSG2    DIS    0,*MF DIRECTORY ERROR* 
* 
 PMSG3    BSS    1
          BSS    1
* 
 PMSG4    DIS    0,*MF TURNED OFF       XXXXXXXXXX* 
* 
* 
 PRETRY   BSS    1
* 
* 
* /---   BLOCK      PCHOOSE    00 000   80/01/12  21.27 
          TITLE  PCHOOSE  CHOOSE PACK TO PUT BINARY ON
* 
* 
*         -PCHOOSE- 
*         THIS ROUTINE FINDS THE BINARY PACK WITH THE MOST
*         FREE SPACE
* 
*         ON RETURN -  X6 = DISK UNIT NUMBER (-1=NONE)
* 
* 
 PCHOOSE  EQ     *
          SX3    2           BIAS TO FREE SPACE TOTAL 
          SA4    PDTYPES+3   BINARY 
          MX7    -1          INITIALIZE MAXIMUM SPACE 
          SA0    PTEMP
          SB1    NDSUS       NUMBER OF DRIVES TO SEARCH 
* 
 PCLP     SB1    B1-1        END TEST 
          NG     B1,PCHK
          SA1    B1+PTYPES   PACK TYPE
          BX0    X1-X4       CHECK FOR *BINARY* PACK
          NZ     X0,PCLP
          SA2    B1+PITS     ECS ADDRESS OF PACK INFO 
          IX0    X2+X3       BIAS TO AMOUNT OF FREE SPACE 
+         RE     2           READ SPACE/FILE LIMIT WORDS
          RJ     ECSPRTY
          SA2    A0 
          SX0    X2          PICK OFF NUMBER OF SPACES USED 
          AX2    18 
          SX2    X2          PICK OFF TOTAL NUMBER OF SPACES
          IX2    X2-X0       X2 = SPACES AVAILABLE
          IX0    X2-X7
          NG     X0,PCLP     CHECK IF MAXIMUM SO FAR
          SA1    A0+1        CHECK FOR FILE LIMIT 
          SX0    X1          (X0) = FILES ON PACK 
          AX1    18 
          SX1    X1          (X1) = MAXIMUM FILES 
          IX0    X0-X1
          PL     X0,PCLP     IF AT FILE LIMIT 
          BX7    X2          SAVE MAX SPACES SO FAR 
          SX6    B1          SAVE DISK UNIT NUMBER
          EQ     PCLP 
* 
 PCHK     SX1    X7-25       CHECK AT LEAST 25 SPACES LEFT
          PL     X1,PCHOOSE        EXIT IF ENOUGH SPACE 
          SX1    X7-5 
          NG     X1,PNO      GIVE UP IF NOT 5 SPACES LEFT 
          SA6    PTEMP       SAVE DISK UNIT 
          CALL   PROSRCH,LHBUFF+LACCNAM 
          SA1    PTEMP       RESTORE UNIT NUMBER
          BX6    X1 
          LX2    ZBLDSHF
          NG     X2,PCHOOSE  IF HIGH PRIORITY 
* 
 PNO      MX6    -1 
          EQ     PCHOOSE     MARK NO SPACE AVAILABLE
* 
* 
 PTEMP    BSS    2
* 
          END