DISKFIO * /--- FILE TYPE = E * /--- BLOCK IDENT 00 000 77/11/14 19.46 IDENT DISKFIO TITLE VARIOUS DISK FILE I/O COMMANDS * * GET COMMON SYMBOL TABLE * CST *CALL PLASFIP * * /--- BLOCK EXTERNAL 00 000 80/05/18 16.30 EXT LOADOV,WHATSIN EXT SYSTEST EXT ERXUNUS EXT GETARGS EXT ECSPRTY EXT PROCESS,ECSPRTY,CKPROC,NGETVAR,RETPROC EXT ERXROLC WRITING READ-ONLY COMMON EXT ERXRAT NAMESET INTERNAL ERROR EXT ERXBREC EXT ERXOPEN ENTRY ZWKBUFF ZWKBUFF EQU TBINTSV FOR PASSING NEW -ATTACH- FIPS * * /--- BLOCK ATTPAUS 00 000 79/08/05 01.46 * ** -ATTPAUS- SUBROUTINE (INTERRUPTABLE) ** ** INCREMENTS BAD -ATTACH- COUNTER AND PAUSES TO ** HINDER THEFT OF CODEWORDS AND COMPILATION OF ** LESSON NAMES * * THIS PAUSE IS SKIPPED IN FINISH UNITS BUT THE * BAD-ATTACH COUNTER IS INCREMENTED TO PREVENT USE * USE TO SEARCH FOR FILES. * THE PAUSE CANNOT BE USED IN FINISH UNITS WHEN A * BAD ATTACH IS IN A TIGHT LOOP WITH NO EXIT. THIS * WILL CAUSE THE TERMINAL TO HANG UP SINCE THERE ARE * ENOUGH PAUSES TO KEEP TIPS LOW AND THERE WILL BE * NO AUTO-BREAK TO KICK THE USER OUT. ** ** SHOULD BE CALLED WHEN -ATTACH- FAILS ** ** ASSUMES THAT COMMON, STORAGE, KEY, ETC. HAVE ** ALREADY BEEN SAVED AND THAT ALL INTERLOCKS HAVE ** BEEN CLEARED ** ** EXIT ADDRESS IS STORED IN (TBINTSV+4), WHICH IS ** USED BY -ATTACH- TO STORE THE CODEWORD ARGUMENT ** AND NO LONGER NEEDED (FOR OBVIOUS REASONS) ** BY THE TIME THIS ROUTINE IS EXECUTED ** ** DOES NOT RETURN IF STOP1 PRESSED * * /--- BLOCK ATTPAUS 00 000 79/09/02 21.42 ENTRY ATTPAUS * ATTPAUS EQ * * SA1 LESSCM+LSTOUSE CHECK IF SYSTEM LESSON NG X1,ATTPAUS --- EXIT IF SYSTEM LESSON * SA1 TRETURN X1 = *ZRETURN* ZR X1,ATTPAUS1 --- BRIF IF 0 (NO SUCH FILE) * SX1 X1-1 CHECK IF 1 (CODEWORD ERROR) NZ X1,ATTPAUS --- EXIT IF NOT CODEWORD ERROR * ATTPAUS1 SA1 ATTPAUS SAVE EXIT ADDRESS BX6 X1 SA6 RETADDR * SA1 TBADATT X1 = BAD -ATTACH- COUNTER SX6 X1+1 INCREMENT COUNT SA6 A1 UPDATE COUNT AX1 18 SHIFT TIME TO POSITION * SB1 50 B1 = 50 MSEC MINIMUM PENALTY SX2 X6-101 100 FREE BAD -ATTACH-ES NG X2,ATTPAUS3 --- BRIF <= 100 * SX2 X6-100 X2 = NO. OVER LIMIT SX3 25 X2 = MSEC PAUSE/BAD -ATTACH- IX2 X2*X3 X2 = LENGTH OF PAUSE SX3 60000 X3 = MAXIMUM PAUSE IX3 X3-X2 SEE IF PAUSE TOO LARGE PL X3,ATTPAUS2 --- BRIF NOT TOO LARGE SX2 60000 ADJUST ATTPAUS2 IX1 X1+X2 X1 = TIME WHEN PAUSE SHOULD END SA2 SYSCLOK X2 = CURRENT MSEC CLOCK TIME IX1 X1-X2 CHECK IF ENUF TIME PASSED NG X1,ATTPAUS3 --- BRIF ENUF TIME PASSED SB1 B1+X1 ADD DIFFERENCE TO MINIMUM * ATTPAUS3 FINISH ATTPAUS4 IF IN FINISH UNIT TUTIM B1,,,ALLOW PAUSE TO KEEP '7EM HONEST * ATTPAUS4 BSS 0 SA1 TBADATT X1 = BAD -ATTACH- COUNTER MX0 -18 X0 = MASK FOR NO. OF BAD ONES BX1 -X0*X1 X1 = NO. OF BAD -ATTACH-ES SA2 SYSCLOK X2 = CURRENT MSEC CLOCK TIME LX2 18 SHIFT TO POSITION BX6 X1+X2 MERGE TIME AND COUNT SA6 A1 UPDATE COUNTER * STOPCHK --- EXIT IF STOP1 PRESSED * EQ RETADDR --- RETURN * RETADDR EQU TBINTSV+4 STORE EXIT ADDR IN SAME PLACE * /--- BLOCK PARAMETERS 00 000 77/12/16 23.02 TITLE VARIOUS DATA NEEDED FOR DISKFIO ROUTINES * * INACTIVE FILE TABLE EQUATES * IACTFWA VFD 60/TIFFWA INACTIVE FILE TABLE FWA IACTLTH VFD 60/TIFLTH LENGTH OF INACTIVE FILE TABLE IACTWPF EQU TWPF WORDS PER FILE ENTRY * * TEMPLATE LESSON BUFFER NAMES * ENTRY TUTNODE TUTNODE BSSZ 2 DATA 10LTUTOR NODE + VFD 12/10,48/0 ENTRY IOBNAME IOBNAME DATA 0 DATA 10LTUTOR FILE DATA 10LI/O BUFFER + VFD 12/1,48/0 * * LESSON DIRECTORY STRUCTURE * LFNAME EQU INFO+0 LTYPE EQU INFO+1 LBLOCKS EQU INFO+2 EXTRAI EQU INFO+4 LBINF0 EQU INFO+64 LBNAM0 EQU INFO+192 * ** * /--- BLOCK ACTF 00 000 78/02/03 13.07 TITLE -ACTF- ACTIVATE FILE IF IN INACTIVE TABLE * * -ACTF- * * ACTIVATE THE GIVEN FILE. IF IT IS ALREADY * ACTIVE, SIMPLY EXIT. IF IT IS INACTIVE, SWAP * IT WITH THE ACTIVE FILE. IF IT IS NEITHER * ACTIVE NOR INACTIVE, THEN TAKE AN ERROR EXIT. * * ON ENTRY -- B1 = ADDRESS OF ACCOUNT';FILE NAME * EXIT -- X7 = 0 IF FILE IS NOW OPEN/ACTIVE * -1 IF FILE IS NOT OPEN * ENTRY ACTF ACTF EQ * RJ =XFSQUISH (X1) = ONE-WORD NAME * * SEE IF FILE IS CURRENTLY ACTIVE * SA2 TAFNAME CURRENTLY ACTIVE FILE NAME BX7 X1-X2 COMPARE THE TWO NAMES NG X7,ACTF1 IF NO MATCH (BEWARE OF -0) ZR X7,ACTF --- EXIT IF FILE ACTIVE * * SEARCH THE INACTIVE TABLE FOR THE DESIRED FILE * ACTF1 SA2 IACTLTH READ LENGTH OF TABLE SB3 X2 TRANSFER TO B3 SA2 IACTFWA TABLE FWA SA2 X2 PLACE ADDRESS IN A2 SB2 IACTWPF NO. OF WORDS PER FILE ENTRY MX7 -1 PRESET FOR ERROR EXIT IACTLP SB3 B3-1 DECREMENT NUMBER TO SEARCH NG B3,ACTF --- EXIT IF FILE NOT OPEN BX6 X1-X2 COMPARE THE TWO FILE NAMES ZR X6,IACTFND --- BRIF INACTIVE FILE FOUND SA2 A2+B2 INCREMENT TO NEXT ENTRY EQ IACTLP --- LOOP ON NEXT TABLE ENTRY * * INACTIVE FILE FOUND -- SWAP WITH ACTIVE FILE AND EXIT * IACTFND SB1 1 B1 = 1 SA1 TAFNAME FWA OF OPEN FILE BUFFER SWAPLP SB2 B2-B1 ONE LESS WORD TO SWAP NG B2,IACTZN --- BRIF DONE SWAPPING BX6 X1 BX7 X2 SA6 A2 SA7 A1 SA1 A1+B1 LOOK AT NEXT WORDS IN BOTH SA2 A2+B1 EQ SWAPLP --- LOOP AND SWAP ANOTHER * * CLEAR OUT THE CURRENTLY SELECTED NAME * IACTZN CALL CHRMOVE,NONAME,TRECNAM,MAXNCHR MX7 0 FLAG FILE OPEN AND ACTIVE EQ ACTF --- EXIT TO CALLER * ** * /--- BLOCK NEWACTF 00 000 77/12/04 21.03 TITLE -NEWACTF- ASSIGN NEW FILE AS ACTIVE FILE * * -NEWACTF- * * DESIGNATES A FILE AS THE NEW ACTIVE FILE WHILE * PLACING THE PRESENT ACTIVE FILE INTO THE INACTIVE * TABLE. ENTER WITH B1 POINTING TO A *IACTWPF* WORD * PACKAGE CONTAINING FILE INFORMATION OF THE CORRECT * FORMAT. ON EXIT, THE PACKAGE WILL HAVE BEEN * COPIED OVER TO THE ACTIVE FILE PACKAGE IN THE * STUDENT BANK. IF NO SPACE IS LEFT IN THE * INACTIVE TABLE, THE CURRENTLY ACTIVE FILE * WILL BE CLOSED TO MAKE ROOM FOR THE NEW ONE. * * ENTRY (ZWKBUFF - ZWKBUFF+2) = NEW FIP. * * *SAVLES* IS ASSUMED TO BE CALLED ON ENTRY. * ENTRY NEWACTF NEWACTF EQ * LINK NEWACTF * * SEE IF NO FILE CURRENTLY ACTIVE * SB1 ZWKBUFF (B1) = BUFFER FWA SA1 TAFNAME CURRENTLY ACTIVE FILE NAME BX7 X1 NG X7,NACTSRCH IF FILE IS ACTIVE ZR X7,NACTFAKE --- SIMPLY ACTIVATE USER FIP * * SEARCH THE INACTIVE TABLE FOR A CLEAR SLOT * NACTSRCH SA2 IACTLTH GET LENGTH OF IACT TABLE SB3 X2 TRANSFER TO B3 SA2 IACTFWA READ ADDRESS OF IACT TABLE SA2 X2 READ ADDRESS TO A2 SB2 IACTWPF NO. OF WORDS PER FILE ENTRY NACTLP SB3 B3-1 DECREMENT NUMBER TO SEARCH NG B3,IACTOVF --- IACT TABLE FULL NG X2,NACTLP1 IF SLOT IN USE ZR X2,NACTFND --- BRIF INACTIVE 0 SLOT FOUND NACTLP1 SA2 A2+B2 INCREMENT TO NEXT ENTRY EQ NACTLP --- LOOP ON NEXT TABLE ENTRY * * CLEAR SLOT FOUND -- INSERT ACTIVE/INACTIVE FILES AND EXIT * * (A2) = FAW OF INACTIVE SLOT TO RECEIVE ACTIVE FIP * (B1) = FWA OF FIP TO PLACE IN ACTIVE SLOT NACTFND SB3 1 B3 = 1 SA1 TAFNAME FWA OF OPEN FILE BUFFER SA3 B1 FWA OF USER FILE BUFFER XFERLP SB2 B2-B3 ONE LESS WORD TO TRANSFER NG B2,NACTZN --- BRIF DONE TRANSFERRING BX6 X1 BX7 X3 SA6 A2 WRITE OVER INACTIVE FILE ENTRY SA7 A1 WRITE OVER ACTIVE FILE ENTRY SA1 A1+B3 SA2 A2+B3 INCREMENT BUFFER POINTERS SA3 A3+B3 EQ XFERLP --- LOOP AND XFER ANOTHER * * CLEAR OUT THE CURRENTLY SELECTED NAME * NACTZN CALL CHRMOVE,NONAME,TRECNAM,MAXNCHR EQ NEWACTF --- EXIT TO CALLER * /--- BLOCK NEWACTF 00 000 77/12/01 02.58 * * PROCEED TO CLOSE THE ACTIVE FILE * IACTOVF CALL CLSACTF,(0) SB1 ZWKBUFF (B1) = BUFFER FWA EQ NACTSRCH --- TRANSFER BUFFERS * * TRANSFER USER BUFFER TO ACTIVE FILE BUFFER * NACTFAKE SB2 IACTWPF SA2 IACTEMP A2 = DUMMY INACTIVE BUFFER SB1 ZWKBUFF (B1) = BUFFER FWA EQ NACTFND --- TRANSFER BUFFERS IACTEMP BSS IACTWPF TEMPORARY BUFFER * ** * /--- BLOCK CLSACTF 00 000 79/10/04 03.53 TITLE -CLSACTF- CLOSE CURRENTLY ACTIVE FILE * * -CLSACTF- * * CALLS THE APPROPRIATE ROUTINE TO CLOSE AN * ACTIVE FILE. * * THIS ROUTINE WILL ALSO ATTEMPT TO COPY AN * INACTIVE FILE TO THE ACTIVE SLOT AND SHORTEN * THE INACTIVE TABLE IF POSSIBLE. ONLY IF THERE * ARE NO INACTIVE FILES WILL THIS ROUTINE EVER * LEAVE THE ACTIVE SLOT *TAFNAME* ZERO. * * ON ENTRY -- B1 = -1 TO IGNORE CLOSE ERRORS * 0 TO CAUSE EXEC ERRORS * * **** SAVLES IS ASSUMED TO BE CALLED ON ENTRY **** * * WHILE CLOSING FILE NODES, *TBINTSV* IS USED AS * FOLLOWS -- * * 0 - 10 STORED ATTACH PARAMETERS * 11 - 14 FOR SAVING *CLSACTF* RJ TRAIL * 15 - 15 USED BY *DETACHP* * ENTRY CLSACTF CLSACTF EQ * LINK CLSACTF SA1 TAFNAME GET FILE NAME NG X1,CLSACTF1 IF ACTIVE FILE ZR X1,CLSACTF --- EXIT IF NO ACTIVE FILE CLSACTF1 SX1 B1 (X1) = CLOSE ERRORS PARAMETER MX6 1 BX6 X1*X6 SAVE SIGN BIT SA1 KEY BX6 X1+X6 (X6) = 1/ERROR FLAG,41/0,18/KEY SA1 NERROR PRESERVE EXECERR INFO MX2 -18 BX1 -X2*X1 LIMIT TO 18 BITS LX1 18 (X1) = 24/0, 18/NERROR, 18/0 BX6 X1+X6 (X6)=1/EF,23/0,18/NERROR,18/KEY SA6 TBINTSV+15 SAVE STUFF HERE FOR THE MOMENT * SAVE THE RJ TRAIL IN TBINTSV+11 - TBINTSV+14. CALL LINKS,(TBINTSV+11) SB2 B2-5 ONLY ROOM FOR 4 WORDS PL B2,"CRASH" OOPS (USED .GT. 4 WORDS) * MOVE THE PARAMETERS WHICH WERE SAVED TEMPORARILY * IN *TBINTSV+15* (WHICH MAY BE USED BY *DETACHP*) * TO *TBINTSV+14* (THE LAST WORD FOR THE SAVED RJ * TRAIL). IF *LINKS* USED *TBINTSV+14*, IT MUST * CONTAIN A ZERO, WHICH WILL BE RESTORED LATER. SA1 TBINTSV+15 (X1)=1/EF,23/0,18/NERROR,18/KEY BX6 X1 SA6 TBINTSV+14 SAVE OVER LAST WORD OF RJ TRAIL * /--- BLOCK CLSACTF 00 000 80/02/10 02.38 * BEWARE OF STRAY INTERLOCKS -- CLEAR THEM JUST * IN CASE. INTCLR X,I.SIGN RELEASE SIGNIN/SIGNOUT PROCESS INTCLR X,I.DS RELEASE DATASET PROCESS * * BRANCH TO APPROPRIATE FILE CLOSE ROUTINE * AFTJMP "CRASH",DSETCL,TUTCL * * CALL THE DATASET/NAMESET/GROUP CLOSE PROCESSOR * * DSETCL X CLOSEDS,TDSNAME DSETCL CALL CLOSEDS,TDSNAME SA1 TBINTSV+14 (X1)=1/EF,23/0,18/NERROR,18/KEY NG X1,COPYIACT --- BRIF IGNORE CLOSE ERRORS NG X6,COPYIACT --- FILL SPACE WITH INACT FILE ZR X1,ERXOPEN --- BRIF FILE NOT OPEN EQ ERXBREC * * CALL THE TUTOR FILE CLOSE PROCESSOR * * TUTCL X TCLOSE TUTCL CALL TCLOSE SA1 TBINTSV+14 (X1)=1/EF,23/0,18/NERROR,18/KEY NG X1,COPYIACT --- BRIF IGNORE CLOSE ERRORS NG X6,COPYIACT --- FILL SPACE WITH INACT FILE EQ ERXOPEN * /--- BLOCK CLSACTF 00 000 77/12/02 20.36 COPYIACT CALL COPIACT * RESTRJ SA1 TBINTSV+14 (X1)=1/EF,23/0,18/NERROR,18/KEY SX6 X1 MX7 0 SA6 KEY RESTORE *KEY* SA7 A1+ ENSURE LAST WORD OF RJ TRAIL 0 AX1 18 SHIFT SAVED *NERROR* DOWN SX6 X1+ (X6) = SAVED *NERROR* SA6 NERROR RESTORE *NERROR* FOR EXECERR CALL LINKR,(TBINTSV+11) RESTORE RJ TRAIL EQ CLSACTF TITLE -COPIACT- REACTIVATE LAST INACTIVE FILE * * -COPIACT- * * REACTIVATES LAST FILE IN THE OPEN FILE BUFFER. * THIS IS USUALLY THE PREVIOUSLY ACTIVE FILE THAT * IS MADE INACTIVE BY AN ATTEMPT TO ATTACH ANOTHER * FILE. * ENTRY COPIACT COPIACT PS SB1 1 B1 = 1 SB2 IACTWPF NO. OF WORDS PER FILE ENTRY SA1 TAFNAME FWA OF OPEN FILE BUFFER MX7 0 PRECLEAR FOR ZEROING SA7 A1 CLEAR OUT TAFNAME JUST IN CASE * * FIND LAST PHYSICAL INACTIVE SLOT WITH A FILE IN IT * SX0 B2 LENGTH OF A FIP SA2 IACTLTH GET NUMBER OF FIPS SX2 X2-1 SUBTRACT ONE FOR LAST ONE IX0 X0*X2 BIAS INTO TABLE SB3 X0 BECAUSE SA A+X IS ILLEGAL SA2 IACTFWA FWA OF IACT TABLE SA2 X2 READ ADDRESS TO A2 SA2 A2+B3 ADD BIAS INTO TABLE LASTLP NZ X2,COPYLP --- BRIF SOMETHING IN SLOT NG X2,COPYLP SA2 A2-IACTWPF LOOK AT SLOT PREVIOUS SX0 X0-IACTWPF SUBTRACT BIAS FOR LATER PL X0,LASTLP --- LOOP ON NEXT SLOT EQ COPIACT IF ALL DONE COPYLP SB2 B2-B1 ONE LESS WORD TO TRANSFER NG B2,COPIACT IF COPY DONE BX6 X2 * SA6 A1 WRITE OVER ACTIVE FILE ENTRY SA7 A2 CLEAR OUT INACTIVE SLOT SA1 A1+B1 SA2 A2+B1 INCREMENT BUFFER POINTERS EQ COPYLP --- LOOP AND COPY ANOTHER * /--- BLOCK CLSALLF 00 000 80/02/03 05.23 TITLE -CLSALLF- CLOSE ALL ACTIVE/INACTIVE FILES * * -CLSALLF- * * CLOSES ALL FILES WHETHER THEY ARE ACTIVE OR * INACTIVE. NO ERROR RETURNS WILL BE GIVEN ON * BAD CLOSES. * * ENTRY CLSALLF CLSALLF EQ * LINK CLSALLF CALL SAVETB SAVE *TBINTSV* CELLS * * LOOP ON CLOSING ALL INACTIVE FILES IGNORING ERRORS * CLSLOOP CALL CLSACTF,(-1) SA1 TAFNAME READ ACTIVE FILE NAME NG X1,CLSLOOP IF INACTIVE FILE PRESENT NZ X1,CLSLOOP --- BRIF MORE INACTIVE LEFT CALL RESTTB RESTORE *TBINTSV* CELLS EQ CLSALLF --- RETURN TO CALLER * ** * /--- BLOCK TDSINIT 00 000 80/08/19 01.34 * TITLE -TDSINIT- INITIALIZE DATA/NAMESET INFO * * -TDSINIT- * * UNCONDITIONALLY CLEAR OUT INFO PACKETS FOR ALL * ACTIVE AND INACTIVE FILES * ENTRY TDSINIT TDSINIT EQ * SB1 1 SB2 TIFLTH*TWPF+TWPF TOTAL LENGTH OF PACKETS SX6 0 SA0 TAFBUF START OF PACKETS TDSINI1 SB2 B2-B1 DECREMENT COUNTER SA6 A0+B2 ZERO NEXT WORD NZ B2,TDSINI1 --- RELOOP UNTIL DONE EQ TDSINIT --- EXIT * /--- BLOCK FILTYPE 00 000 80/07/18 03.32 TITLE -FILTYPE- GET FILETYPE TO B1 * * -FILTYPE- * * GETS THE FILE TYPE OF THE ACTIVE FILE TO B1 * * ON ENTRY -- SOME FILE IS ACTIVE * EXIT -- B1 = 0 FOR UNRECOGNIZED TYPE * 1 FOR DATASET TYPE * 2 FOR TUTOR TYPE * X1 = 0 (FOR GETVAR) * * DESTROYS A1,X2,X1,B1 (GETVAR CONVENTIONS) * * ENTRY FILTYPE FILTYPE EQ * SB1 B0 PRESET B1 IN CASE OF EXIT SA1 TAFNAME GET ACTIVE FILE NAME NG X1,FILTYP1 IF ACTIVE FILE ZR X1,FILTYPE --- EXIT IF NO ACTIVE FILE FILTYP1 RJ FILTYP2 (X1) = 6-BIT FILE TYPE CODE ZR X1,FILTYPE --- IF NO FILE TYPE SX2 X1-NFTYPES-1 PL X2,NOTYPE --- IF OUT OF RANGE SA1 ATTRTAB+X1 (X1) = FILE TYPE ATTRIBUTE WORD SB1 X1+1 SX1 0 EQ FILTYPE NOTYPE SB1 B0 MX1 0 EQ FILTYPE * * -FILTYP2- * * ISOLATE 6-BIT FILE TYPE TO X1 * ENTRY FILTYP2 FILTYP2 EQ * SA1 TAFNAME GET ACTIVE FILE NAME NG X1,FILTYP3 IF ACTIVE FILE ZR X1,FILTYP2 IF NO FILE FILTYP3 SA1 TAFINF2 READ ATTACHED FILE INFO AX1 18 SHIFT INTO POSITION MX2 -6 FORM 6 BIT FILE TYPE MASK BX1 -X2*X1 MASK TO 6 BITS EQ FILTYP2 * /--- BLOCK READTF 00 000 78/04/29 19.13 TITLE -READTF- READ TUTOR FILE NODE ** * * -READTF- * * ROUTINE TO READ TUTOR FILE NODE TO INFO BUFFER * * ALSO RETURNS THE FOLLOWING PARAMETERS -- * * B1 = 0 IF PARTS OPTION SELECTED * CURRENT NAME BIAS IF NAME OPTION SELECTED * B2 = BIAS OF LAST BLOCK NAME IN FILE * X1 = CURRENT NAME IF ONE IS SELECTED * ENTRY READTF READTF EQ * SA1 TAFINF2 GET ACTIVE FILE INFO CALL READLES,B0,B0 GET ECS FWA OF NODE SX1 TUTHEAD GET STANDARD HEADER LENGTH IX0 X0+X1 BIAS PAST HEADER SA0 INFO READ DIRECTORY TO *INFO* BUFFER RE BLKLTH RJ ECSPRTY MX7 -1 SA7 JJSTORE FLAG *INFO* OVERWRITTEN SA1 LBLOCKS GET NUMBER OF BLOCKS IN FILE SB2 X1-1 ISOLATE MAXIMUM LEGAL BIAS ZEROLP SA1 LBNAM0+B2 GET NEXT BLOCK NAME NZ X1,LASTB --- BRIF LAST BLOCK FOUND NG X1,LASTB --- BRIF LAST BLOCK FOUND SB2 B2-1 EQ ZEROLP --- LOOP UNTIL LAST BLOCK FOUND LASTB SB1 0 PRESET BIAS TO 0 */// */// TRAP PUT IN BY OZZIE ON 78.04.29. */// */// TRAP IF B2 IS ILLEGAL VALUE. THIS WILL HOPEFULLY */// GIVE MORE INFO ABOUT THE CAUSE OF TWO CRASHES */// IN WHICH THE ABOVE READ OF THE TUTOR FILE NODE */// READ 320 WORDS OF ZERO WHILE THE ECS STORAGE */// BUFFER APPEARED TO BE INTACT. THE FORMER CRASHES */// WERE IN ROUTINE -NAMBIAS- AND WERE CAUSED BECAUSE */// B2 WAS NEGATIVE, CAUSING A2 TO BE NEGATIVE IN A */// LOOP. TRAP HERE IF B2 IS INITIALIZED NEGATIVE. */// LT B2,B0,"CRASH" */// SA1 TAFINF1 GET BIAS INFO WORD NG X1,READTF --- EXIT IF PARTS OPTION AX1 36 SHIFT NAME BIAS INTO POSITION SB1 X1 STORE BIAS IN B1 SA1 LBNAM0+B1 GET CURRENT NAME SELECTED EQ READTF --- EXIT TO CALLER * ** * /--- BLOCK NAMBIAS 00 000 79/02/08 02.08 TITLE -NAMBIAS- CALCULATE NAME BIASES ** * * -NAMBIAS- * * THIS ROUTINE, GIVEN THE BIAS TO ANY BLOCK, * WILL RETURN THE BIAS TO THE NAME ASSOCIATED * WITH THAT BLOCK AND THE BIAS TO THE NEXT * SEQUENTIAL NAME. * * ON ENTRY -- B1 = BIAS TO ANY BLOCK NAME * B2 = BIAS TO LAST BLOCK IN FILE * EXIT -- B1 = BIAS TO NAME FOR THAT BLOCK * B2 = SAME AS ON ENTRY * B3 = BIAS TO NEXT SEQUENTIAL NAME * -1 IF NO NEXT SEQUENTIAL NAME * * DESTROYS A1,A2,X0,X1,X2 * ENTRY NAMBIAS NAMBIAS EQ * * * SCAN BACKWARD FOR FIRST BLOCK IN THIS NAME * SA2 LBINF0+B1 READ BLOCK INFO WORD LX2 L.TYPE MX0 -L.TYPEL BX2 -X0*X2 ISOLATE BLOCK TYPE SB3 X2 MOVE BLOCK TYPE TO B3 SB3 B0-B3 COMPLEMENT IT SA1 LBNAM0+B1 GET CURRENT BLOCK NAME ZR X2,BCKLP IGNORE BBLKS IF ITS A SORCE BLK SX0 X2-7 ZR X0,BCKLP ... OR TEXT BLOCKS SX0 X2-9 NZ X0,BCKLP0 ... OR LISTING BLOCKS BCKLP SB1 B1-1 LOOK AT THE PREVIOUS NAME ZR B1,BCKDONE --- BRIF FIRST NAME IN FILE SA2 LBINF0+B1 GET PREVIOUS BLOCK INFO WORD LX2 L.TYPE SHIFT BLOCK TYPE INTO POSITION MX0 -L.TYPEL TYPE FIELD MASK BX2 -X0*X2 ISOLATE BLOCK TYPE SX0 X2+B3 COMPARE THE BLOCK TYPES NZ X0,BCKDONE --- BRIF DIFFERENT TYPE ZR X2,BCKLP1 --- BRIF SOURCE BLOCK SX0 X2-7 ZR X0,BCKLP1 --- BRIF TEXT BLOCK SX0 X2-9 ZR X0,BCKLP1 --- BRIF LISTING BLOCK * ALL NON-SOURCE/TEXT/LISTING BLOCKS GO THRU HERE BCKLP0 SA2 LBINF0+B1 GET BLOCK INFO AGAIN LX2 L.BLKS SHIFT NO. OF BLOCKS INTO POS MX0 -L.BLKSL BX2 -X0*X2 ISOLATE NUMBER OF CONTIG BLOCKS NZ X2,FWDSRCH --- BRIF THIS IS START BLOCK BCKLP1 SA2 LBNAM0+B1 GET PREVIOUS NAME BX0 X2-X1 COMPARE THE TWO NAMES NZ X0,BCKDONE --- BRIF DIFFERENT NAME PL X0,BCKLP --- LOOP UNTIL DIFFERENT NAME BCKDONE SB1 B1+1 INCREMENT PAST MISMATCH FWDSRCH BSS 0 START FORWARD SEARCH * /--- BLOCK NAMBIAS 00 000 78/10/29 01.57 * * SCAN FORWARD TO DIFFERENT NAME * SB3 B1 NXTLP SB3 B3+1 LOOK AT NEXT SEQUENTIAL BLOCK GT B3,B2,LASTN --- BRIF LAST NAME IN FILE SA2 LBNAM0+B3 GET NEXT BLOCK NAME BX0 X2-X1 COMPARE THE TWO NAMES NZ X0,NAMBIAS --- EXIT IF A DIFFERENT NAME NG X0,NAMBIAS --- EXIT IF A DIFFERENT NAME MX0 -L.TYPEL SA2 LBINF0+B3 GET BLOCK INFO WORD AGAIN LX2 L.TYPE BX1 -X0*X2 ISOLATE BLOCK TYPE SA2 LBINF0+B1 GET OLD BLOCK TYPE LX2 L.TYPE BX2 -X0*X2 ISOLATE OLD BLOCK TYPE IX0 X1-X2 COMPARE BLOCK TYPES SA1 A1 RESTORE BLOCK NAME NZ X0,NAMBIAS --- EXIT IF BLOCK TYPES DIFFER EQ NXTLP --- LOOP UNTIL DIFFERENT NAME LASTN SB3 -1 FLAG LAST NAME IN FILE EQ NAMBIAS --- RETURN TO CALLER * ** * /--- BLOCK GENCOMP 00 000 77/12/20 00.18 TITLE -GENCOMP- GENERIC COMPARISON OF TWO WORDS ** * * -GENCOMP- * * PERFORMS GENERIC COMPARISON OF TWO WORDS * * ON ENTRY -- X1 CONTAINS WORD TO TEST * X2 CONTAINS WORD TO TEST AGAINST * EXIT -- X7 = 1 IF PARTIAL OR FULL MATCH * 0 IF NO MATCH * B3 = BITS IN PARTIAL MATCH - 1 * ENTRY GENCOMP GENCOMP EQ * MX6 1 1 BIT FOR MASK FORMATION MX7 0 0 IN CASE OF GENERIC FAILURE SB3 65 INITIAL SHIFT COUNT GENLP SB3 B3-6 MASK 1 LESS CHARACTER NG B3,GENCOMP --- EXIT IF NO GENERIC MATCH LX0 X6,-B3 FORM MASK FOR N CHARACTERS BX0 X0*X2 MASK DOWN FOR COMPARISON BX0 X0-X1 COMPARE THE TWO NZ X0,GENLP --- LOOP IF NOT THE SAME NG X0,GENLP --- LOOP IF NOT THE SAME SX7 1 FLAG PARTIAL MATCH EQ GENCOMP --- RETURN TO CALLER * ** * /--- BLOCK NAMREC 00 000 79/08/13 02.25 TITLE NAMREC CONVERT RELATIVE RECORD TO ABSOLUTE * * -NAMREC- * * THIS ROUTINE CALCULATES THE ABSOLUTE RECORD * NUMBER OF THE FILE GIVEN THE RELATIVE RECORD * WITHIN THE NAME CURRENTLY SELECTED. THIS * ASSUMES THAT THE FILE NODE HEADER HAS BEEN READ * AND THAT THE DATASET PROCESS (I.DS) HAS BEEN * INTERLOCKED. * * A0 = ADDRESS OF RECORD ALLOCATION TABLE * X1 = HEADER RECORD FOR CHAIN * X2 = RELATIVE RECORD NUMBER - 1 (RELATIVE TO ZERO) * * ON EXIT, * * X1 = ABSOLUTE RECORD NUMBER * X6 = NEGATIVE IF SYSTEM ERROR (RECORD=0 OR OUT OF RANGE) * = POSITIVE IF OK * * ENTRY NAMREC * NAMREC EQ * BX3 X2 X3 = RELATIVE RECORD NUMBER MX2 -FFIELD SA4 FILINF1 AX4 FMAXREC SHIFT TO MAX. RECORD NUMBER BX4 -X2*X4 X4 = MAX. POSSIBLE RECORD MX5 -1 INCREMENT FOR EACH ITERATION NAMREC2 ZR X1,NAMREC3 --- SYSTEM ERROR IF RECORD = 0 IX6 X4-X1 CHECK IF RECORD NUMBER VALID NG X6,NAMREC --- SYSTEM ERROR, OUT OF RANGE ZR X3,NAMREC --- ALREADY AT CORRECT RECORD GETSEG GET NEXT RECORD IN CHAIN IN X2 BX1 X2 CURRENT RECORD <- NEXT RECORD IX3 X3+X5 SUBTRACT FROM RELATIVE COUNT EQ NAMREC2 * NAMREC3 SX6 -1 MARK SYSTEM ERROR EQ NAMREC * /--- BLOCK NXTLINK 00 000 79/08/13 21.59 TITLE NXTLINK * * -NXTLINK- * * OBTAINS THE NEXT RECORD NUMBER IN THE CHAIN GIVEN * THE CURRENT RECORD NUMBER. THIS PERFORMS BOUNDS * CHECKING ON THE NEXT RECORD NUMBER TO MAKE SURE * THE ALLOCATION TABLE IS NOT MESSED UP. * * THE DATASET PROCESS (I.DS) SHOULD BE INTERLOCKED. * * ON ENTRY * * X1 = CURRENT RECORD NUMBER IN CHAIN * A0 = ADDRESS OF RECORD ALLOCATION TABLE * * ON EXIT * * X1 = NEXT RECORD NUMBER IN CHAIN * X6 = NEGATIVE IF SYSTEM ERROR * = POSITIVE IF OK * ENTRY NXTLINK * NXTLINK EQ * GETSEG GET LINK VALUE FOR THIS RECORD BX1 X2 CURRENT <- NEXT SA2 FILINF1 AX2 FMAXREC MX6 -FFIELD BX2 -X6*X2 X2 = MAX. VALUE FOR LINK ZR X1,NXTL1 --- ERROR IF OUT OF RANGE IX6 X2-X1 CHECK IF RECORD NUMBER VALID PL X6,NXTLINK --- EXIT IF VALID NUMBER * * SYSTEM ERROR * NXTL1 SX6 -1 EQ NXTLINK * /--- BLOCK READDS 00 000 79/08/13 02.28 TITLE READDS * * * * -READDS- * READS THE DATASET ECS FILE NODE HEADER AND * THE NAMESET HEADER INTO CM. * * THE DATASET PROCESS (I.DS) SHOULD BE INTERLOCKED * IF THE INFO IN THE HEADER WILL BE USED AS THE * BASIS FOR DECISIONS (E.G. CHECKS TO SEE IF SOME- * THING IS RESERVED OR TO SEE IF THERE'7S ENOUGH * ROOM LEFT IN THE FILE TO ADD RECORDS) * * ENTRY (B1) = ADDR OF -ATTACH- FIP (E.G. TDSNAME) * * ON EXIT - * DSLOC = ECS ADDRESS OF FILE NODE * NAMLOC0 = ECS ADDRESS OF FIRST NAME (NAMESETS) * NAMWDS = NAME ENTRY LENGTH IN WORDS (NAMESETS) * X0 = ECS ADDRESS OF FILE NODE * X6 = ECS ADDRESS OF NAMES (ONLY FOR NAMESETS) * ENTRY READDS READDS EQ * SA1 B1+BDSPARM (X1) = 42/JUNK, 18/LESSON NO. CALL READLES,DSNODE,(DSHEAD+FPRMLTH) MX7 -12 SA2 DSNODE LOAD 1ST WORD OF HEADER LX2 12 BX2 -X7*X2 MASK OFF LESSON TYPE CODE SX7 X2-9 NZ X7,"CRASH" EROR IF NOT DATASET FILE NODE BX7 X0 SA7 DSLOC SAVE ADDRESS OF ECS BUFFER SA1 BNAMBUF GET BIAS TO NAMESET HEADER ZR X1,READDS EXIT IF NOT NAMESET IX0 X0+X1 ECS ADDRESS OF NAMESET HEADER SA0 NSH + RE NPRMLTH READ NAMESET HEADER RJ ECSPRTY SX1 NPRMLTH LENGTH OF NAMESET HEADER IX6 X0+X1 ECS ADDRESS OF NAMES SA6 NAMLOC0 SAVE ADDRESS OF NAMES BX0 X7 RETURN ECS ADDRESS OF FILE NODE SA1 FILINF2 AX1 FNWORDS SHIFT TO ENTRY LENGTH MX2 -FFIELD BX7 -X2*X1 ENTRY LENGTH IN WORDS SA7 NAMWDS SAVE FOR LATER USE EQ READDS * * /--- BLOCK SETFIO 00 000 79/10/18 23.25 TITLE SETFIO SET FILE I/O ACTIVITY * * SETFIO * * SETS THE FILE I/O ACTIVITY RESERVATION ENTRY. * * ENTRY (B1) = ADDR OF -ATTACH- FIP (E.G. TDSNAME) * * ON EXIT, * X6 = -1 IF OK * 0 IF FILE BUSY * * THE -CLRFIO- ROUTINE MUST BE CALLED AFTER * THE I/O IS COMPLETED (WITH OR WITHOUT ERROR). * * ENTRY SETFIO * SETFIO EQ * * SX3 B1 SAVE OVER INTLOK INTLOK X,I.DS,W INTERLOCK CHANGING FILE NODE CALL READDS,X3 READ FILE NODE HEADER * SA1 FILINF1 LX1 -FIO POSITION I/O RESERVE AT RIGHT MX6 -FFIELD BX3 -X6*X1 X3 = I/O ACTIVITY MARKER * SA2 STATION RESERVING STATION NUMBER SX2 X2+1 INCR (TO ALLOW FOR CONSOLE) * NZ X3,SETFIO2 --- IF ALREADY RESERVED * BX6 X1+X2 STATION + REST OF FILINF1 LX6 FIO SA6 A1 * * * MODIFY FILE NODE IN ECS * SA1 DSLOC ECS ADDRESS OF FILE NODE SX2 DSHEAD LENGTH OF STANDARD HEADER IX0 X1+X2 ADDRESS OF DATASET HEADER SA0 DSH WE FPRMLTH RJ ECSPRTY * SETFIO1 INTCLR X,I.DS SX6 -1 OK EQ SETFIO --- EXIT * SETFIO2 BX3 X2-X3 CHECK IF SAME STATION NUMBER ZR X3,SETFIO1 --- OK IF RESERVED HERE * SETFE0 INTCLR X,I.DS SX6 0 FILE BUSY EQ SETFIO --- EXIT * /--- BLOCK CLRFIO 00 000 79/10/18 13.11 TITLE CLRFIO CLEAR FILE I/O ACTIVITY * * CLRFIO * * CLEARS THE FILE I/O ACTIVITY RESERVATION ENTRY. * * ENTRY (B1) = ADDR OF -ATTACH- FIP (E.G. TDSNAME) * * NOTE--A CHECK IS DONE TO ASSURE THAT THE CALLING * STATION IS THE SAME AS THE ONE WITH THE I/O * RESERVED; NO CLEAR IS DONE IF IT IS NOT. * * ENTRY CLRFIO * CLRFIO EQ * * SA1 B1+BDSNAME (X1) = NAME OF FILE NG X1,CLRFIO1 NEG. NAME = FILE IS PRESENT ZR X1,CLRFIO --- EXIT IF NO FILE PRESENT CLRFIO1 SA1 B1+BDSINF (X1) = FILE INFORMATION AX1 18 MX2 -6 BX1 -X2*X1 (X1) = FILE TYPE ZR X1,CLRFIO --- EXIT IF NO FILE TYPE SX2 X1-NFTYPES-1 COMPARE W/ MAXIMUM FILE TYPE PL X2,CLRFIO --- EXIT IF TYPE OUT OF RANGE SA1 X1+ATTRTAB (X1) = FILE ATTRIBUTE WORD SX1 X1+ (X1) = *AFTJMP* PARAMETER NZ X1,CLRFIO --- NEITHER DATASET NOR NAMESET SX3 B1+ SAVE FIP ADDR OVER INTLOK * INTLOK X,I.DS,W INTERLOCK CHANGING FILE NODE CALL READDS,X3 READ FILE NODE HEADER SA1 FILINF1 FILE INFORMATION WORD MX6 -FFIELD LX6 FIO BX7 X6*X1 CLEAR FILE I/O ACTIVITY * * ENSURE THAT THIS STATION IS THE ONE WITH THE RESERVATION * BX1 -X6*X1 EXTRACT RESERVATION ENTRY LX1 -FIO POSITION AT RIGHT SA2 STATION RELEASING STATION NUMBER SX2 X2+1 INCR (TO ALLOW FOR CONSOLE) IX6 X1-X2 COMPARE WITH RESERVATION NZ X6,CLRDON EXIT IF NOT THE SAME STATION SA7 A1 STORE WITH ENTRY CLEARED * * * MODIFY FILE NODE IN ECS * SA1 DSLOC SX2 DSHEAD IX0 X1+X2 SA0 DSH WE FPRMLTH RJ ECSPRTY * CLRDON INTCLR X,I.DS EQ CLRFIO --- EXIT * /--- BLOCK READFTB 00 000 79/08/13 02.29 TITLE READFTB * * -READFTB- * * THIS ROUTINE READS THE RECORD MANAGEMENT TABLE * AND THE RECORD ALLOCATION TABLE FROM ECS INTO * THE CM BUFFERS. THE ALLOC. TABLE IS ONLY READ * FOR NAMESET TYPE FILES. * * THIS ASSUMES THAT -READDS- HAS BEEN CALLED. * * THE DATASET PROCESS (I.DS) SHOULD BE INTERLOCKED. * * ENTRY (B1) = ADDRESS OF -ATTACH- FIP. * * ON EXIT, * * RMT = RECORD MANAGEMENT TABLE * RAT = RECORD ALLOCATION TABLE (NAMESETS ONLY) * ENTRY READFTB * READFTB EQ * SA1 DSLOC ECS ADDRESS OF FILE NODE SA2 BRMT BIAS TO RMT IX0 X1+X2 ECS ADDRESS OF RMT SA3 FILINF2 MX6 -FFIELD AX3 FTBSIZE SHIFT TO TABLE SIZE IN WORDS BX3 -X6*X3 GET TABLE SIZE SA2 B1+BDSINF (X2) = 1/NAMESET,59/OTHER STUFF SB1 X3+ (B1) = RAT/RMT SIZE IN WORDS SA0 RMT ADDRESS OF CM BUFFER RE B1 READ RECORD MANAGEMENT TABLE RJ ECSPRTY * PL X2,READFTB --- EXIT IF NOT NAMESET SA2 BRAT BIAS TO RAT IX0 X1+X2 ECS ADDRESS OF RAT SA0 RAT ADDRESS OF CM BUFFER RE B1 READ RECORD ALLOCATION TABLE RJ ECSPRTY EQ READFTB --- EXIT * /--- BLOCK READNAM 00 000 79/08/13 02.29 TITLE READNAM -- READ CURRENT USER NAME READNAM SPACE 5,20 ** READNAM - READ CURRENT NAME ENTRY * * READS THE NAME ENTRY THAT THE USER IS CURRENTLY * SET FOR INTO A SPECIFIED LOCATION. * * ENTRY *READDS* CALLED. * *I.DS* (DATASET PROCESS) INTERLOCKED. * * ENTRY (B1) = ADDR OF -ATTACH- FIP (E.G. TDSNAME) * (B2) = ADDR OF NAMESET NAME (E.G. TRECNAM) * * EXIT (X2) = >0 IF NON-SOURCE BLK IN USER LESSON. * (X7) = -1 IF NAME FOUND, ELSE POSITIVE. * (B1) = LENGTH OF NAME ENTRY. * * CALLS CHRCOMP, CHRMOVE, FINDNAM. * * MACROS CALL. * ENTRY READNAM * READNAM EQ * SX6 B1 SAVE ADDR OF -ATTACH- FIP SX7 B2 SAVE ADDR OF NAME SA6 FIPSAVE SA7 NAMSAVE SA1 B2+ CHECK IF CURRENTLY SET TO NAME ZR X1,READE0 --- ERROR IF NOTHING TO READ * * * READ CURRENT NAME * SA1 NAMLOC0 ECS ADDRESS OF NAMES SA2 B1+BDSINF SX2 X2 BIAS TO CURRENT NAME ENTRY IX0 X1+X2 ECS ADDRESS OF NAME ENTRY BX6 X0 SA6 NAMLOC SAVE ADDRESS FOR LATER USE SA1 NAMWDS LENGTH OF NAME ENTRY SB1 X1 SA0 NAME RE B1 READ CURRENT NAME ENTRY RJ ECSPRTY * * * CHECK IF BIAS STILL GIVES CURRENT NAME * SA1 FILINF2 MX7 -FFIELD AX1 FNSIZE SHIFT TO NAME SIZE IN CHARS BX6 -X7*X1 X6 = NAME SIZE IN CHARS SA1 NAMSAVE (X1) = ADDRESS OF NAME CALL CHRCOMP,X1,A0,X6 NZ X6,REFIND IF NAME MOVED SINCE LAST TIME SA1 NAMLOC ECS ADDRESS OF NAME ENTRY SA2 NAMWDS GET LENGTH OF ENTRY BX0 X1 RETURN ECS ADDRESS SB1 X2 RETURN LENGTH OF ENTRY EQ READOK --- EXIT OK * /--- BLOCK REFIND 00 000 79/06/27 11.47 * * * RE-FIND THE NAME (SOMEONE SHIFTED IT) * REFIND SA1 NAMSAVE (X1) = ADDRESS OF NAME CALL FINDNAM,X1 FIND THE CURRENT NAME * * AFTER CALL, X0 = ECS ADDRESS OF NAME, X6 HAS BIAS * TO NAME, X5 = SIZE OF ENTRY IN WORDS, X7 = RETURN. * PL X7,READE0 --- JUMP IF NO LONGER EXISTS * * * UPDATE ECS BIAS TO CURRENT NAME * SA1 FIPSAVE (X1) = ADDRESS OF -ATTACH- FIP SA1 X1+BDSINF MX2 -18 MASK FOR NAME BIAS BX1 X1*X2 ZERO OUT OLD BIAS BX6 X1+X6 INSERT NEW LOCATION SA6 A1 STORE * * * UPDATE ECS ADDRESS OF CURRENT NAME * BX6 X0 X6 = ECS ADDR. OF CURRENT NAME SA6 NAMLOC * * * RE-READ CORRECT NAME ENTRY * SA1 NAMWDS LENGTH OF NAME ENTRY SB1 X1 SA0 NAME RE B1 READ NAME ENTRY RJ ECSPRTY * READOK SA1 NAME-1+B1 GET EXTRA INFO WORD BX6 X1 SA6 NAMINFO SAVE COPY FOR LATER USE MX7 -1 RETURN FOUND MX2 0 SET TO SOURCE OR SYSTEM LESSON SA3 LESSCM+LSTOUSE NG X3,READNAM --- IF SYSTEM LESSON SA3 FFAW (X3) = FILE ATTRIBUTE WORD LX3 60-/FAW/S.FTYPE POSITION FILE TYPE CODE MX4 -/FAW/M.FTYPE (X4) = MASK FOR FILE TYPE BX3 -X4*X3 (X3) = FILE TYPE SX3 X3-GRTYPE CHECK FOR GROUP NZ X3,READOK1 --- IF NOT GROUP SA3 FILINF5 (X3) = FILE INFORMATION AX3 FUPD8LV POSITION UPDATE LEVEL MX4 -FFIELD (X4) = MASK FOR UPDATE LEVEL BX3 -X4*X3 (X3) = UPDATE LEVEL SX3 X3-UPD8LV6 CHECK FOR LEVEL .GE. 6 NG X3,READNAM --- EXIT IF GROUP .LE. 5 READOK1 AX1 15+15+24 MX2 -IBSUBF BX2 -X2*X1 (X2) = 0 IF SOURCE, ELSE .GT. 0 EQ READNAM --- EXIT * * * CURRENT NAME WAS DELETED BY ANOTHER USER * READE0 SA1 NAMSAVE (X1) = ADDRESS OF NAME CALL CHRMOVE,NONAME,X1,MAXNCHR SA1 FIPSAVE (X1) = ADDRESS OF -ATTACH- FIP SA1 X1+BDSINF MX2 -18 MASK FOR NAME BIAS BX6 X1*X2 ZERO OUT BIAS SA6 A1 STORE MX7 0 INDICATE NAME CANNOT BE FOUND EQ READNAM --- EXIT FIPSAVE BSS 1 ADDRESS OF -ATTACH- FIP NAMSAVE BSS 1 ADDRESS OF NAME * /--- BLOCK FINDNAM 00 000 79/08/13 02.29 TITLE NAMESET BINARY/GENERIC SEARCH * * -FINDNAM- * * THIS ROUTINE PERFORMS A BINARY CHOP SEARCH * OF AN ECS RESIDENT NAMESET DIRECTORY. ONCE * THE BINARY SEARCH IS DONE, A LINEAR SCAN IS * PERFORMED TO COUNT (UP TO 2) THE NUMBER OF * GENERIC MATCHES TO THE KEY UNTIL IT CANNOT BE * MATCHED GENERICALLY. THE FIRST NON-ZERO 6-BIT * CODE WHEN SCANNING FROM THE END OF THE OBJECT * KEY FORWARD DETERMINES THE MASK USED FOR GENERIC * COMPARISONS. * * THIS ASSUMES THAT -READDS- HAS BEEN CALLED. * * THE DATASET PROCESS (I.DS) SHOULD BE INTERLOCKED. * * ON ENTRY-- * * B1 = ADDRESS OF KEY TO SEARCH FOR * * ON EXIT-- * * X0 = ECS ADDRESS OF REQUESTED NAME * X5 = LENGTH OF AN ENTRY IN WORDS * X6 = RELATIVE ECS BIAS TO NAME * (OR WHERE IT SHOULD BE PUT) * X7 = -1 IF FOUND, * ELSE COUNT OF GENERIC MATCHES (UP TO 2) * * ENTRY FINDNAM FINDNAM EQ * * * SAVE B5, B7 OVER THE ROUTINE * SX6 B5 SAVE B5 SA6 B5SAVE SX6 B7 SAVE B7 SA6 NCTYPE * /--- BLOCK FINDNAM 00 000 79/01/25 04.05 * * * GENERATE MASK FOR LAST WORD OF ENTRY * SA1 FILINF2 MX7 -FFIELD AX1 FNSIZE SHIFT TO LENGTH OF NAME (CHARS) BX1 -X7*X1 CHARACTERS IN NAME CALL CHRMOVE,B1,NAMKEY,X1 GET OBJECT KEY BX4 X7 X4 = MASK FOR LAST WORD * * * INITIALIZE CONSTANTS * SA1 NAMWDS GET ENTRY LENGTH (WORDS) BX5 X1 X5 = LENGTH OF ENTRY IN WORDS SB6 X1-1 B6 = LENGTH OF OBJECT KEY SB5 NAMKEY-1+B6 B5 = LWA OF OBJECT KEY SB1 1 B1 = CONSTANT 1 SB7 59 B7 = CONSTANT 59 SA0 NAMTMP SA1 NAMLOC0 GET ECS ADDRESS OF FIRST NAME BX7 X1 X7 = ECS ADDRESS OF NAMES * /--- BLOCK FINDNAM 00 000 78/02/03 03.23 * * BEGIN EXECUTION * SB2 B0 B2 = BASE POSITION (REL. 0) SA2 NNAMINF BOTTOM 18 = NAMES IN USE SB3 X2 B3 = DOMAIN OF SEARCH EQ NHALF1 BEGIN EXECUTION * NHALF2 SB2 X3+B1 ADVANCE BASE POSITION (SCAN+1) NG X6,NHALF1 JUMP IF PREV. LENGTH WAS ODD SB3 B3-B1 REDUCE DOMAIN BY 1 IF EVEN * NHALF1 ZR B3,NOTFND -- UNSUCCESSFUL EXIT SX3 B3 GET DOMAIN IN X3 LX6 X3,B7 SAVE ODD/EVEN FLAG IN SIGN BIT AX3 1 DIVIDE BY 2 SB3 X3 B3 = NEW DOMAIN (LAST ONE/2) SX3 B2+B3 X3 = POSITION BEING TESTED IX0 X3*X5 DISPLACEMENT INTO BUFFER IX0 X7+X0 COMPUTE ECS ADDRESS RE B6 RJ ECSPRTY SA1 A0 FIRST WORD OF SCAN KEY SB4 NAMKEY FIRST WORD OF OBJECT KEY COMP1 SA2 B4 GET OBJECT WORD NG X1,COMP2 JUMP IF SCAN KEY NEGATIVE NG X2,NHALF2 OBJECT HIGHER THAN SCAN EQ COMP3 COMPARE - BOTH HAVE SAME SIGN * COMP2 PL X2,NHALF1 OBJECT LESS THAN SCAN KEY * COMP3 LT B4,B5,COMP4 --- JUMP IF NOT LAST WORD BX1 X4*X1 MASK OFF IRRELAVENT CHARACTERS * COMP4 IX1 X2-X1 NG X1,NHALF1 JUMP IF IN 1ST HALF NZ X1,NHALF2 JUMP IF IN 2ND HALF SA1 A1+B1 NEXT WORD OF SCAN KEY SB4 B4+B1 NEXT WORD OF OBJECT KEY LE B4,B5,COMP1 CONTINUE IF MORE WORDS LEFT IX6 X3*X5 X6 = BIAS TO NAME ENTRY IX0 X7+X6 X0 = ECS ADDRESS OF NAME SX7 -B1 X7 = -1 (FOUND) BNREST SA1 B5SAVE SB5 X1 RESTORE B5 SA1 NCTYPE SB7 X1 RESTORE B7 EQ FINDNAM --- EXIT * /--- BLOCK GENSCAN 00 000 78/02/03 02.57 * * IF THE KEY CANNOT BE FOUND, SEARCH LINEARLY * COUNTING THE NUMBER OF GENERIC MATCHES. * NOTFND SB3 B0 B3 = NUMBER OF GENERIC MATCHES SB7 2 B7 = MAXIMUM VALUE OF GENERIC COUNT * * FIRST, SEARCH THE OBJECT KEY FROM THE END * OF THE KEY FORWARD LOOKING FOR THE LAST * CHARACTER. MASK WILL BE GENERATED FROM THAT. * * B5 WILL = LWA OF GENERIC PORTION OF KEY * MX0 -6 FOR MASKING OFF LOWER 6 BITS SB4 NAMKEY USE B4 FOR END TEST SB5 B4+B6 START B5 AT LWA+1 OF KEY MSKLP1 LE B5,B4,GENEXIT IF KEY = 0, EXIT SEARCH SB5 B5-B1 SCAN FROM LAST TO FIRST SA1 B5 GET WORD OF KEY MX6 60 INITIALIZE MASK TO WHOLE WORD MSKLP2 LX6 6 DECREASE SIZE OF MASK BX6 X0*X6 BY 6 BITS BX3 -X6*X1 SEE IF MASK HOLDS CONTENTS NZ X3,MSKFIN --- IF NOT, LAST CHAR FOUND NZ X6,MSKLP2 IF MORE CHARS LEFT, CONTINUE EQ MSKLP1 TRY PREVIOUS WORD IN OBJECT * MSKFIN AX6 6 EXTEND MASK OVER LAST CHAR MX0 6 BX6 X0+X6 IN CASE ONLY ONE CHARACTER * /--- BLOCK GENSCAN 00 000 78/02/03 03.07 * * BEGIN SCANNING THE NAMES * SA3 NNAMINF BOTTOM 18 = NAMES IN USE SX3 X3+B1 X3 = ENTRIES + 1 GSCAN SX1 B2+B3 ENTRY TO BE TESTED IX0 X1-X3 SEE IF END OF NAMES PL X0,GENEXIT --- IF NO MORE NAMES, EXIT IX0 X1*X5 DISPLACEMENT INTO BUFFER IX0 X7+X0 COMPUTE ECS ADDRESS RE B6 RJ ECSPRTY SB4 NAMKEY START OF GENERIC KEY SA1 A0 START OF NAME BEING SEARCHED GCOMP SA2 B4 GET NEXT WORD OF DIRECTORY NAME LT B4,B5,GCOMP2 --- IF LAST WORD, USE MASK BX1 X1*X6 MASK OFF ALL BUT GENERIC PART GCOMP2 BX1 X1-X2 COMPARE WITH GENERIC KEY NZ X1,GENEXIT --- IF DOES NOT MATCH, EXIT SA1 A1+B1 GET NEXT WORD OF SEARCH NAME SB4 B4+B1 NEXT WORD OF GENERIC KEY LE B4,B5,GCOMP --- IF NOT LAST WORD, CONTINUE SB3 B3+B1 ADD TO COUNT OF GENERIC MATCHES LT B3,B7,GSCAN --- KEEP LOOKING IF LESS THAN 2 * GENEXIT SX6 B2 RETURN FIRST GENERIC MATCH IX6 X6*X5 BIAS TO FIRST GENERIC MATCH IX0 X7+X6 X0 = ECS ADDRESS OF NAME SX7 B3 RETURN COUNT OF GENERIC MATCHES EQ BNREST --- RESTORE REGS AND EXIT * NAMKEY BSS MAXNWDS KEY BEING SEARCHED FOR NAMTMP BSS MAXNWDS+1 TABLE ENTRY BEING CHECKED B5SAVE BSS 1 USED TO SAVE B5 OVER ROUTINE * /--- BLOCK FINDRES 00 000 80/07/02 00.14 TITLE FINDRES -- SEARCH SIGNON RESERVATION TABLE * * -FINDRES- * * SEARCHES THE SIGNON RESERVATION TABLE IN ECS TO * DETERMINE IF THE CURRENTLY SELECTED NAME IS SIGNED * ON OR NOT. * * ENTRY (TDSNAME) = GROUP NAME * (TRECNAM) = SIGNON NAME * * EXIT (X6) = -1 IF RESERVED BY A STATION * 0 IF NOT RESERVED * (X5) = INDEX TO ENTRY WHERE FOUND * (X4) = PREVIOUS ENTRY IN CHAIN (-1 IF NONE) * (X0) = ECS ADDRESS OF RESERVATION * (SIGNCM) = RESERVATION ENTRY (3 WORDS) * * ENTRY FINDRES FINDRES EQ * SA1 TRECNAM COMBINE NAME SA2 TRECNAM+1 SA3 TDSNAME AND GROUP IX1 X1+X2 IX1 X1+X3 MX6 12 BX1 -X6*X1 MASK OFF EXPONENT PX6 X1 NX6 X6 SX2 NUMRESV SIZE OF HASH SECTION OF TABLE PX3 X2 NX3 X3 FX6 X6/X3 INDEX/TABLESIZE UX6 X6,B1 LX6 X6,B1 INT(INDEX/TABLESIZE) IX6 X2*X6 TABLESIZE*INT(INDEX/TABLESIZE) IX5 X1-X6 INDEX MOD TABLESIZE MX4 -1 INITIALIZE PREVIOUS INDEX * /--- BLOCK FINDRES 00 000 80/07/02 00.14 * * * CHECK IF SIGNON ENTRY MATCHES * READRES SA1 ASIGNON ECS ADDRESS OF TABLE SX2 RESVLTH SIZE OF EACH ENTRY IX6 X5*X2 BIAS TO THIS ENTRY IX0 X1+X6 SA0 SIGNCM RE RESVLTH RJ ECSPRTY SA1 A0 PICK UP FIRST WORD ZR X1,EMPTY --- DETECT THIS ENTRY EMPTY SB1 1 SA1 TRECNAM SA2 SIGNCM BX6 X1-X2 COMPARE FIRST WORD NZ X6,REHASH --- REHASH IF NO MATCH SA1 A1+B1 SA2 A2+B1 BX6 X1-X2 COMPARE SECOND WORD MX7 -12 BX6 X7*X6 MASK OFF UNUSED BITS NZ X6,REHASH --- REHASH IF NO MATCH SA1 TDSNAME SA2 A2+B1 BX6 X1-X2 COMPARE THIRD WORD BX6 X7*X6 MASK OFF UNUSED BITS NZ X6,REHASH --- REHASH IF NO MATCH BX3 X0 SAVE ECS ADDRESS BX0 X3 RESTORE ECS ADDRESS MX6 -1 -1 = FOUND EQ FINDRES --- EXIT * * * SELECT NEXT ENTRY IN CHAIN * REHASH BX4 X5 SET PREVIOUS INDEX TO ENTRY SA1 SIGNCM+1 PICK UP SECOND WORD OF ENTRY MX6 -12 BX5 -X6*X1 MASK OFF INDEX TO NEXT ENTRY NZ X5,READRES --- JUMP IF NOT END-OF-CHAIN * EMPTY BSS 0 MX6 0 0 = NOT FOUND EQ FINDRES --- EXIT * /--- BLOCK LJUSTC 00 000 77/08/17 23.07 TITLE LJUSTC LEFT JUSTIFY CODEWORD * * LJUSTC * * 'LEFT JUSTIFIES THE NAME IN X1, CHANGING ANY * ENCLOSED ZEROS TO SPACES. * * ENTRY LJUSTC LJUSTC EQ * ZR X1,LJUSTC --- EXIT IF ALL ZEROS (OR -0) MX0 6 MASK FOR ONE CHARACTER LX1 -6 ACCOUNT FOR INITIAL SHIFT LJC1 LX1 6 GET NEXT CHAR TO TOP BX2 X0*X1 EXTRACT ZR X2,LJC1 ELIMINATE LEADING ZEROS SB1 1 SB2 9 MX0 -6 SEARCH FOR LAST CHAR (NONZERO) SX4 1R X4 = SPACE CODE FOR FILL LJC2 BX2 -X0*X1 LX0 6 SHIFT MASK LX4 6 SHIFT FILL CHARACTER SB2 B2-B1 ZR X2,LJC2 NG B2,LJUSTC --- EXIT IF ONLY 1 CHAR LJC3 BX2 -X0*X1 NZ X2,LJC4 BX1 X1+X4 LJC4 LX0 6 LX4 6 SB2 B2-B1 PL B2,LJC3 EQ LJUSTC --- EXIT * /--- BLOCK MASTERFILE 00 000 82/10/01 17.13 TITLE MASTERFILE FUNCTIONS RMFSIZE SPACE 4,10 ** RMFSIZE - READ MASTERFILE DIRECTORY SIZE. * * READS MASTERFILE DIRECTORY SIZE FROM THE MASTER- * FILE DIRECTORY FOR A SPECIFIC MASTERFILE. * * ENTRY (X1) = MASTERFILE NAME OR NUMBER * * EXIT (X1) = NUM OF DIRECTORY BLOCKS IF MF ACTIVE * = -1 IF MASTERFILE NOT ACTIVE * * USES A - 0, 1, 2. * B - 1, 3. * X - 0, 1, 2. * * CALLS NONE. * * MACROS NONE. RMFSIZE EQ * SA0 PNAMES (A0) = MASTERFILE NAMES FWA * CHECK IF WE HAVE A NUMBER NG X1,RMF10 IF A NAME (NO MF NUMBER IS NEG) SB3 X1 (B3) = PRESET TO POSS MF NUM SX2 NDSUS (X2) = NUMBER OF MASTERFILES IX2 X1-X2 COMPARE PARAMETER WITH NDSUS PL X2,RMF10 IF A NAME (NOT IN (0..NDSUS-1)) SA2 A0+B3 (X2) = THE MASTERFILE NAME NZ X2,RMF40 IF MASTERFILE ACTIVE EQ RMF30 MASTERFILE NOT ACTIVE * LOOP THROUGH LIST FOR THIS MASTERFILE NAME RMF10 BSS 0 SB3 NDSUS (B3) = NUMBER OF MASTERFILES RMF20 BSS 0 SA2 A0+B3 (X2) = NEXT MASTERFILE NAME BX2 X1-X2 COMPARE WITH SPECIFIED MF NAME ZR X2,RMF40 IF THIS MF (IF THEY ARE SAME) SB3 B3-B1 (B3) = NEXT ORDINAL PL B3,RMF20 IF MORE MFS TO SEARCH THROUGH RMF30 BSS 0 MX1 -1 (X1) = -1 = MF NOT ACTIVE EQ RMFSIZE * GET DIRECTORY SIZE FIELD FOR THIS MASTERFILE RMF40 BSS 0 SA1 PITS+B3 (X1) = EM ADDR OF SPEC MF DIR SX0 2 (X0) = OFFSET TO FIRST PARAMETR IX0 X0+X1 (X0) = EM ADDR OF FRST PARAMETR RX1 X0 (-RXX- 1 WD READ, MAY CHG *A1*) MX0 -6 (X0) = MASK FOR DIR SIZE FIELD LX1 60D-48D POSITION DIR SIZE TO LOW BITS BX1 -X0*X1 (X1) = DIRECTORY SIZE FIELD EQ RMFSIZE * /--- BLOCK MASTERFILE 00 000 79/04/06 23.31 SPACE 4,10 ** S"MF$" - RETURN *MF$* FOR A SPECIFIC MASTERFILE. * * RETURNS THE VALUE OF MASTERFILE PARAMETER *MF$* * FOR A SPECIFIED MASTERFILE. POSSIBLE PARAMETERS * ARE *DCPP*, *NMFBLK*, *PITLTH*, AND *MFFILS*. * * ENTRY (X1) = MASTERFILE NAME OR NUMBER * * EXIT (X1) = *MF$* FOR THE MASTERFILE IF ACTIVE * = -1 IF MASTERFILE NOT ACTIVE * * USES A - NONE. * B - NONE. * X - 1. * * CALLS RMFSIZE. * * MACROS NONE. PURGMAC MFFUNC MACREF MFFUNC$ MFFUNC MACRO ARG LOCAL LAB20 MACREF MFFUNC MF$ MICRO 1,, ARG ENTRY S"MF$" S"MF$" EQ * CALL RMFSIZE NG X1,S"MF$" IF MASTERFILE NOT ACTIVE NZ X1,LAB20 IF NOT A 2-PART DIRECTORY MF * GET PARM FOR A 2-PART DIRECTORY MASTERFILE SX1 "MF$"2 (X1) = *MF$* FOR A 2-PART MF EQ S"MF$" * GET PARM FOR A 3-PART DIRECTORY MASTERFILE LAB20 BSS 0 SX1 "MF$"3 (X1) = *MF$* FOR A 3-PART MF EQ S"MF$" ENDM MFFUNC DCPP MFFUNC NMFBLK MFFUNC PITLTH MFFUNC MFFILS MFFUNC MFLTH * /--- BLOCK END 00 000 77/11/14 19.48 * END