TAD I LOJOBP /PICK UP PROJ,PROG NUMBER JMS I UTS01 /SEARCH UFD TABLE JMP LGO2 /OOPS!! MIGHT AS WELL TRY TO LEAVE GRACEFULLY ISZ I UTPRNU /REMOVE THIS JOB FROM ACCESS COUNT JMP LGO2 CLA CMA /LAST USER ACCESSING THIS UFD TAD UTPRNU JMS I TF01 /FREE THE UFD TABLE ENTRY LGO2, CLA DCA I LOJOBP /REMOVE USER FROM JOB TABLE TAD LGO4A /KLUDGE FIEXIT TO RETURN TO LGO4 DCA LGKLUJ TABOUT, CLA CMA DCA TABSTA /FORCE TABLES OUT JMP I FIEXIT LOJOBP, 0 LOSRRI, RTABLE 0 LGO4A, LGO4 LGO1A, LGO1 LGKLUJ, FIX500 LGRESA, LGRES0 /ROUTINE TO OPEN A UFD /CALLING SEQUENCE: / TAD (PROJ,PROG NUMBER) / JMS UFO0 / ERROR RETURN (AC=0 IF TABLES FULL; OTHERWISE UFD NOT FOUND) / NORMAL RETURN (POSITION ON TABLE IN AC) *3200 UFO0, 0 JMS UFO6 /GO GET THE RETR. INFO FOR THIS GUY'S UFD INTO CORE JMP I UFO0 /COULDN'T GET IT DCA UOBUFP /POINTER TO RETRIEVAL INFORMATION TAD UFDTBL IAC DCA UOUFDP /UFD TABLE POINTER /SEARCH FOR A FREE SLOT IN UFDTBL UFO3, TAD I UOUFDP SNA CLA JMP UFO2 /FOUND A FREE SLOT ON THE TABLE TAD UOUFDP /THIS SLOT IS OCCUPIED TAD P0004 DCA UOUFDP /NEXT POSITION (ACCES COUNT ENTRY) TAD UFDEND /ARE WE AT THE END OF THE TABLE CMA TAD UOUFDP SNA CLA /HAVE WE SEARCHED THE WHOLE TABLE? JMP I UFO0 /NO ROOM ON TABLE JMP UFO3 /LOOK AT NEXT SLOT /COMES HERE WITH UOUFDP POINTING TO A FREE SLOT IN UFDTBL UFO2, CLL STA RAL /AC=-2 TAD UOUFDP /BACK UP THE POINTER DCA INDEX TAD UFORET+1 JMS I UFQUOA /LOAD THE UFD TABLE STA TAD UFDTBL CIA TAD INDEX CLL RTR DCA UFO6 /RELATIVE POSITION ON TABLE TAD UFO6 JMS I BLDP1 /GENERATE A PTR INTO RETTBL DCA UFORET /RETRIEVAL POINTER TAD C7771 DCA CFH /COUNTER FOR TRANSFER TO TABLE /NOW MOVE RETRIEVAL INFORMATION FOR THIS GUY'S /UFD INTO RETTBL UFO4, ISZ UOBUFP TAD I UOBUFP DCA I UFORET ISZ UFORET ISZ CFH /ENTIRE RETRIEVAL BLOCK TRANSFERRED? JMP UFO4 /NO, KEEP IT UP ISZ UFO0 /YES, PREPARE FOR NORMAL RETURN TAD UFO6 /PICK UP RELATIVE POSITION JMP I UFO0 UFORET, 0 0 UFQUOA, UFQUOT UOUFDP= UTPRNU UOBUFP, 0 UFO6, 0 DCA UFORET+1 /SET UP CALLING SEQUENCE FOR MFD SEARCH TAD RETTBL DCA UFORET CMA JMS I DS01 /ONE WORD MASTER FILE DIRECTORY SEARCH FOR PROJ,PROG MATCH UFORET JMP I UFO6 /COULD NOT FIND UFD ENTRY TAD P0004 /POINT AT DISK QUOTA WORD DCA UFORET TAD I UFORET AND P0077 /SAVE ONLY LOGIN QUOTA DCA SEGLIM /SAVE FOR LATER TAD P0003 TAD UFORET DCA UFORET /POINTER TO UFD RETRIEVAL INFORMATION TAD I UFORET DCA UFO1 TAD RETTBL /POINTER TO RET. INFO OF FILE BEING SEARCHED (IN THIS CASE, THE MFD) JMS I GE01 /GET RETRIEVAL INFORMATION INTO CORE UFO1, 0 ISZ UFO6 JMP I UFO6 /ROUTINE TO SEARCH UFD TABLE FOR PROJ,PROG NUMBER /CALLING SEQUENCE: / TAD (PROJ,PROG NUMBER) / JMS UTS0 / NOT FOUND RETURN / NORMAL RETURN (RETRIEVAL POSITION IN AC) UTS0, 0 DCA UTPR1 /PROJ,PROG NUMBER TAD UFDTBL /PTR TO HEAD OF UFDTBL DCA UTUPTR UTS1, TAD UFDEND /END OF UFD TABLE CIA TAD UTUPTR SNA CLA JMP I UTS0 /COULD NOT FIND PROJ,PROG NUMBER ON TABLE TAD I UTUPTR CIA TAD UTPR1 SNA CLA JMP UTS3 /FOUND ENTRY, GET POINTER TAD UTUPTR /STEP UP ONE SLOT TAD P0004 DCA UTUPTR JMP UTS1 /LOOK IN THE NEXT ENTRY UTS3, TAD UFDTBL CIA TAD UTUPTR CLL RTR /RELATIVE POSITION ON TABLE IAC /THE RELATIVE POSITION ISZ UTPRNU /UTPRNU POINTS TO ACCESS COUNT OF THIS PROJ, PROG # ISZ UTS0 JMP I UTS0 DVT1, UTPR1, 0 UTUPTR= UTPRNU DVT0, 0 /COMPUTE DEVICE TIME AT RELEASE DCA DVT1 /ELAPSED DEVICE TIME JMS I JBLD0 DCA DVT3 /PROJ,PROG NUMBER OF CURRENT USER CLA CMA JMS I DS01 /SEARCH MFD FOR PROJ,PROG NUMBER DVT4 JMP I DIRBAD /***********DEBUG ONLY*********** TAD C0005 DCA CFH /POINTER TO DEVICE TIME WORD TAD DVT1 TAD I CFH /UPDATE USER'S CUMULATIVE DEVICE TIME DCA I CFH DCA BUFMOD /SCHEDULE WRITE DATFLD JMP I DVT0 DVT4, RTABLE DVT3, 0 /COMES HERE IF FIP WAS CALLED BY S.I. /READ S.I. BACK IN AND RETURN TO IT FIX30, CFLD /CHANGE TO CURRENT FIELD TAD C0603 DCA FLPARB /SET UP READ IOT DCA FLPARB+1 /SI IS ON TRACK 0 OF THE DISC JMS I FIX401 JMS I FIO01 /RETURN WILL BE TO SI SCL1, 0 JMS I RD301 /SET UP DISK PARAMETERS STA DCA BUFSTA /FUDGE TO APPEAR THAT READ WAS DONE JMP I SCL1 RD301, RD30 /EXIT ROUTINE /COMES HERE WHEN FIP HAS COMPLETED ITS TASK /FIRST, SEE IF ANY INTERNAL FILES HAVE BEEN CHANGED /THOSE THAT HAVE CHANGED MUST BE WRITTEN BACK OUT TO DISC *3400 /*** ANY DATA FIELD IS OK AT THIS POINT!! FIX0, JMS I WRT1 /MAKE SURE THE BUFFER IS EMPTY ISZ TABSTA /CHECK TABLE STATUS JMP FIX1 /NOTHING CHANGED IN TABLES TAD JOBTAB /BOTTOM OF TABLE AREA JMP FIX2 /SAVE TABLES BEFORE EXIT FIX1, ISZ SATSTA /CHECK SAT STATUS JMP FIX20 /NOTHING TO BE SAVED, EXIT TAD SATBOT /BOTTOM OF SAT FIX2, JMS I FIX401 TAD FIDEXP /GLOBAL TI "FIPDEX" DCA FLPARB+1 /MEMORY FIELD TAD C0605 DCA FLPARB /WRITE IOT JMS I FIO01 /PERFORM THE WRITE HLT /ERROR ON WRITE, FATAL /ALL DISC TABLES ARE NOW UP TO DATE (*** ANY DATA FIELD IS OK AT THIS POINT!!) FIX20, FGETJT JOBSTS DCA FIOPTR DATFLD TAD I FIOPTR AND FISIOT DCA I FIOPTR CFLD FGETJT /RESTORE USER AC JOBREG+2 DCA FIOPTR /ADDRESS OF USER'S AC TAD FIUSAC DATFLD DCA I FIOPTR CDF TAD C002 /FIP ALWAYS RUNS IN FIELD 2 SO ADD 2 TO CORTBL TAD CORTBA /GLOBAL TO "CORTBL" DCA FIOPTR /POINTS TO THIS FIELD'S ENTRY IN CORTBL JMP I .+1 FIX500, FIX50 FISIOT, -JSIOT-1 /ROUTINE TO DETERMINE IF A DEVICE IS ASSIGNED TO THIS JOB /CALLING SEQUENCE: / TAD (DEVICE NUMBER) / JMS DTE0 / 0 (SET BY DTE0 TO POINT TO ENTRY IN DEVTBL) / RETURN (DEVICE NOT ASSIGNED TO THIS JOB) / RETURN (DEVICE ASSIGNED) DTE0, 0 SPA JMP DTE10 /NON-TTY DEVICE TAD NULNM1 /CHECK FOR VALID TTY NUMBER SMA JMP DTE6 /INVALID TTY NUMBER CLL RAL /TWO WORDS PER TTY DTE4, TAD DEVEND /FIND LOCATION IN DEVTBL DTE5, CFLD DCA I DTE0 /RETURN ARGUMENT TAD I DTE0 ISZ DTE0 DCA DTE2 DATFLD TAD I DTE2 /GET POINTER TO DDB SNA /IS THERE ONE? JMP I DTE0 /NO, RETURN DCA DTE2 /YES ISZ DTE2 TAD I DTE2 /GET JOB NUMBER CIA TAD FIJOB /NUMBER OF CURRENT JOB AND P0037 SNA CLA /DOES DEVICE BELONG TO THIS JOB? ISZ DTE0 /YES JMP I DTE0 /RETURN DTE6, STA TAD DEVTBA /POINT TO DUMMY DEVTBL ENTRY JMP DTE5 DTE2, 0 NULNM1, -NULINE-1 P3777, 3777 NUDEVM, DEVTBE-JOBTBL NUDEV, JOBTBL-DEVTBE DTE10, AND P3777 TAD NUDEVM /CHECK DEVICE NUMBER FOR VALIDITY SMA JMP DTE6 /INVALID DEVICE NUMBER TAD NUDEV /GET DEVICE NUMBER BACK JMP DTE4 /GO FINISH UP LNK0, 0 /GET FILE LINKAGE TAD LNKF DCA LNK1 FGETJT LNK1, 0 DCA CFH DATFLD TAD I CFH /PTR TO FILE CONTROL BLOCK JMP I LNK0 LNKF, JOBF0 SAV1, FGETJ0, 0 CFLD TAD I FGETJ0 DCA .+4 TAD JOBDAT CIF GETJTA 0 ISZ FGETJ0 JMP I FGETJ0 SAVCRE, 0 DCA SAV1 TAD SAV1 /FILE ADDR TAD P0004 /PTR TO PROTECTION BITS IN FILE DCA SAV2 TAD I SAV2 /GET THE PROTECTION BITS AND C0020 /IS IT WRITE PROTECTED AGAINST THE OWNER? SZA CLA JMP I EXT10A /YES, RETURN WITH PROT. VIOLATION MESSAGE TAD SAV1 /NO, REDUCE THE FILE TO 0 SEGS JMS I RED11 /GO DO REDUCTION JMP I SAVCRE /RETURN RED11, RED1 EXT10A, EXT10 SAV2, CRFUFD, 1 JMS I ACC01 /IS THIS ACCOUNT 1? JMP CRFUF1 /YES IAC DCA I INDEX /FILE SIZE INITIALLY 1 JMP I CRFUFD /BACK FOR THE DATE CRFUF1, DCA I INDEX /ZERO CPU TIME JMP I .+1 /GO ZERO DEVICE TIME ALSO CRFUFR /CONVERT AN ABSOLUTE PTR INTO RETTBL TO A RELATIVE ENTRY NUMBER ENS3, 0 CIA TAD RETTBL /REL. PTR TO ADDRESS WITHIN RETTBL CIA AND P7770 /ANY POINTER WITHIN THE BLOCK IS OK CLL RTR RAR /DIVIDE BY 8 JMP I ENS3 /ROUTINE TO ASSIGN A DEVICE *3600 ASD1, TAD FIOSTK+1 SMA /TTY? JMP I LGI201 /DON'T LET HIM/HER ASSIGN TTY'S! RETURN WITH AC=7777 JMS I DTE01 /IS THIS DEVICE ASSIGNED TO THIS JOB? ASD2, 0 /SET BY DTE01 TO POINT TO PROPER ENTRY IN DEVTBL SKP JMP ASD4 /YES TAD I ASD2 /GET DDB ADDRESS FOR THIS DEVICE SZA /ZERO? JMP ASD11 /NO, SO SOMEONE HAS IT /COMES HERE IF OKAY TO MAKE THIS ASSIGNMENT CFLD /CHANGE TO CURRENT FIELD TAD ASD2 6202 /CIF FIELD 0 GETDDB /GET A BLOCK FROM THE FREE LIST AND LINK IT INTO DEVTBL JMP I LGI201 /NO BLOCK.. REDO IN CASE OF USER OTHERWISE ERROR RETURN FOR SI DATFLD TAD I ASD2 /PICK DDB ADDRESS FROM DEVTBL DCA CFH /SAVE IT TAD FIOSTK+1 AND P0037 /CLEAR BIT 0 DCA I CFH /SET TO REFLECT THE DEVICE NUMBER ISZ CFH TAD FIJOB DCA I CFH /PLUG IN THE JOB NUMBER ASD7, CFLD JMP I FIEXIT /COMES HERE IF ONE JOB ATTEMPTS TO ASSIGN AN ALREADY ASSIGNED DEVICE ASD11, IAC DCA CFH TAD I CFH SNA CMA DCA FIUSAC /DELIVER TO USER'S AC JMP ASD7 /EXIT ASD4, TAD FIOSTK+1 CLL RAL SZA CLA /PTR? JMP ASD7 /NO TAD I ASD2 CIF 00 JMS I ASDCLR /CLEAR THE READER BUFFER JMP ASD7 ASDCLR, SICLR /ROUTINE TO PERFORM ACTUAL REDUCTION /CALLING SEQUENCE: / TAD (NUMBER OF SEGMENTS TO REMAIN) / JMS RED30 / RETRIEVAL CHAIN POINTER / UFD RETRIEVAL POINTER / RETURN /FIRST TRACE THRU THE LINKED LIST OF FILE INFORMATION /RETRIEVAL BBLOCKS UNTIL WE GET TO THE ONE IN WHICH THE /NEW LAST SEGMENT IS RED30, 0 DCA RED31 /LINKAGE TO RETRIEVAL CHAIN TAD GDRETP /PICK UP RETRIEVAL POINTER JMS I GE01 /GET THIS WORD INTO CORE RED31, 0 DCA REBUFF TAD I REBUFF /PICK UP LINK TO NEXT DCA RED31 /SAVE LINK TAD WNDREM /DELETING ENTIRE WINDOW? SNA CLA JMP RED36 /YES, REMOVE LINK TO LAST WINDOW AS WELL RED37, ISZ REWNDC /AT END OF CHAIN? JMP RED30+2 /NO, KEEP SAVING DCA I REBUFF /YES, TERMINATE IT /FOUND RETRIEVAL BLOCK IN WHICH TO CHOP OFF /THE LIST OF SEGMENTS. /START DELETING THE SEGMENT NUMBERS AND RETURNING /THE ACTUAL DISC SEGMENTS TO THE POOL TAD WNDREM IAC /GET POINTER TO FIRST SEGMENT TO BE DELETED TAD REBUFF DCA REBUFF /POINTER TO FIRST SEGMENT TO REMOVE DCA SEGLIM /CLEAR SEGMENT COUNTER TAD WNDREM /NUMBER OF SEGMENTS TO LEAVE IN RET. WINDOW RED32, TAD C7771 /7 SEGMENTS PER RETRIEVAL WINDOW DCA REWNDC /SAVE COUNT DCA BUFMOD /REMEMBER TO WRITE OUT THE BUFFER RED33, TAD REDM9 DCA CFH /SET COUNT FOR SATREL DIVIDE STL STA TAD I REBUFF /PICK UP THE SEGMENT NUMBER SZL /IS IT A REAL SEGMENT JMP RED38 /NO; END OF WINDOW, END OF FILE JMS I SATREA /RELEASE IT ON SAT DCA I REBUFF /CLEAR THE CCELL ISZ SEGLIM /COUNT SEGMENT ISZ REBUFF ISZ REWNDC /END OF CURRENT RETRIEVAL WINDOW? JMP RED33 /NO, CONTINUE TAD RED31 /YES, MOVE TO NEXT SNA /END OF CHAIN? JMP RED39 /YES, EXIT RED34, DCA RED35 /NO TAD GDRETP JMS I GE01 /GET NEXT WINDOW RED35, 0 DCA REBUFF TAD I REBUFF DCA RED31 /SET UP LINK TO NEXT DCA I REBUFF /CLEAR FIRST WORD OF WINDOW ISZ REBUFF JMP RED32 /KEEP WIPING OUT RED36, STL CLA RTL /ARE WE TWO WINDOWS FROM THE END YET? TAD REWNDC SZA CLA JMP RED37 /NOT EXACTLY DCA I REBUFF /YES, CLEAR LINK TO NOW EMPTY WINDOW DCA BUFMOD /SCHEDULE WRITE JMP RED37 RED38, CLA DCA I REBUFF /CLEAR TO END OF WINDOW ISZ REBUFF ISZ REWNDC /ARE WE THERE YET? JMP RED38 /NO RED39, TAD GDRETP /GET RETRIEVAL POINTER JMS I ENS32 /CONVERT IT INTO A RELATIVE ENTRY NUMBER STL RTL /TIMES 4 PLUS 2 IAC TAD UFDTBL /POINTS TO WORD3 OF UFDTBL ENTRY DCA REBUFF TAD I REBUFF /HAS HIS/HER SEGMENT COUNT BEEN SET UP YET? SNA CLA JMP I RED30 /NO; SO JUST EXIT TAD SEGLIM /NUMBER OF SEGMENTS WE REMOVED FROM THIS FILE CIA TAD I REBUFF /SUBTRACT FROM THOSE THAT WE KNEW ABOUT DCA I REBUFF /UPDATE UFDTBL ENTRY STA DCA TABSTA /REMEMBER TO WRITE OUT THE TABLES JMP I RED30 /EXIT ENS32, ENS3 REDM9, -11 SATREA, SATREL REBUFF, 0 *4000 /RENAME ROUTINE REN0, JMS I ACC01 /IS IT ACCOUNT 1? JMP PASSQU /YES; GO CHANGE PASSWORD AND DISK QUOTA JMS I IFN01 TAD FIOSTK+1 /PICK UP INTERNAL FILE NUMBER JMS I UC01 /USER-OWNER CHECK JMP I REN1A /USER NOT OWNER, ERROR JMS I FILNAM /CHECK IF THIS NEW NAME IS IN DIRECTORY JMP I BADNAM /YES, DON'T RENAME TAD FIOSTK /PICK UP INTERNAL FILE NUMBER NOW SHIFTED TO FIOSTK JMS I GD01 /GET THIS DIRECTORY ENTRY INTO CORE DCA REENTP /POINTER TO DIRECTORY ENTRY TAD REENTP TAD P0004 DCA REPRTP /POINTER TO PROTECTION BITS TAD I REPRTP /PICK UP PROTECTION BITS AND C0020 /WRITE PROTECTED AGAINST OWNER? SZA JMP I REN1A /YES, ERROR TAD FIOSTK+2 /TRANSFER NEW NAME TO DIRECTORY SNA /IS IT A NULL NAME? JMP I BADNAM /YES, DON'T RENAME DCA I REENTP ISZ REENTP TAD FIOSTK+3 DCA I REENTP ISZ REENTP TAD FIOSTK+4 DCA I REENTP DCA BUFMOD /SCHEDULE WRITE JMP I FIEXIT /EXIT FROM FILE PHANTOM REN1A, REN1 FILNAM, USENAM BADNAM, CRF30 SEGS0, TAD I SEGCNT DCA FIUSAC JMP I FIEXIT SEGCNT, -SATSIZ+1 SIFLD, CORTBL+1 PASSQU, CDF 00 TAD I SIFLD /IS THIS REQUEST FROM SI? AND C0200 CFLD SZA JMP I REN1A TAD FIOSTK+1 /OR IS [S]HE TRYING ACCOUNT 0? SNA JMP I BADNAM /YES; ERROR JMP I .+1 PASQU0 /BUILD A RETRIEVAL POINTER GIVEN RELATIVE POSITION ON RETTBL /CALLING SEQUENCE: / TAD (RELATIVE POSITION) / JMS BLDP / RETURN (POINTER IN AC) REENTP, BLDP, 0 DCA CFH CLA CMA TAD CFH CLL RAL RTL TAD RETTBL JMP I BLDP /JMS I LINK01 /MISSING SEGMENT ADD /REPLACEMENT LINK0, 0 DCA LINK1 TAD GDRETP JMS I GE01 LINK1, 0 /GET A DIRECTORY WORD INTO CORE TAD P0003 DCA LINK2 TAD I LINK2 CIA TAD I LINK0 SZA CLA /SEARCH THROUGH UFD UNTIL WE FIND ENTRY BEING SOUGHT JMP LINK3 ISZ LINK0 TAD I LINK0 /TAKE A BLOCK OUT OF THE CHAIN DCA I LINK2 DCA BUFMOD /SCHEDULE WRITE ISZ LINK0 JMP I LINK0 REPRTP, LINK2, 0 LINK3, TAD I LINK2 JMP LINK0+1 /ROUTINE TO SET UP A UFDTBL ENTRY AS FOLLOWS: /WORD 0: PROJECT, PROGRAMMER NUMBER /WORD 1: -ACCESS COUNT /WORD 2: -DISK SEGMENT QUOTA (LOGIN) /WORD 3: ACTUAL NUMBER OF SEGMENTS OWNED. /(WORDS 1 AND 3 ARE INITIALLY SET TO 0.) /WORD 3 IS LOADED BY "CREATE," OR BY "EXTEND" IF IT HAS NOT PREVIOUSLY /BEEN LOADED. "CREATE" & "EXTEND" ALWAYS MODIFY WORD 3, "REDUCE" ONLY /MODIFIES WORD 3 IF IT IS NON-ZERO. UFQUOT, 0 DCA I INDEX /SAVE PROJECT, PROGRAMMER NUMBER DCA I INDEX /ZERO ACCESSES SO FAR TAD SEGLIM /LOGGED IN QUOTA CLL RAL /TIMES 2 TAD SEGLIM /THREE RAL /SIX RTL /TWENTY FOUR TAD SEGLIM /TWENTY FIVE CIA /NEGATE DCA I INDEX /SAVE LOGGED-IN SEGMENT QUOTA DCA I INDEX /NO KNOWN SEGMENTS AS OF YET JMP I UFQUOT /ROUTINE TO GET THE NUMBER OF A DEVICE ATTACHED TO THIS JOB /CALLING SEQUENCE: / JMS LNS0 / RETURN IF NONE AVAILABLE / NORMAL RETURN (DEVICE NUMBER IN AC) LNS0, 0 TAD DEVTBA /GLOBAL TO #DEVTBL# DCA CFH DATFLD /CDF FIELD 0 LNS4, TAD I CFH /PICK UP POINTER TO DDB SNA JMP LNS2 /DEVICE UNASSIGNED IAC DCA LNS3 /POINTER TO SECOOND WORD OF DDB TAD I LNS3 AND P0037 /PICK OFF THE JOB NUMBER OF OWNER CIA TAD FIJOB /NUMBER OF CURRENT JOB SNA CLA JMP LNS5 /THIS DEVICE IS OURS LNS2, ISZ CFH TAD CFH CMA TAD DEVOVR /GLOBAL TO "JOBTBL" SZA CLA JMP LNS4 /CONTINUE LOOKING DOWN TABLE LNS7, CFLD /MAKE SURE WE ARE IN THIS FIELD JMP I LNS0 /FOUND NOW DEVICES LNS5, TAD DEVEND CIA TAD CFH ISZ LNS0 SMA JMP LNS6 TAD LNS10 CLL RAR JMP LNS7 LNS6, TAD C4000 JMP LNS7 LNS10, DEVTBE-DEVTBL LNS3, 0 C4000, 4000 /ROUTINE TO RELEASE A DEVICE *4200 REL00, 0 JMS I DTE01 /IS THIS DEVICE ASSIGNED TO THIS USER? REL5, 0 /SET BY DTE0 TO POINT TO DEVTBL ENTRY FOR THIS DEVICE JMP REL13 /NO, SO DON'T RELEASE IT TAD I REL5 DCA REL6 /SAVE ADDRESS OF DDB FOR LATER TAD REL6 TAD P0003 /POSITION OF TIME IN DDB DCA REL2 TAD I REL2 /GET TIME ASSIGNED CIA DCA REL2 /-TIME ASSIGNED CDF TAD I RELCK1 /GET TIME NOW RTL RTL AND P0007 /JUST SIGNIFICANT PART OF LOW ORDER TIME DCA REL3 TAD I RELCK2 DATFLD RTL RAL AND P7770 /JUST INSIGNIFICANT PART OF HI ORDER TAD REL3 /TIME AT RELEASE CLL TAD REL2 /-TIME AT ASSIGNMENT DCA REL2 /TIME WE OWNED IT TAD REL2 SNL /GONE THRU MIDNITE WHILE ASSIGNED? TAD RELCON /YES, FUDGE TO PROPER VALUE SZA JMS I DVT01 /RECORD TIME SINCE WE USED A MEASURABLE AMOUNT STL TAD REL5 TAD RELCDR /IS IT A CARD READER OR DECTAPE OR RK05? SPA RAR /NO - IS IT A KEYBOARD OR THE PTR? SNL JMP REL11 /EITHER KEYBOARD, PTR, CDR, DTA, OR RK05 TAD RELREG /EITHER PTP OR LPT REL8, DCA REL6 /ENTER HERE FROM REL12 FOR TELEPRINTER STA TAD I REL5 DCA INDEX /POINT TO WORD 0 OF DDB (AUTOINDEXED) TAD I INDEX /CHECK STATUS IF TELEPRINTER SPA CLA JMP REL4 /[S]HE'S IN THE ^S CONDITION - FLUSH HIM/HER OUT DCA I INDEX /CLEAR THE JOB NUMBER ISZ INDEX ISZ INDEX TAD I INDEX /CHECK FILL POINTER SZA CLA JMP REL9 /STILL BUSY - LET "CONOUT" RELEASE IT TAD REL6 SZA CLA /ASSIGNABLE DEVICE? JMP REL7 /YES REL4, TAD I REL5 CIF 00 JMS I RELTBL /MAKE SURE THE BUFFER IS CLEAR DATFLD TAD I REL5 /RELEASE THE DDB JMS I RETBK1 CLA DATFLD DCA I REL5 REL9, CFLD JMP I REL00 REL7, CIF 20 /INHIBIT INTERRUPTS TAD I REL6 CLL RAL SNA JMP REL4 SPA STL RAR DCA I REL6 JMP REL9 REL11, SMA CLA /IS IT A KEYBOARD OR THE PTR? JMP REL12 /NO TAD REL6 CIF 00 JMS I RELTBL /FLUSH OUT THE BUFFER REL12, TAD REL6 JMS I RETBK1 /RELEASE THE DDB CLA DATFLD DCA I REL5 /REMOVE FROM DEVTBL TAD DEVEND CIA TAD REL5 SMA CLA JMP REL9 ISZ REL5 JMP REL8 REL13, CDF TAD I JOB AND C0200 CFLD SZA CLA /CALLED BY SI?? JMP I LGI201 /YES, INDICATE ERROR WITH AC=-1 JMP I REL00 /NO, UUO CALL RELREG, OUTREG+NULINE+3 RELCDR, -DEVTBE-4 DVT01, DVT0 REL2, 0 REL3, 0 RELCK1, CLK1 RELCK2, CLK2 RELCON, 3227 /FUDGE FOR MIDNIGHT OVERFLOW RELTBL, SICLR P0100, 100 FIXSCH, 0 IAC DCA REL5 TAD I REL5 AND P0100 SNA CLA JMP I FIXSCH TAD DEVOVR CIA TAD INDEX FIXOUT, CIF CDF DCA I FIPJOB WAIT EXCEED, 215;212;"[;" ;" ;" ;" ;" ;" ;" ;"E;"X;"C;"E;"E;"D;"I;"N;"G " ;"D;"I;"S;"K;" ;"Q;"U;"O;"T;"A;"];215;212;0 /COMPLETION OF LOGOUT ROUTINE /REMOVES JOB FROM PERMANENT MONITOR TABLES /MUST BE DONE LAST, SINCE WE NEED THE JOB STATUS BLOCKS /TO INDICATE ANY ERRORS IN THE FIP I/O LGO4, TAD LGO500 /RESTORE THE FIP EXIT CFLD DCA I LGOFIX TAD FIJOB /SEE IF [S]HE OWNS ANY CORE FIELDS CIF CORE /SEARCH CORE TABLE FOR HIM/HER FIP SI CJOB JMP LGO5 /NO; NOTHING TO RELEASE AND P0007 /YES; RELEASE THE FIELD TAD CORTBA DCA CFW /POINTS TO ENTRY IN CORTBL CDF DCA I CFH /ZERO THE ENTRY LGO5, TAD FIJOB /RETURN STATUS BLOCKS TAD DEVOVR /START OF JOB TABLE (END OF DEVTBL) DCA LGO6 /POINTS TO JOB TABLE ENTRY DATFLD TAD I LGO6 /GET ADDRESS OF JOB STATUS JMS I LGOBLS /RETURN STATUS DATFLD DCA I JOBDAT /CLEAR JOBDAT DCA I LGO6 /CLEAR POINTER IN JOBTABLE CDF DCA I JOB /CLEAR JOB (SO SAVJOB WON'T SAVE US) JMP I .+1 /AND NOW GO DO FIX50 LGO500, FIX50 LGOBLS, RETBLS LGOFIX, FIX500 LGO1, TAD FIOSTK+1 /LOGOUT WITH AC=0? SZA CLA JMP I LGI201 /NO, SO IT'S AN ERROR TAD FIJOB TAD JOBTAB DCA CFH /GET HIS/HER PROJ-PROG # TAD I CFH CIA DCA FIOSTK+2 /SAVE HIS/HER # TAD JOBTAB DCA INDEX /INITIALIZE TO START OF TABLES TAD LGOMAX /-JOBMAX DCA FIOSTK+3 /COUNT OF JOBS TO CHECK DCA FIOSTK+4 /COUNT OF MATCHES TAD I INDEX TAD FIOSTK+2 /COMPARE SNA CLA ISZ FIOSTK+4 /EXACT MATCH - INDEX COUNT ISZ FIOSTK+3 /DONE? JMP .-5 /NO STA /YES - RETURN # OF MATCHES -1 TAD FIOSTK+4 DCA FIUSAC JMP I FIEXIT /AND AWAY LGOMAX, -JOBMAX OPN11, 0 DCA OPN13 TAD FIOSTK+2 /GET RETRIEVAL POINTER OF UFD BEING ACCESSED CIA TAD RETTBL /IS IT THE MFD? SNA CLA JMP OPN14 /MFD OR UFD, READ OK/WRITE NEVER OK JMS I ACC01 /IS [S]HE THE SYSTEM MANAGER? JMP OPN12 /YES; SKIP PROTECTION CHECK TAD I OPN11 /GET PROPER TEST BITS AND P0007 /JUST TEST FOR READ PROTECTION FIRST AND I OPN13 /COMPARE AGAINST FILE'S PROTECTION WORD SZA CLA JMP I OPNPRA /PROTECTION ERROR TAD I OPN11 /READ OK, GET TEST BITS FOR WRITE CLL RAL /CHECK FOR WRITE PROTECTION AND I OPN13 OPN12, CMA DCA LGO6 /-1 IF OK TO WRITE TAD I ZDS1 /SOME MORE CONDITIONS TO TEST DCA OPN13 TAD FIOSTK+2 JMS I OPN16 /IS [S]HE THE ONLY PERSON TO OPEN THE FILE? OPN13, 0 JMP OPN14 /NO TAD BASSWT CIA DATFLD SZA DCA I BASWIN /MAKE SURE THE BASIC WINDOW GETS LOADED CFLD ISZ LGO6 /IS [S]HE ALLOWED TO MODIFY IT? OPN14, TAD P0004 /NO, SO WRITE PROTECT BIT IS ON ISZ OPN11 /SKIP ON RETURN JMP I OPN11 OPN16, ENS0 OPNPRA, OPNPRE LGO6, FIX40, 0 DCA FLPARB+3 TAD FLPARB+3 DCA FLPARB+5 CLA CMA TAD FLPARB+5 DCA FLPARB+4 JMP I FIX40 *4600 TTYTBA, TTYTBL CLK1A, CLK1 CLK2A, CLK2 RESET, DCA I CFH FGETJT JOBACC DCA ADDR DATFLD TAD FIOSTK+2 DCA I ADDR /PLUG HIS/HER ACCOUNT # INTO HIS JOB STATUS BLOCKS TAD FIJOB /GET JOB # TAD TTYTBA DCA ADDR TAD I ADDR /GET LINE # CLL RAL TAD DEVTBA /FIND THE DDB DCA ADDR TAD P0003 TAD I ADDR DCA ADDR CDF TAD I CLK1A RTL RTL AND P0007 DCA CFH TAD I CLK2A RTL RAL AND P7770 TAD CFH DATFLD /NOW RESET THE DCA I ADDR /ASSIGN TIME JMP I .+1 /THEN EXIT TABOUT BASCO0, 0 JMS I IFN01 /JUST RETURN INTERNAL FILE # IN FIOSTK+1 TAD FIOSTK+1 JMS I CL01 /CLOSE ANY FILE THAT IS OPEN TAD FIOSTK+3 /MAY BE SNA /IS IT A NULL FILE NAME? JMP I OPN3A /YES, ERROR RETURN TAD OPN3A+1 /COMPARE BA SZA CLA JMP BASSET /NO MATCH TAD FIOSTK+2 /IS ACCT # 2? SNA JMS I JBLD0 /WHAT'S HIS/HER ACCOUNT? CLL RTR SNA CLA TAD FIOSTK+4 /COMPARE SI TAD OPN3A+2 SNA CLA TAD FIOSTK+5 TAD OPN3A+3 /COMPARE C SNA CLA CMA /IF BASIC, BASSWT=-1 BASSET, DCA BASSWT /IF NOT, BASSWT=0 TAD FIOSTK+1 JMS I EBLD0 /GET PTR TO ENTTBL WORD 1 RELATIVE PTR WORD 2 ADDRESS IN UFD JMP I BASCO0 /RETURN OPN3A, OPN3 -4241 /-BA -6351 /-SI -4300 /-C CLOBAS, 0 JMS I RETBK1 DCA BAS3 TAD BAS3 CIA TAD BASWIN SNA CLA JMP CLOBA1 TAD BAS3 JMS I RETBK1 CLA SKP CLOBA1, CLA CMA JMP I CLOBAS BAS0, 0 DCA BAS1 /SAVE BUFFER ADDRESS OF RETRIEVAL WINDOW TAD BASWIN /BASIC WINDOW ADDRESS DCA ADDR /GET BUFFER ADDRESS READY BAS5, TAD BAS1 / DCA BAS2 TAD C7771 DCA BAS3 /COUNT OF 7 SEGS PER WINDOW BAS4, ISZ BAS2 CFLD TAD I BAS2 /PICK UP THE SEG # ISZ ADDR SNA JMP BAS6 DATFLD DCA I ADDR /SAVE IT IN WINDOW ISZ BAS3 /COUNT JMP BAS4 /STILL IN SAME BLOCK CFLD TAD I BAS1 /CHANGE THE BLOCK SNA JMP BAS6 /NO MORE SEGMENTS DCA BAS1 TAD FIOSTK+2 /GET THIS BLOCK OF UFD IN BUFFER JMS I GE01 BAS1, 0 DCA BAS1 /SAVE THE BUFFER ADDRESS CONTAINING THE NEEDED BLOCK JMP BAS5 /CONTINUE BAS6, SNA TAD I BAS1 SZA CLA JMP I BAS123 /BASIC MUST BE 39 SEGMENTS OR LESS TO USE SPECIAL WINDOW TAD ADDR SMA CLA JMP .+5 DATFLD DCA I ADDR ISZ ADDR JMP .-2 DATFLD CLA CMA DCA I BASWIN /-1 IN FIRST WORD TO MARK BASIC WINDOW JMP I BAS0 ADDR, 0 BAS2, 0 BAS3, 0 BAS123, OPN123 /ROUTINE TO LET SYSTEM MANAGER CHANGE PASSWORDS AND DISK QUOTAS UFDNAM, RTABLE 0 PASQU0, DCA UFDNAM+1 /SAVE ACCOUNT NUMBER TO SEARCH FOR CMA JMS I DS01 /SEARCH MFD FOR THIS ACCOUNT UFDNAM JMP PASNOT /ACCOUNT NOT FOUND IN MFD DCA INDEX /SAVE POINTER TO OLD PASSWORD TAD FIOSTK+2 /FIRST TWO CHARACTERS OF NEW PASSWORD DCA I INDEX /SAVE IN MFD NAME BLOCK TAD FIOSTK+3 /SECOND TWO CHARACTERS OF NEW PASSWORD DCA I INDEX /SAVE IN MFD ISZ INDEX /SKIP PAST LINK TO NEXT UFD TAD FIOSTK+4 /GET NEW DISK QUOTA DCA I INDEX /SAVE NEW QUOTA DCA BUFMOD /REMEMBER TO WRITE OUT THE MFD SEGMENT TAD FIOSTK+1 /SEE IF THIS ACCOUNT IS CURRENTLY IN THE UFDTBL JMS I UTS01 JMP I FIEXIT /NOT THERE ISZ UTPRNU /POINTS TO -QUOTA ENTRY STA TAD FIOSTK+1 /IS IT THE QUOTA FOR THE "GRACE SPACE"? SNA CLA JMP PASQU1 /YES TAD FIOSTK+4 /TRIM OFF THE LOGOUT PORTION OF THE QUOTA AND P0077 DCA FIOSTK+4 TAD FIOSTK+4 CLL RAL /MULTIPLY BY TWO TAD FIOSTK+4 /THREE RAL /SIX RTL /TWENTY FOUR PASQU1, TAD FIOSTK+4 /TWENTY FIVE; OR ACTUAL COUNT IF FOR "GRACE SPACE" CIA /NEGATE THE RESULT DCA I UTPRNU /SAVE AWAY IN THE UFDTBL JMP I .+1 TABOUT PASNOT, TAD P7000 /RETURN FILE NOT FOUND DCA FIUSAC JMP I FIEXIT /SUBROUTINE TO FIND AN EMPTY DIRECTORY ENTRY /CALLING SEQUENCE: / TAD (POINTER TO UFD RETRIEVAL INFORMATION) / JMS DE0 / BAD RETURN (COULD NOT FIND A FREE ENTRY) / NORMAL RETURN (POINTER TO ENTRY IN AC) DE0, 0 DCA DERETP /SAVE RETRIEVAL PTR DCA DE2 /ZERO THE ADDRESS IN UFD TAD BUFSTA /IS THERE A SEGMENT IN THE BUFFER? SMA CLA JMP DE7 /NO, SO START FROM THE BEGINNING TAD I GERETA /GET THE SEGMENT IN CORE CMA DCA NSEGCR TAD DERETP /GET RETRIEVAL PTR FOR INCREMENT DCA UFDPTR DE5, TAD I UFDPTR SNA /IS THERE A SEGMENT? JMP DE7 /NO, START FROM 0 LOC IN UFD TAD NSEGCR /YES, DOES IT AGREE WITH THE SEGMENT IN CORE? SNA CLA JMP DE6 /YES, START SEARCHING AT THIS POINT TAD DE2 /NO, INCREMENT THE ADDR TAD C0400 DCA DE2 ISZ UFDPTR /POINT TO NEXT SEGMENT IN RETRIEVAL BLOCK JMP DE5 /GO BACK DE7, DCA DE2 /INDICATE THAT SEARCH IS FROM WORD 0 STA DE6, DCA I UFD01 /SAVE SECOND PASS FLAG DE1, TAD DERETP JMS I GE01 /GET ENTRY INTO CORE DE2, 0 SNA /SKIP IF ENTRY EXISTS JMP DE4 /DID NOT EXIST, EXTEND UFD DCA DEBUFP TAD I DEBUFP /FIRST WORD OF ENTRY SZA CLA JMP DE3 /NOT EMPTY, LOOK AT NEXT ENTRY ISZ DEBUFP /ZERO COULD MEAN END OF STRING OF RETRIEVAL INFORMATION BLOCKS TAD I DEBUFP /LOOK AT SECOND WORD OF ENTRY SZA CLA /IF ZERO, EMPTY ENTRY JMP DE3 /NOT EMPTY, KEEP LOOKING TAD DE2 /PICK UP ENTRY POINTER SNA /ENTRY 0 NEVER AVAILABLE JMP DE3 ISZ DE0 /POINT TO NORMAL RETURN JMP I DE0 DE3, TAD C0010 /INCREMENT TO NEXT ENTRY TAD DE2 DCA DE2 /SAVE NEXT ENTRY INDEX JMP DE1 /LOOK AT NEXT ONE DE4, ISZ I UFD01 /HAVE WE TRIED FROM THE BEGINNING YET? JMP DE7 /NO, WELL TRY IT THEN... TAD DERETP JMS I UFD01 /TRY EXTENDING THE UFD JMP I DE0 /TOO BAD, CAN'T EXTEND UFD JMP DE1 /NOW WE HAVE PLENTY OF ROOM DEBUFP, 0 UFD01, UFD0 DERETP, 0 UFDPTR, 0 GERETA, RDCURR NSEGCR, 0 /ROUTINE TO OUTPUT QUOTA EXCEEDED MESSAGE EXTEL0, 0 DATFLD TAD FIJOB /CURRENT JOB NUMBER TAD TTYTAB /POINTS AT POSITION IN TTYTBL DCA DE0 TAD I DE0 /GET CONSOLE NUMBER FOR THIS JOB STL RAL /TIMES 2 PLUS 1 TAD DEVTBA /INDEX TO OUTPUT DDB CDF DCA I CONDVA /STORE FOR FIELD 0 PRINT ROUTINE CFLD TAD EXTMES /GET MESSAGE POINTER DCA INDEX EXTEL1, TAD I INDEX /GET CHARACTER OF THE MESSAGE SNA /ANY LEFT? JMP I EXTEL0 /NO; SO GO EXTEND CIF CDF 00 DCA I FICHAR /STORE FOR PRINT OUT ROUTINE CFLD PRINT /SEND MESSAGE #[EXCEEDING DISK QUOTA]# JMP I EXTEL0 /RAN OUT OF SPACE IN THE OUTPUT BUFFER (TOO BAD!) JMP EXTEL1 /BACK FOR NEXT CHARACTER TTYTAB, TTYTBL CONDVA, CONDBA EXTMES, EXCEED-1 FICHAR, TTCHAR /ROUTINE TO CLEAR ALL CPU AND DEVICE TIME ACCUMULATORS IN THE MFD /THIS IS USED BY THE #RESET# FUNCTION IN THE CUSP #CAT# LGRES0, CLA IAC /SET RESET FLAG IN DIRECTORY SEARCH ROUTINE DCA I RETBK1 TAD RETBK1 DCA EXQ1 /SET POINTER SO FLAG WILL CLEAR ON COMPLETION TAD RETTBL DCA GDRETP /SET RETRIEVAL POINTER JMS LOQUO /GO DO THE RESET CMA /SHOULD RETURN A ZERO IN AC JMP EXTQU1 /ROUTINE TO COUNT TOTAL SEGMENTS OWNED BY A UFD AND /SAVE THE RESULT IN WORD 3 OF THE UFDTBL ENTRY FOR THE RESPECTIVE UFD /CALL: / EXQ1 POINTS TO WORD 3 OF CORRECT UFDTBL ENTRY / JMS LOQUO / RETURN (ENTRY 3 LOADED, TOTAL ALSO IN AC) EXQ3, LOQUO, 0 DCA WNDREM /FUDGE A FILE NAME BEGINNING WITH TWO SPACES JMS I DS01 /SEARCH DIRECTORY TO DETERMINE SEGMENT COUNT GDRETP /(HOPE NO ONE SCRAMBLES LOC. 23-26 ON PAGE 0!!) CLA SKP /GOOD - COULDN'T FIND SUCH A FILE JMP I DIRBAD /FOUND IT! OOPS! TAD SEGLIM /GET THE TOTAL FROM THE DIRECTORY SEARCH DCA I EXQ1 /SAVE IN UFDTBL TAD FIOSTK+1 /INTERNAL FILE NUMBER? SMA /IF THIS IS NOT A "RESET" WE MUST RELOAD JMS I GD01 /THE CORRECT DIRECTORY SEGMENT DCA REL6 /SAVE POINTER TO NAME BLOCK TAD SEGLIM /RETURN WITH CURRENT TOTAL JMP I LOQUO EXTQU8, CLA /WE'VE BEEN HERE BEFORE FOR THIS GUY CFLD TAD EXQ2 /WILL THIS EXTEND CARRY TAD I EXQ1 /THIS FILE ACROSS THE QUOTA BOUNDARY AGAIN? SMA SZA CLA /(I.E. HAS [S]HE REDUCED SINCE LAST EXTEND?) JMP EXTQU9 /NO; [S]HE'S STILL ABOVE QUOTA, EXTEND QUIETLY EXTQU6, TAD EXFILE /ADDRESS WITHIN MESSAGE TO STORE FILE NAME DCA INDEX JMS EXTNAM /CHAR 1 & 2 OF FILE NAME JMS EXTNAM /CHAR 3 & 4 OF FILE NAME JMS EXTNAM /CHAR 5 & 6 OF FILE NAME JMS I EXTELL /NOTIFY USER THAT QUOTA IS BEING EXCEEDED EXTQU9, CLA JMP I EXTQU0 /EXIT TO EXTEND FILE AS REQUESTED EXTQU5, TAD FIOSTK+2 /NUMBER OF SEGMENTS [S]HE WON'T GET EXTQU1, DCA FIUSAC /PASS RESULT BACK TO THE USER JMP I FIEXIT /ROUTINE TO CHECK LOGIN QUOTA BEFORE EXTENDING A FILE EXTQU0, 0 TAD GDRETP /COMPARE RETRIEVAL POINTER CIA TAD RETTBL /AGAINST THE MFD'S ENTRY SNA CLA /IS IT FROM THE SYSTEM MANAGER? JMP I VIOLAT /GET OUT QUICK, BEFORE [S]HE DESTROYS THE SYSTEM TAD FIOSTK+2 /NUMBER OF SEGMENTS TO BE ADDED SPA /IS [S]HE BEING REASONABLE? JMP EXTQU1 /NO - [S]HE DESERVES TO FAIL! CLL CIA TAD I SATSEG /ARE THERE THAT MANY SEGMENTS LEFT ON THE SYSTEM? SNL CLA JMP EXTQU5 /NO; SO DON'T GIVE ANY TAD GDRETP /RETRIEVAL POINTER JMS I ENS33 /CONVERT TO RELATIVE ENTRY NUMBER STL RTL /TIMES FOUR PLUS TWO TAD UFDTBL /POINTS AT -LOGIN QUOTA DCA EXQ1 /SAVE POINTER TAD I EXQ1 /GET NEGATIVE QUOTA DCA EXQ2 /AND SAVE ISZ EXQ1 /POINTS AT CURRENTLY OWNED COUNT TAD I EXQ1 /GET HIS/HER PRESENT TOTAL SNA /HAS THE COUNT BEEN SET UP YET? JMS LOQUO /NO; GO FIGURE IT OUT TAD FIOSTK+2 /ADD THE NUMBER [S]HE WANTS TAD EXQ2 /AND SUBTRACT FROM QUOTA SPA SNA /WILL THIS EXCEED THE QUOTA FOR THIS ACCOUNT? JMP EXTQU9 /NO; GO EXTEND TAD I GRACE /WILL IT GO BEYOND THE #GRACE SPACE#? SMA SZA CLA JMP EXTQU5 /YES; DON'T BOTHER EXTENDING TAD FIOSTK+1 /SEE IF THIS FILE IS ALREADY IN THE GRACE AREA JMS I LNK01 /GET POINTER TO FILE CONTROL BLOCK TAD FILPRP /POINT TO STATUS WORD DCA EXQ3 DATFLD TAD I EXQ3 /GET CURRENT STATUS FOR THIS FILE RAR SZL /IS THIS FILE IN THE GRACE AREA? JMP EXTQU8 /MAYBE; SEE IF [S]HE'S REENTERING STL RAL /SET GRACE BIT DCA I DXQ3 CFLD JMP EXTQU6 /SEND MESSAGE, THEN GO EXTEND /ROUTINE TO PLANT FILE NAME INTO "EXCEEDING QUOTA" MESSAGE EXTNAM, 0 TAD I REL6 /GET PART OF FILE NAME RTR RTR RTR AND P0077 /SAVE LEFT BYTE TAD P0240 /CONVERT TO ASCII DCA I INDEX /STORE IN THE MESSAGE AREA TAD I REL6 /NOW FOR THE RIGHT BYTE AND P0077 TAD P0240 /CONVERT TO ASCII DCA I INDEX /SAVE RIGHT BYTE ISZ REL6 /POINT TO NEXT CHARACTER JMP I EXTNAM /ROUTINE TO CHECK FOR THE SAFE REDUCTION OF A UFD /TWO CONDITIONS MUST BE MET: / THE ACCOUNT CANNOT BE IN USE TO ANYONE / THE ACCOUNT MUST HAVE AN EMPTY DIRECTORY EXQ2, REDUF0, 0 TAD GDRETP /GET RETRIEVAL POINTER CIA TAD RETTBL /IS [S]HE TRYING TO REDUCE A UFD? SZA CLA JMP I REDUF0 /NO; LET HIM/HER REDUCE NORMAL FILES TAD I REL6 /GET THE ACCOUNT NUMBER OF THE UFD IN QUESTION JMS I UTS01 /LOOK IT UP IN THE UFD TABLE JMP REDUF1 /NOT THERE - GOOD CLA TAD C4400 /TELL HIM "FILE IN USE" JMP EXTQU1 REDUF1, TAD I REL6 /GET THE ACCOUNT NUMBER OF THE UFD TO BE DELETED JMS I UFO01 /LOAD ITS RETRIEVAL WINDOW INTO RTABLE JMP EXTQU5 /COULDN'T; PAS HIS/HER OWN AC BACK AS AN ERROR INDICATION JMS I BLDP1 /MAKE A RETRIEVAL POINTER DCA GDRETP /SAVE IT FOR THE SEARCH ISZ EXQ1 /POSITION UFDTBL POINTER FOR THIS ACCOUNT ISZ EXQ1 /TO POINT TO THE SEGMENT ACCUMULATOR JMS LOQUO /SEE IF THIS UFD STILL CONTAINS FILES CLL STA RTL /AC=-3 TAD EXQ1 /POSITION WE'VE BEEN ASSIGNED ON UFDTBL JMS I TF01 /FREE THE POSITION TAD I EXQ1 /DID [S]HE OWN ANY SEGMENTS? SZA CLA JMP I VIOLAT /STILL SOME FILES IN THERE! STA DCA FIOSTK+2 /FORCE HIM/HER TO COMPLETELY DELETE THIS UFD JMP I REDUF0 VIOLAT, PRT1+1 ENS33, ENS3 SATSEG, -SATSIZ+1 EXFILE, EXCEED+2 EXTELL, EXTEL0 P0240, 240 GRACE, UTABLE+2 $%&$%&$%&$%&$%&$%&$%&$%&$%&$%&$%&$%&$%&$%&$%&$%&$%&$