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