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