From 810f5f7c14255a049863901d57e245dca2298aa7 Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Tue, 13 Feb 2018 21:07:57 +0100 Subject: [PATCH] Add ARCDEV 23 for old format. --- src/syseng/arcdev.23 | 3447 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 3447 insertions(+) create mode 100644 src/syseng/arcdev.23 diff --git a/src/syseng/arcdev.23 b/src/syseng/arcdev.23 new file mode 100644 index 00000000..965a199e --- /dev/null +++ b/src/syseng/arcdev.23 @@ -0,0 +1,3447 @@ +TITLE ARCDEV -- BOJ HANDLER FOR ARCHIVE DEVICE + + +; SUMMARY OF ARCDEV ROUTINES + +; DIRMAP - MAP IN DIRECTORY OF ARCHIVE + +; OPNARC - OPEN ARCHIVE - EXPECTS OPEN MODE IN A - IF OPEN FAILS +; BECAUSE FILE LOCKED IN KEEPS TRYING AT HALF SECOND INTERVALS. + +; BLTSCR - BLT A COPY OF THE DIRECTORY (WHICH SHOULD ALREADY BE MAPPED IN) +; INTO THE SCRATCH AREA STARTING AT BLOCK3 (AFTER MAPPING IN +; A SCRATCH BLOCK + +; BLTBCK - BLT A COPY OF DIRECTORY FROM BLOCK3 BACK TO DIRECTORY AREA +; THEN RELEASE SCRATCH BLOCK + +; RETRY - SLEEP 1/2 SECOND THEN REEXECUTE INTSTRUCTION BEFORE PUSHJ + +; DSCBPT - RETURN BYTE POINTER IN A TO DESCRIPTOR AREA OF FILE WHOSE +; NAME AREA IS POINTED TO BY Q + +; DSCALO - TAKES BYTE COUNT0 IN B AND ALLOCATES THAT MANY BYTES IN +; DESCRIPTOR AREA FOR FILE WHOSE NAME AREA IS POINTED BY Q. +; UPDATES NAME AREA. + +; FBTALO - ALLOCATE A FBAT ENTRY - RETURNS INDEX IN A + +; FBTFRE - TAKES FBAT INDEX IN A - FREES THAT ENTRY + +; BLKALO - ALLOCATES A DATA BLOCK - TAKES FIRST ONE FROM CHAIN. IF CHAIN +; IS EMPTY IT EXTENDS FILE. LEAVES ALLOCATE BLOCK MAPPED INTO +; DATA AREA. RETURNS OFFSET FROM DATAB1 OF BLOCK HEADER IN A + +; BLKFRE - TAKES IN A AN OFFSET FROM DATAB1 AND RETURNS BLOCK AT THAT +; ADDRESS TO FREE CHAIN. + +; FILFRE - TAKES THE FILE WHOSE NAME AREA IS POINTED AT BY Q AND +; RELEASES ALL OF ITS DATA BLOCKS AND ITS FBAT ENTRY. + +; ENDFRE - TAKES A WORD COUNT IN A AND RETURNS THAT MANY WORDS FROM +; THE END OF THE CURRENT BLOCK TO THE FREE CHAIN + +; MAPDBL - TAKES A DISK ACCESS POINTER IN A AND MAPS IN THE BLOCK THAT +; STARTS AT THAT ADDRESS. IT WILL RETURN IN A THE OFFSET FROM +; DATAB1 WHERE THE BLOCK CAN BE FOUND. + +; NOWIDX - GUARANTEES THAT Q POINTS TO THE NAME AREA OF THE FILE THAT +; IS CURRENTLY BEING HACKED. + +; NEWBLK - ATTEMPTS TO MAP IN NEXT BLOCK IN A FILES CHAIN (AFTER THE +; ONE CURRENTLY MAPPED IN. IF THERE IS NO NEXT BLOCK AND THE +; FILE IS OPEN FOR WRITING IT CREATES ANOTHER BLOCK AT THE +; END OF THE SUB-FILE. IF THERE IS NO NEXT BLOCK AND THE SUB-FILE +; IS OPEN FOR READING, THEN NEWBLK FAILS TO SKIP. + +; PAGE 13 - CONTAINS ADDRESSES TO JUMP TO TO REPORT ERRORS - THESES +; ARE NOT___ PUSHJED TO. + +; PAGE 14 - CONTAINS THE CODE USED TO LOAD THE OLD ARC DEVICE HANDLER +; IF IT IS NEEDED. + +; PAGE 15 - CONTAINS ALL THE LOCK ROUTINES - THEY ARE OBVIOUS + +; FIOTO - INSURE THAT THERE IS A BLOCK CURRENTLY MAPPED IN FOR WRITING. +; CREATES ONE IF NOT. RETURNS CURRENT OFFSET POINTER WITHIN +; DATAB1 (TO NEXT DATA WORD). + +; LENADJ - TAKES OLD LENGTH IN A - NEW LENGTH IN "LENGTH" - ADJUSTS +; NAME AND DESCRIPTOR AREAS OF FILE IF CHANGES ARE NEEDED. + +; THE REST OF THE SECTIONS OF CODE SHOULD BE FAIRLY OBVIOUS BY NAME. + + +; ARCHIVE FORMAT + + +; FIRST BLOCK LOOKS ALMOST EXACTLY LIKE A DISK DIRECTORY EXCEPT FOR +; THE FIRST FOUR WORDS: + +; WORD 0 - ALWAYS -1 TO DISTINGUISH FROM OLD ARCHIVES +; WORD 1 - "UDNAMP" RELATIVE POINTER WITHIN DIRECTORY TO +; START OF FIRST NAME AREA BLOCK +; WORD 2 - "UDESCP" BYTE NUMBER OF NEXT AVAILABLE BYTE IN +; DESCRIPTOR AREA +; WORD 3 - GC TAG - SYSTEM PACKED DATE/TIME OF LAST REARRANGEMENT +; OF DIRECTORY (E.G. DELETION, INSERTION, GARBAGE COLLECTION) + +; ONLY OTHER DIFFERENCE FROM STANDARD DISK DIRECTORY IS IN 5TH WORD +; OF EACH NAME BLOCK. DISK USES LEFT HALF FOR REFERENCE DATE, DOESN'T +; USE RIGHT HALF. ARC USES LEFT HALF FOR REFERENCE DATE, USES RIGHT HALF +; FOR COUNT OF NUMBER OF OPENS FOR READING. + +; SECOND BLOCK: + +; WORD 2000 - ACCESS POINTER TO FIRST BLOCK IN FREE BLOCK CHAIN +; (0=>CHAIN IS EMPTY) +; WORD 2001 - NUMBER OF FREE BLOCKS IN ENTIRE ARCHIVE +; WORD 2002 - NUMBER OF FREE WORDS IN ENTIRE ARCHIVE +; WORD 2003 - NUMBER OF BLOCKS IN USE IN ENTIRE ARCHIVE +; WORD 2004 - NUMBER OF WORDS IN USE IN ENTIRE ARCHIVE +; WORD 2005 - RELATIVE POINTER (RELATIVE TO 2005) TO NEXT AVAILABLE +; FBAT ENTRY (0=>FBAT IS FULL) +; WORDS 2006-<2005+200.> - THE FBAT - EACH ENTRY POINTS TO +; THE FIRST DATA BLOCK IN A FILE. +; WORDS <2005+200.>-EOF - DATA BLOCKS + +; A DATA BLOCK: + +; HEADER - 4.9 BIT - 1=>BLOCK IS FREE +; 4.8 BIT - 1=>LAST BLOCK IN FILE CHAIN +; 4.9,4.8 BITS BOTH 1 => SINGLE WORD OF GARBAGE +; 4.7 BIT - UNUSED +; 4.6-3.5 - LENGTH-1 OF DATA AREA (NOT INCLUDING HEADER AND TRAILER) +; 3.4-1.1 - DISK ADDRESS OF NEXT DATA BLOCK IN THE CHAIN + +; TRAILER - IDENTICAL TO HEADER EXCEPT +; 3.4-1.1 - DISK ADDRESS OF PREVIOUS DATA BLOCK IN THE CHAIN + + +; This file contains the basics needed to write a JOB device handler. +; It should be .INSERTed by the file containing the device specific code. +; It defines that startup code, a few .CALL blocks, a stack, an +; interrupt handler, etc. For full details, see the PTDD on the +; JOB device. + +; The file containing the device specific code must supply the following: + +; STOPER an eight word table. Entry i contains the address +; of the code that handles op-code i. If a particular +; op-code is not handled, put the address BADOP in its +; table slot. + +; CALCNT a variable whose value is set (via ==A) to the total +; number of .CALL names that the handler knows about. + +; CALNAM a table CALCNT words long. Entry i contains the sixbit +; name of a .CALL operation. + +; CALXCT a table CALCNT words long. Entry i contains the address +; of the code that handles the operation whose name is +; given in in slot i of CALNAM. + + +;AC DEFS + +A=1 +B=2 +C=3 +D=4 +E=5 +TT=6 +I=7 +Q=10 +J=11 +R=12 +W=13 +H=14 +P=15 ;DO NOT CHANGE! ;PDL POINTER +T=16 ;" +U=17 ;" ;USER INDEX + +BOJC==1 +MFDI==3 + +XXXX==. + +LOC 42 + JSR TSINT + +LOC XXXX + + +ARC==2 ; OPEN ARCHIVES ON CHANNEL 2 + +LOC 77 +SIXBIT /ARCDEV/ +DEVICE: 0 ; DEVICE HE DID THE OPEN ON +FNAME1: 0 ; FIRST NAME OF OPEN SUB-FILE +FNAME2: 0 ; SECOND NAME OF OPEN SUB-FILE +DIRECT: 0 ; DIRECTORY ARCHIVE LIVES IN +POSPTR: 0 ; ACCESS POINTER +OPMODE: 0 ; MODE OF OPEN +CRUNAM: 0 ; CREATOR OF THIS ARCDEV +CRJNAM: 0 ; JNAME OF CREATOR OF THIS ARCDEV +LENGTH: 0 ; FILE LENGTH OF READ FILE + +LOCKSW: 0 ; 0=>ARC NOT LOCKED 1.1 BIT=1 => SOFT LOCKED, 1.2 BIT=1 => HARD LOCKED +INTLCK: 0 ; 0=>ALL INTERRUPS OK, =/0=>SAVE JOB/BOJ INTERRUPTS +BOJNUM: 0 ; NUMBER OF CURRENT BOJ HANDLER (I.E. xx IN UNAME "JOB xx") + +DEVFN2: SIXBIT />/ ;SECOND FILE NAME OF REAL DISK FILE +DEVRDM: 0 +OPTYPE: 0 ; 0=>SUB-FILE OPEN, -1=>DIRECTORY OPEN +CLSINP: -1 ; NOT -1 IF CLOSE IN PROGRES +NEWFIL: 0 ; 0=>NEW FILE BEING WRITTEN, -1=>OLD FILE +RANDOM: 0 ; RANDOM INFO FROM DIRECTORY BLOCK +CRDATE: 0 ; CREATION DATE FROM DIRECTORY BLOCK +RFDATE: 0 ; REFERENCE DATE FROM DIRECTORY BLOCK +ORFDAT: 0 ; REFERENCE DATE BEFORE RESET +WHENGC: 0 ; DIRECTORY GC TAG WHEN Q WAS LAST COMPUTED +IDXFBT: 0 ; INDEX INTO FIRST BLOCK ADDRESS TABLE +WDLFIB: 0 ; NUMBER OF WORDS LEFT IN MAPPED IN DATA BLOCK +CHLFIB: 0 ; NUMBER OF CHARACTERS LEFT IN MAPPED IN DATA BLOCK +BLBPTR: 0 ; BYTE POINTER TO NEXT CHARACTER SLOT IN DATA BLOCK +PSAV: 0 ; SAVED P FO INTERUPTS +BLKPOS: 0 ; INDEX OF NEXT WORD IN CURRENT BLOCK TO BE SENT + ; -1 => NO CURRENT BLOCK +NEWHDR: 277760,,0 ; FRESH DATA BLOCK HEADER +NEWTRL: 277760,,0 ; FRESH DATA BLOCK TRAILER +IOCERR: 0 ; IOC ERROR FLAG, 0=>NO ERROR, -1=>ERROR +DATADR: 0 ; ACCESS POINTER OF CURRENTLY MAPPED IN DATA BLOCK +DATOFF: 0 ; OFFSET POINTER IN BLOCK OF HEADER OF CURRENTLY MAPPED + ; DATA BLOCK +BFRSZ==20. ; SIZE OF IOT BUFFER FOR DIRECTORY ASCII BLOCK IOTS +IOTBFR: BLOCK BFRSZ ; IOT BUFFER FOR DIRECTORY ASCII BLOCK IOTS +MINBLS==100. ; MINIMUM SIZE OF PARTIAL LAST PAGE TO BE USED AS A DATA BLOCK + +DIRHDR: ASCIZ / + % OVERHEAD % EMPTY +/ + +PAT: +PATCH: BLOCK 20 + +LPDLL=100 +PDLPTR: -LPDLL,,PDL + +PDL: BLOCK LPDLL + +INTOP: 0 ; PLACE TO GET OP-CODE AT INTERRUPT LEVEL + +; JOBGET AREA AND JOBGET FOR MAIN PROGRAM LEVEL + +WD1: 0 +WD2: 0 +WD3: 0 +WD4: 0 +WD5: 0 +WD6: 0 +WD7: 0 +WD8: 0 +WD9: 0 +WD10: 0 +WD11: 0 +WD12: 0 +WD13: 0 +RET=2000,,0 + +SYSTEM: 0 + +SSTATU: SETZ + SIXBIT /SSTATU/ + 2000,,0 + 2000,,0 + 2000,,0 + 2000,,0 + 2000,,0 + 2000,,SYSTEM + SETZM + +RFBLK: SETZ ; GET MY CREATOR'S NAME + SIXBIT /RFNAME/ + 1000,,BOJC + 2000,,A + 2000,,CRUNAM + SETZM CRJNAM + +IJGET: SETZ ; GET OPERATOR WORD ONLY + SIXBIT/JOBCAL/ + 1000,,BOJC + SETZM INTOP + +JGET: SETZ ; GET ALL INFO ABOUT LAST JOB I/O OP + SIXBIT/JOBCAL/ + 1000,,BOJC + RET WD1 + SETZ [-12.,,WD2] + +JRET: SETZ ; UNHANG LAST JOB I/O OP + SIXBIT/JOBRET/ + 1000,,BOJC + H + SETZ I + +RETBLK: REPEAT 8.,0 + +JIOC: SETZ ; GIVE JOB USER AN I/O CHANNEL ERROR + SIXBIT/SETIOC/ + 1000,,BOJC + SETZ I + +JINT: SETZ ; GIVE JOB USER AN I/O INTERRUPT + SIXBIT/JOBINT/ + 401000,,BOJC + +JSTAT: SETZ ; CHANGE STATUS OF JOB USER'S CHANNEL + SIXBIT/JOBSTS/ + 1000,,BOJC + SETZ H + +JSTS: SETZ ; RETURN FILE NAMES TO SYSTEM + SIXBIT/JOBSTS/ + MOVEI BOJC + MOVEI 22 ;SNJOB + DEVICE + FNAME1 + SETZ FNAME2 + +START: JFCL ; LEAVE PLACE TO PUT .VALUE FOR DEBUGGING + .SUSET [.SMASK,,[1_10]] ; ENABLE IOCERR INTERRUPT + .SUSET [.SMSK2,,[1_BOJC]] ; ENABLE CHANNEL INTERRUPT + .CALL SSTATU + .VALUE + .OPEN BOJC,[17,,(SIXBIT/BOJ/)] ; OPEN CHANNEL + JRST CLOSE ; CAN'T +START1: MOVE P,PDLPTR ; RESET PDL + SETOM HNGFLG ; SET NOT HUNG + +LOOP: MOVEI A,GOTOPR ; NO IOT IN PROGRESS + MOVEM A,INIOT ; MAKE INTERRUPTS GO AFTER HANG + SETZM INTSW ; INTERRUPTS SHOULD NEVER BE LOCKED OUT HERE + SKIPN HNGFLG ; SEE IF HUNG + .HANG ; YES - WAIT UNTIL NOT +GOTOPR: SETZM HNGFLG + MOVE P,[-LPDLL-1,,PDL-1] ; RESET PDL IN CASE SOMEBODY INTERRUPTED + MOVEI A,LOOP ; NO IOT IN PROGRESS + MOVEM A,INIOT ; MAKE INTERRUPTS ABORT OPERATION + .CALL JGET ; GET INFO FOR CALL + JRST CHKOPN ; FAILED - IGNORE + LDB A,[370200,,WD1] ; SEE IF CLOSE BITS SET + JUMPN A,CLOSE ; YES - GO CLOSE + LDB A,[000400,,WD1] ; GET OP CODE + CAIGE A,10 ; .CALL? + JRST @STOPER(A) ; STANDARD OPERATOR - GO PROCESS + MOVE A,WD2 ; GET SIXBIT OF .CALL NAME + SKIPL B,[-CALCNT,,0] ; GET POINTER TO NAMES WE KNOW ABOUT + JRST BADOP ; IF CALCNT=0, THEN NO .CALLS HANDLED + CAMN A,CALNAM(B) + JRST @CALXCT(B) ; FOUND IT - GO EXECUTE THE RIGHT CODE + AOBJN B,.-2 ; NO - KEEP LOOKING +BADOP: HRLZI H,12 ; SET "MODE NOT AVAILABLE" FOR ILLEGAL OPS + SETZM I ; NO RETURNS + .CALL JRET ; MAKE HIM CONTINUE W/O SKIPPING + JFCL ; DON'T CARE IF HE HAS QUIT + JRST LOOP ; DON'T DIE FOR THAT + +CHKOPN: SKIPE IFOPEN ; IS THE CHANNEL ALREADY OPEN? + JRST LOOP ; YES - STAY IN LOOP UNTIL CLOSE + JRST CLOSE ; NO - LET SOMEBODY ELSE HAVE IT + +CLOSE: .CLOSE BOJC, ; CLOSE THE CHANNEL + SKIPE CLSCOD ; DID USER SUPPLY CLOSE ROUTINE? + JRST @CLSCOD ; YES - EXEUCUTE IT + .LOGOUT + .VALUE + + +; NOTE!! - BECAUSE OF PCLSR HACKING IN THE SYSTEM, INTERRUPTS FROM +; THE JOB USER MUST CAUSE ANY CURRENT OPERATION TO BE ABORTED. IOT'S +; ARE HANDLED IN A SPECIAL WAY TO ALLOW THE BOJ TO RECORD INTERRUPTED +; IOTS THAT WERE HALF COMPLETED. IF YOU WANT SOMETHING TO BE DONE +; WHEN IOTS ARE INTERRUPTED, PUT AN ADDRESS INTO THE WORD "INIOT". +; THE INTERRUPT HANDLER WILL JUMP TO THAT ADDRESS INSTEAD OF DISMISSING. +; THE LAST THING THAT SHOULD BE DONE AT THAT ADDRESS IS THE FOLLOWING: + +; .DISMISS [LOOP] + +TSINT: 0 + 0 + SKIPL TSINT ; IOC INTERRUPT + JRST INTIOE ; NO - IOERR INTERRUPT + .CALL IJGET ; GET COMMAND INFO + JRST TSINT1 ; NONE - DISMISS WITHOUT WAKEUP + PUSH P,A ; SAVE A + LDB A,[370200,,INTOP] ; GET CLOSE BITS + JUMPE A,TSINT0 ; SEE IF CLOSE? + SKIPN INTSW ; ARE INTERRUPTS LOCKED OUT? + JRST CLOSE ; NO - GO CLOSE RIGHT NOW + MOVEI A,1 ; YES - MARK CLOSE WANTED WHEN UNLOCKED + MOVEM A,INTSW2 + POP P,A + .DISMIS TSINT+1 + +TSINT0: POP P,A ; OTHERWISE - RESTORE A + SETOM HNGFLG ; WAKEUP MAIN PROGRAM LEVEL +TSINT1: SKIPN INTSW ; BOJ INTERRUPTS LOCKED OUT? + .DISMIS INIOT ; NO - DISMISS REGULAR WAY + SETOM INTSW2 ; SET INTERRUPT OCCURRED SWITCH + .DISMIS TSINT+1 ; CONTINUE INTERRUPTED CODE FOR NOW + +INTIOE: MOVEI I,3 + .CALL JIOC ; SIGNAL IOC ERROR TO USER + JFCL + MOVEI A,300 ; SLEEP AWHILE TO TRY AVOID STATUS TIMING ERROR + .SLEEP A, + JRST CLOSE ; DIE + + +; INTOFF - THIS ROUTINE CAN BE CALLED TO TELL THE INTERRUPT HANDLER +; NOT TO INTERRUPT UNTIL AN INTON IS DONE (INTOFF'S ARE NOT CUMMULATIVE) + +INTOFF: SKIPG INTSW ; IF NOT LOCKED - FLUSH PENDING STUFF + SETZM INTSW2 ; NO PENDING INTERRUPTS + AOS INTSW ; BUMP INTERRUPT LOCK COUNT + POPJ P, + +; INTON - THIS ROUTINE CAN BE CALLED TO TELL THE INTERRUPT HANDLER +; THAT BOJ INTERRUPTS ARE OK AGAIN. ANY INTERRUPT THAT HAS ARRIVED +; SINCE THE INTOFF WILL BE PRESENTED NOW (I.E. INTON WILL NOT RETURN +; TO THE CALLER UNLESS THERE IS NO PENDING INTERRUPT). + +INTON: PUSH P,A + SOSLE INTSW ; DECREMENT INTERRUPT LOCK SWITCH + JRST INTON2 ; STILL POSITIVE - STILL LOCKED + SETZM INTSW + SKIPLE INTSW2 ; DID A CLOSE OCCUR? + JRST CLOSE ; YES - CLOSE RIGHT NOW + SKIPN INTSW2 ; DID AN INTERRUPT OCCUR? + JRST INTON2 ; NO - FORGET IT + SETOM HNGFLG ; MAKE SURE HE DOESN'T HANG + POP P,A + JRST @INIOT ; OK TO PROCESS NOW +INTON2: POP P,A ; OTHERWISE RETURN TO CALLER + POPJ P, + + +INTSW: 0 ; 0=> BOJ INTERRUPTS OK, -1=>NO BOJ INTERRUPTS +INTSW2: 0 ; -1=>BOJ INTERRUPT OCCURRED WHILE LOCKED +HNGFLG: 0 +IFOPEN: 0 +INIOT: START ; INTERRUPTS CAUSE RESTART UNTIL + ; MAIN LOOP IS ENTERED THE FIRST TIME + +CLSCOD: 0 + ;UFD INFO +;USER DIR IN TRACK NUMBERED SAME AS INDEX IN MFD (SEE QFL2) + +NUDSL==200. ;# UFDS SPACE RESERVED +UFDBYT==6 ;SIZE OF BYTES +UFDBPW==36./UFDBYT ;NUMBER OF BYTES PER WORD + ;RANDOM INFO + + ARCTYP==0 ;-1=>NEW ARCHIVE, OTHERWISE OLD FORMAT + UDESCP==1 ;FS PNTR TO DESC AREA + UDNAMP==2 ;PNTR TO ORG OF NAME AREA + GCTAG==3 ;DATE/TIME OF LAST GARBAGE COLLECT + UDDESC==11. ;FIRST LOC AVAIL FOR DESC + + ;UFD DESCRIPTORS + ;0 => FREE 1-UDTKMX => TAKE NEXT N + ;UDTKMX+1 THRU UDWPH-1 => SKIP N-UDTKMX AND TAKE ONE + ;40 BIT SET => LOAD ADDRESS. LOWER 5 BITS PLUS NEXT TWO CHARS (17 BITS IN ALL) + + ;IF LINK DESCR + ;6 CHAR OR UNTIL ; = SYS NAME. MUST HAVE NO CHAR = 0 IN THIS OR NEXT 2 NAMES + ;NEXT CHAR QUOTED BY : (FOR NAMES WITH : OR ;) + ;NEXT CHAR N1 + ;NEXT CHAR N2 + ;END BY 0 + + UDTKMX==12. ;HIGHEST "TAKE N" CODE + UDWPH==31. ;PLACE HOLDER ON WRITE (OR NULL FILE) +; NXLBYT==2 ;# ADDITIONAL BYTES FOR LOAD ADDR + ;ACTUAL PARAMETER ASSIGN MUST BE AT FRONT OF FILE + + ;MFD DEFS + + MDNAMP==1 + MNUNAM==0 + LMNBLK==2 + + ;NAME AREA DATA + + LUNBLK==5 ;WDS/NAME BLK + UNFN1==0 ;FIRST FN + UNFN2==1 ;SECOND FN + UNRNDM==2 ;ALL KINDS OF RANDOM INFO + UNDSCP==1500,, ;PNTR TO DESC + + UNPKN==150500,, ;PACK # + UNBOJN==150500,, ;BOJ # ON LAST WRITE + UNRNUM==600,, + UNAUTH==111100,, + UNLINK==1 ;LINK BIT + UNLNKB==220100,, + UNWRIT==4 ;OPEN FOR WRITING + UNMARK==10 ;GC MARK BIT + UNCDEL==20 ;DEL WHEN CLOSED + UNPDEL==40 ;DEL FROM UNMOUNTED PACK + UNDS1==100000 ;HAS BEEN HALF DELETED AND HAS 1 STRIKE + UNHD==200000 ;HAS BEEN HALF DELETED + DELBTS==UNCDEL+UNPDEL+UNHD ;DELETED -- IGNORE + UNIGFL==DELBTS+UNWRIT ;BITS TO IGNORE FILE + UNWRDC==301200,, ; WORD COUNT OF LAST BLOCK MOD 2000 + UNDUMP==400000 ;HAS BEEN DUMPED + UNREAP==2 ;CAN'T BE REAPED + UNDATE==3 ;DATE ETC. + UNTIM==2200,, ;COMPACTED TIME OF CREATION + UNYMD==222000,, ;Y,M,D OF CREATION + UNMON==270400,, ;MONTH + UNDAY==220500,, ;DAY + UNYRB==330700,, + UNREF==4 ; REFERENCE DATE SAME AS LEFT HALF OF UNDATE + +QFNG: SKIPA C,[SETZ] ;GENERATE FILE NAME TO REPLACE < OR > ON WRITE +QLOOK: MOVEI C,0 + PUSH P,J ;Q_FILE # + MOVEI J,ARCDIR ;GET POINTER TO SHARED COPY OF DIRECTOYR + MOVEI Q,2000-LUNBLK(J) + ADD J,UDNAMP(J) + CAMN A,[SIXBIT />/] + TLOA J,400000 + CAMN A,[SIXBIT / + CAMN B,[SIXBIT />/] + TLOA J,400000 + CAMN B,[SIXBIT //] + JRST POPJJ ;MUST BE READ RETN FILE NOT FOUND +QLOOK1: PUSH P,D + PUSH P,TT + PUSH P,I + PUSH P,[-1] ;BEST INDEX + PUSH P,[SETZ] ;BEST "NUMERIC" PART + PUSH P,[SETZ] ;BEST ALPHA PART +QLOOK4: CAIGE Q,(J) + JRST QLOOK2 + MOVE D,UNRNDM(Q) + TLNE D,UNIGFL + JUMPGE C,QLOOK3 ;IF CONJURING NAME FOR WRITE, CONSIDER ALL + XCT QLKI1(C) + JRST QLOOK3 + SKIPE TT,@QLKI1+1(C) +QLOOK6: TRNE TT,77 ;RIGHT ADJ + JRST QLOOK5 + LSH TT,-6 + JRST QLOOK6 +QLOOK5: MOVEI I,0 +QLOOK8: LDB D,[600,,TT] + CAIL D,'0 + CAILE D,'9 + JRST QLOOK7 ;NOT A DIGIT +QLOK5B: TRNE I,77 ;RIGHT ADJ LOW NON NUM PART + JRST QLOK5A + LSH I,-6 + JUMPN I,QLOK5B +QLOK5A: TLC TT,400000 ;AVOID CAM LOSSAGE + TLC I,400000 + SKIPGE -2(P) + JRST QLOK5D ;FIRST MATCH + JUMPGE J,QLOK5E ;GET LEAST + CAMGE TT,-1(P) ;GET GREATEST + JRST QLOOK3 + CAME TT,-1(P) + JRST QLOK5D + CAMGE I,(P) + JRST QLOOK3 ;NOT AS GOOD +QLOK5D: HRRZM Q,-2(P) + MOVEM TT,-1(P) + MOVEM I,(P) +QLOOK3: SUBI Q,LUNBLK + JRST QLOOK4 + + +QLOK5E: CAMLE TT,-1(P) + JRST QLOOK3 + CAME TT,-1(P) + JRST QLOK5D + CAMLE I,(P) + JRST QLOOK3 + JRST QLOK5D + +QLOOK7: LSHC TT,-6 ;LOW DIGIT NOT NUMERIC + JUMPN TT,QLOOK8 ;NO NUMERIC DIGITS AT ALL ("BIN", MAYBE?) + JUMPL J,QLOK5B ;IF LOOKING FOR GREATEST, LET THIS BE LEAST + MOVNI TT,1 ;GREATEST IF LOOKING FOR LEAST + JRST QLOK5B + +QLOOK2: JUMPL C,QFNG1 ;REALLY WANT TO MAKE F.N.'S FOR WRITE + SUB P,[1,,1] + POP P,C ;BEST "NUMERIC" PART + POP P,Q ;ADR + POP P,I + POP P,TT + POP P,D + JUMPL Q,POPJJ + MOVE A,UNFN1(Q) ;ACTUAL MATCHED FILE NAMES + MOVE B,UNFN2(Q) + POP P,J + AOS (P) + POPJ P, + + +QFNG1: SKIPGE -2(P) + JRST QFNG2 ;NOT FOUND START W/ 1 + MOVE TT,-1(P) + TLC TT,400000 + MOVE I,[600,,TT] +QFNG3: LDB D,I + CAIL D,'0 + CAILE D,'9 + JRST QFNG4 ;REACH END OF NUMERIC FIELD + AOS D + CAILE D,'9 + JRST QFNG5 + DPB D,I +QFNG5A: TLNE TT,770000 + JRST QFNG3A + LSH TT,6 + JRST QFNG5A + +QFNG2: MOVSI TT,(SIXBIT /1/) +QFNG3A: MOVEM TT,A(C) ;STORE INTO A OR B AS APPRO + SUB P,[3,,3] + POP P,I + POP P,TT + POP P,D + JRST POPJJ + + +QFNG5: MOVEI D,'0 + DPB D,I + ADD I,[60000,,] + JUMPL I,QFNG5A + JRST QFNG3 + +QFNG4: TLNN TT,770000 ;SKIP ON ALREADY 6 CHAR NAME + LSH TT,6 + MOVEI D,'1 + DPB D,I + MOVEI D,'0 +QFNG4B: TLNN I,770000 + JRST QFNG5A + IDPB D,I + JRST QFNG4B + +QLKI1: CAME B,UNFN2(Q) + CAME A,UNFN1(Q) + UNFN2(Q) + + +;ROUTINE TO FIND PLACE IN DIRECTORY WHERE A B WOULD GO +;SKIPS ONL IF DIRECTORY CONTAINS AT LEAST ONE FILE +;FOR INSERTION, FILE GOES BEFORE PNTR RETURNED IN J +;RETURNS PNTR IN Q TO BEGINNING OF NAME AREA +;(ONLY WORKS FOR LUNBLK = 5) + +QLGLKB: MOVEI J,BLOCK3 ; DO LOOKUP IN SCRATCH BLOCK + SKIPA +QLGLK: MOVEI J,ARCDIR + HRRZ Q,UDNAMP(J) + ADDI Q,(J) + CAIL Q,2000(J) + POPJ P, ;DIRECTORY EMPTY + TLC A,(SETZ) + TLC B,(SETZ) + PUSH P,D + PUSH P,E + ADDI J,600 +REPEAT 7,[ + CAMGE J,Q + JRST .+6 + MOVE D,UNFN1(J) + TLC D,(SETZ) + CAMN A,D + JSP E,QLGLE + CAML A,D + ADDI J,<1_<7-.RPCNT>>*LUNBLK + SUBI J,<1_<6-.RPCNT>>*LUNBLK +] + CAMGE J,Q + ADDI J,LUNBLK + CAMGE J,Q + JRST 4,. + MOVE D,UNFN1(J) + TLC D,(SETZ) + CAME A,D + JRST QLGL1 + MOVE D,UNFN2(J) + TLC D,(SETZ) + CAMLE B,D +QLGL2: ADDI J,LUNBLK +QLGL3: TLC A,(SETZ) + TLC B,(SETZ) + POP P,E + POP P,D +POPJ1: AOS (P) + POPJ P, + +QLGL1: CAML A,D + JRST QLGL2 + JRST QLGL3 + +;CALL BY JSP E,QLGLE +QLGLE: MOVE D,UNFN2(J) + TLC D,(SETZ) + CAMN B,D + JRST QLGL3 + CAML B,D + JRST 1(E) + JRST 2(E) + ;REMOVE HOLE FROM NAME AREA AT Q +QSQSH: PUSH P,A + PUSH P,B + PUSH P,C + PUSH P,TT + PUSHJ P,BLTSCR + MOVEI TT,BLOCK3 + MOVE A,UDNAMP(TT) + ADDI A,(TT) + HRRZ C,Q + ADDI C,BLOCK3-ARCDIR +QSQSH1: SUBI C,LUNBLK + CAMLE A,C + JRST QSQSH2 + HRLZ B,C + HRRI B,LUNBLK(C) + BLT B,2*LUNBLK-1(C) + JRST QSQSH1 +QSQSH2: +REPEAT LUNBLK,SETZM .RPCNT(A) + SUBI A,-LUNBLK(TT) + HRRZM A,UDNAMP(TT) + .CALL GETTAG + SETZM A + MOVEM A,BLOCK3+GCTAG + MOVEM A,WHENGC + PUSHJ P,BLTBCK + POP P,TT + POP P,C + POP P,B + POP P,A + POPJ P, + QBTBLI: 440600,, ;IF GOING TO ILDB + 360600,, + 300600,, + 220600,, + 140600,, + 060600,, + 000600,, + +; GCDIR - directory garbage collector - written especially +; for archiver - does not have all the features needed by +; the system's garbage collector. + +; GCDIR the directory is already in core started at the location +; whose lable is ARCDIR. It will also assume that can use a 2000 word +; block beginning at BLOCK3. It clobbers ACs A,B,C,D,E,TT. + +; ARG in A - instruction to execute with address of directory +; name area in A. Instruction should skip if entry should be +; retained. Files with first name of zero are always flushed. + +GCDIR: PUSH P,A ; SAVE RETAIN INSRUCTION + PUSHJ P,HLOCK ; LOCK THE DIRECTORY + .CALL SCRMAP + JFCL + MOVE A,[ARCDIR,,BLOCK3] + BLT A,BLOCK3+UDDESC-1 ; COPY THE DIRECTORY HEADER + MOVE A,(P) + PUSHJ P,GCDIR1 ; CALL REAL GARBAGE COLLECTOR + PUSHJ P,INTOFF ; BLT BACK MUST BE DONE WITH INTS OFF + MOVE A,[BLOCK3,,ARCDIR] ; BLT BACK + BLT A,ARCDIR+1777 + PUSHJ P,INTON ; RENABLE INTERRUPTS + PUSHJ P,HULOCK ; UNLOCK FILE + POP P,A + POPJ P, + +; GCDIR1 CAN BE CALLED DIRECTLY WITH THE DIRECTORY ALREADY IN BLOCK3. +; GCDIR1 WILL LEAVE IT THERE. GCDIR1 DOES NO FILE OR INTERRUPT LOCKING. + +GCDIR1: PUSH P,A ; SAVE RETAIN INSTRUCTION + MOVEI E,1 ; INDEX OF NEXT AVAILABLE DESC BYTE + MOVE D,[360600,,BLOCK3+UDDESC] ; BYTE POINTER TO NEXT DESC + MOVEI TT,BLOCK3+2000 + MOVEI C,2000-LUNBLK + CAMGE C,ARCDIR+UDNAMP ; ANYTHING THERE? + JRST GCOVER ; DONE + +GCLOOP: SKIPN ARCDIR(C) ; IS ENTRY NAME ZERO? + JRST GCNEXT ; YES - FLUSH IT + HRRZI A,ARCDIR(C) + XCT (P) ; KEEP IT? + JRST GCNEXT ; NO + HRLS A ; YES - COPY IT + SUBI TT,LUNBLK + HRR A,TT ; MAKE BLT POINTER + BLT A,4(TT) + LDB A,[UNDSCP+UNRNDM+ARCDIR(C)] ; GET INDEX OF DESC AREA + DPB E,[UNDSCP+UNRNDM(TT)] ; SET NEW INDEX + IDIVI A,UFDBPW ; GET WORD NUMBER + ADDI A,ARCDIR+UDDESC ; GET WORD ADDRESS + HLL A,QBTBLI(B) ; GET BYTE POINTER +GCDCPY: ILDB B,A ; TRANSFER THE DESCRIPTOR AREA + IDPB B,D + AOS E ; UPDATE INDEX OF NEXT ONE + TRNE B,40 ; IS THIS START OF AN ADDRESS? + JRST GCDADR ; YES - JUMP + JUMPN B,GCDCPY ; GO UNTIL ZERO IS COPIED + JRST GCNEXT + +GCDADR: ILDB B,A ; DISK ADR - COPY NEXT TWO BYTES + IDPB B,D ; WITHOUT LOOKING + ILDB B,A + IDPB B,D + ADDI E,2 + JRST GCDCPY + +GCNEXT: SUBI C,LUNBLK ; GO NEXT ENTRY + CAML C,ARCDIR+UDNAMP ; DONE? + JRST GCLOOP ; NO + ; YES +GCOVER: MOVEM E,BLOCK3+UDESCP ; SAVE INDEX OF AVAILABLE BYTE + SUBI TT,BLOCK3 + MOVEM TT,BLOCK3+UDNAMP ; SAVE INDEX OF FIRST NAME AREA + HRRI E,1(D) ; ZERO IN BETWEEN SPACE + HRLI E,2(D) + SETZM 1(D) + HRRZ A,BLOCK3+UDNAMP ; FROM END OF DESCRIPTORS TO NAME AREA + ADDI A,BLOCK3-1 ; GET ADDRESS OF 1-ADR OF NAME AREA + CAILE A,(E) ; ANY ROOM TO ZERO? + BLT E,(A) ; YES - ZERO IT + .CALL GETTAG + SETZM A + MOVEM A,ARCDIR+GCTAG + POP P,A ; RESTORE INSTRUCTION + POPJ P, ; DONE + +GETTAG: SETZ + SIXBIT/RQDATE/ + SETZM A + + +; FLEN - GET FILE LENGTH - INPUT A/ POINTER TO NAME AREA +; OUTPUT A/ FILE LENGTH + +; DESCRIPTOR BYTE MEANINGS + ;0 => FREE 1-UDTKMX => TAKE NEXT N + ;UDTKMX+1 THRU UDWPH-1 => SKIP N-UDTKMX AND TAKE ONE + ;40 BIT SET => LOAD ADDRESS. LOWER 5 BITS PLUS NEXT TWO CHARS (17 BITS IN ALL) + +FLEN: PUSH P,B + PUSH P,C + MOVE B,UNRNDM(A) + TLNE B,UNLINK + JRST FLENLK + LDB B,[UNDSCP+UNRNDM(A)] + JUMPE B,FLENR2 + CAMN B,LENADR+1 + JRST USELL + CAMN B,LENADR+2 + JRST USELL + MOVEM B,@LENADR + LDB C,[UNWRDC+UNRNDM(A)] + SKIPN C + MOVEI C,2000 + PUSH P,C + IDIVI B,UFDBPW + ADDI B,ARCDIR+UDDESC + HLL B,QBTBLI(C) + SETZM A +FLENLP: ILDB C,B + JUMPE C,FLENOV + CAIG C,UDTKMX + JRST TAKEN + CAILE C,UDTKMX + CAIGE C,UDWPH + AOJA A,FLENLP + TRNN C,40 + JRST FLENLP + AOS A + ILDB C,B + ILDB C,B + JRST FLENLP + +TAKEN: ADD A,C + JRST FLENLP + +FLENOV: JUMPE A,FLENRT + SOS A + IMULI A,2000 + ADDM A,(P) +FLENRT: POP P,A + MOVEM A,@LENLEN + SKIPA +FLENR2: SETZM A +FLENR1: POP P,C + POP P,B + POPJ P, + +USELL: PUSH P,@LENLEN + MOVE A,LENADR + AOS A + CAILE A,LENADR+2 + MOVEI A,LENADR+1 + MOVE A,LENLEN + AOS A + CAILE LENLEN+2 + MOVEI A,LENLEN+1 + POP P,A + JRST FLENR1 + +FLENLK: MOVE A,[37777,,-1] + JRST FLENR1 + +LENADR: .+1 + -1 + -1 + +LENLEN: .+1 + 0 + 0 + +; SLISTF - INITIALIZES LFCHR - I.E. STARTS A LISTF +; TAKES AS ARGS A/ POINTER TO DIRECTORY +; B/ BYTE POINTER TO HEADER FOR DIRECTORY (ASCIZ) +; LFCHR - GIVES THE NEXT CHARACTER FROM A LISTF + +SLISTF: MOVEM A,LFDIR ; SAVE POINTER TO DIRECTORY + ADD A,UDNAMP(A) ; GET POINTER TO FIRST THING IN NAME AREA + MOVEM A,LFNAME ; SAVE POINTER TO NEXT NAME AREA + MOVEM B,LFBPTR ; SAVE CURRENT BYTE POINTER + POPJ P, ; DONE WITH SETUP + +LFCHR: ILDB A,LFBPTR ; GET NEXT CHARACTER + SKIPE A ; ZERO? + POPJ P, ; NO - RETURN IT + PUSH P,B ; SAVE SOME ACS + PUSH P,C + PUSH P,D + PUSH P,E + MOVE D,LFDIR ; GET POINTER TO DIRECTORY + MOVEI A,LUNBLK ; GET ADDER IN CASE NEEDED +LFNXT: MOVE C,LFNAME ; GET POINTER TO NEXT NAME AREA + CAIL C,2000(D) ; STILL MORE? + JRST LFEOF ; NO MORE NAME AREAS + SKIPE UNFN1(C) ; HAS THIS BEEN DELETED? + JRST LFNXT1 ; NO - USE IT + ADDM A,LFNAME ; YES - GO TO NEXT ONE + JRST LFNXT + +LFNXT1: MOVE A,UNRNDM(C) ; GET FLAG BITS + TLNN A,UNLINK ; LINK? + JRST LFFILE ; NOT A LINK + MOVE A,[ASCII/ L /] + MOVEM A,LFBFR ; LINK - START WITH AN 'L' + MOVE A,[440700,,LFBFR+1] + MOVEM A,LFBPTR ; REST BYTE POINTER + MOVEI A,40 ; ONE SPACE + IDPB A,LFBPTR + MOVE A,UNFN1(C) ; PRINT FNAME1 + PUSHJ P,LF6BIT + MOVEI A,40 + IDPB A,LFBPTR + MOVE A,UNFN2(C) + PUSHJ P,LF6BIT + MOVEI A,40 + IDPB A,LFBPTR + MOVE A,UNRNDM(C) ; GET RANDOM BITS + ANDI A,17777 ; ISOLATE BYTE INDEX + IDIVI A,UFDBPW ; CONVERT TO BYTE POINTER + ADDI A,UDDESC(D) + HLL A,QBTBLI(B) +LFCH00: MOVEI E,6 +LFCHR1: ILDB B,A ; GET NEXT CHAR + JUMPE B,LFCHR3 + CAIN B,'; ; SEMI-COLON IS SEPARATOR + JRST LFCHR3 + CAIN B,': ; COLON IS QUOTE + ILDB B,A + ADDI B,40 ; CONVERT TO ASCII + IDPB B,LFBPTR + SOJG E,LFCHR1 + +LFCHR3: JUMPE B,LFCHR9 + MOVEI B,40 + IDPB B,LFBPTR + JRST LFCH00 + + +LFFILE: MOVE A,[440700,,LFBFR] + MOVEM A,LFBPTR + MOVEI B,40 + MOVE A,UNRNDM(C) + TLNE A,UNIGFL ; OPEN FOR WRITING? + MOVEI B,"* ; YES - OUTPUT STAR + IDPB B,LFBPTR + MOVEI B,40 + IDPB B,LFBPTR + IDPB B,LFBPTR + LDB A,[UNPKN+DEVRDM] + IDIVI A,10. + ADDI A,"0 + ADDI B,"0 + IDPB A,LFBPTR ; REPLACES PACK NUMBER + IDPB B,LFBPTR ; REPLACES PACK NUMBER + MOVEI B,40 + IDPB B,LFBPTR + IDPB B,LFBPTR + MOVE A,UNFN1(C) ; OUTPUT FILE NAMES + PUSHJ P,LF6BIT + MOVEI B,40 + IDPB B,LFBPTR + MOVE A,UNFN2(C) + PUSHJ P,LF6BIT + MOVEI B,40 + IDPB B,LFBPTR + HRRZ A,C ; GET FILE LENGTH + PUSHJ P,FLEN + IDIVI A,2000 + SKIPE B ; NO AOS IF ZERO + AOS A + PUSHJ P,LFDEC + MOVEI A,40 + IDPB A,LFBPTR + SKIPL UNRNDM(C) + MOVEI A,"! + IDPB A,LFBPTR + MOVE A,UNDATE(C) + CAMN A,[-1] + JRST LFNODT + LDB A,[270400,,UNDATE(C)] + PUSHJ P,LFDEC + MOVEI A,"/ + IDPB A,LFBPTR + LDB A,[220500,,UNDATE(C)] + PUSHJ P,LFDEC + MOVEI A,"/ + IDPB A,LFBPTR + LDB A,[330700,,UNDATE(C)] + PUSHJ P,LFDEC + MOVEI A,40 + IDPB A,LFBPTR + HRRZ B,UNDATE(C) + LSH B,-1 + IDIVI B,10. + PUSH P,C + IDIVI B,6 + PUSH P,C + IDIVI B,10. + PUSH P,C + IDIVI B,6 + PUSH P,C + IDIVI B,10. + PUSH P,C + PUSH P,B + MOVEI B,2 +LFF1: POP P,A + ADDI A,"0 + IDPB A,LFBPTR + POP P,A + ADDI A,"0 + IDPB A,LFBPTR + MOVEI A,": + SKIPE B + IDPB A,LFBPTR + SOJGE B,LFF1 +LFCHR9: MOVEI A,15 + IDPB A,LFBPTR + MOVEI A,12 + IDPB A,LFBPTR + SETZM A + IDPB A,LFBPTR + MOVE A,[440700,,LFBFR] + MOVEM A,LFBPTR + MOVEI A,LUNBLK + ADDM A,LFNAME + ILDB A,LFBPTR + MOVEI A,40 + IDPB A,LFBPTR +LFCHR0: POP P,E + POP P,D + POP P,C + POP P,B + POPJ P, + +LFEOF: MOVE A,[440700,,[3_35+3_26+3_17+3_10+3_1]] + MOVEM A,LFBPTR + MOVEI A,3 + JRST LFCHR0 + +LFNODT: MOVEI A,"- + IDPB A,LFBPTR + JRST LFCHR9 + +LFBPTR: 0 +LFNAME: 0 +LFDIR: 0 +LFBFR: REPEAT 100.,0 + +LF6BIT: PUSH P,B + PUSH P,C + MOVEI C,6 +LF6BL: SETZM B + ROTC A,6 + ADDI B,40 + IDPB B,LFBPTR + SOJG C,LF6BL + POP P,C + POP P,B + POPJ P, + +LFDEC: PUSH P,B + PUSH P,[-1] + IDIVI A,10. + PUSH P,B + JUMPN A,.-2 +LFDEC1: POP P,A + JUMPL A,LFDEC2 + ADDI A,"0 + IDPB A,LFBPTR + JRST LFDEC1 + +LFDEC2: POP P,B + POPJ P, + + + ; THIS FILE CONTAINS ROUTINES TO DO THINGS TO NEW FLAVOR ARCHIVES + +; ARCINI - THIS ROUTINE IS USED TO INITIALIZE AN ARCHIVE. + +; ARCINI SKIPS IF IT WINS (IT WILL LOSE IF THE OUTPUT FILE +; CANNOT BE OPENED). + +; A 2000 WORD BLOCK STARTING AT BLOCK3 WILL BE CLOBBERED. + +ARCINI: PUSH P,A + PUSH P,B + MOVEI A,7 + PUSHJ P,OPNARC ; OPEN THE OUTPUT FILE + JRST ARCIN9 ; CAN'T - FAIL + .CALL SCRMAP ; GET SCRATCH PAGE + PUSHJ P,RETRY + SETZM BLOCK3 ; INITIALIZE THE OUTPUT BLOCK + MOVE A,[BLOCK3,,BLOCK3+1] + BLT A,BLOCK3+1777 + SETOM BLOCK3+ARCTYP ; -1 => NEW FLAVOR ARCHIVE + MOVEI A,2000 ; POINTER TO NAME AREA OFF THE END + MOVEM A,BLOCK3+UDNAMP + MOVE A,[-2000,,BLOCK3] + .IOT ARC,A + MOVE A,[-5,,BLOCK3] + SETZM (A) ; ZERO OUT FCHAIN POINTER AND STATISTICS + AOBJN A,.-1 + MOVEI A,1 + MOVE B,[-,,BLOCK3+5] + MOVEM A,(B) ; MAKE CHAIN OUT OF FIRST BLOCK ADDRESS + AOS A ; TABLE + AOBJN B,.-2 + SETZM B,BLOCK3+FBTLEN-1 ; MAKE IT CIRCULAR + MOVE A,[-,,BLOCK3] + .IOT ARC,A ; WRITE OUT FBAT. + .CLOSE ARC, ; THAT'S IT - NO DATA BLOCKS NOW + .CALL SCRFLS ; FLUSH THE SCRATCH PAGE + JFCL ; IT'LL GET CLEANED UP LATER + MOVEI A,6 ; REOPEN THE FILE TO MAP + PUSHJ P,OPNARC + PUSHJ P,RETRY ; JUST OPENED IT SO WE KNOW ITS THERE + PUSHJ P,DIRMAP ; MAP IN DIRECTORY + .CLOSE ARC, + AOS -2(P) +ARCIN9: POP P,B + POP P,A + POPJ P, + + +; DINSRT - ROUTINE TO INSERT A NEW ENTRY INTO A DIRECTORY +; TAKES FILE NAMES IN A AND B. ASSUMES THAT THE +; DIRECTORY IS IN ARCDIR + +GTDRNM: PUSH P,C + SKIPA C,CRUNAM +GTDRNC: PUSH P,C +GTDRIN: PUSH P,A + .CALL MFDOPN + JRST GTDRLS + .CALL MFDIOT + JRST GTDRLS + .CLOSE MFDI, + MOVEI A,MFDBLK + ADD A,MDNAMP(A) ;PTR TO USER AREA +QFL1: LDB B,[1200,,A] + JUMPE B,GTDRLS + CAMN C,MNUNAM(A) + JRST QFL2 + ADDI A,LMNBLK + JRST QFL1 + +QFL2: SUBI B,2000-LMNBLK*NUDSL + LSH B,-1 + SKIPA +GTDRLS: MOVEI B,777 + POP P,C + POP P,A + POPJ P, + +MFDOPN: SETZ + SIXBIT /OPEN/ + MOVSI .BII + MOVEI MFDI + [SIXBIT /DSK/] + [SIXBIT /M.F.D./] + [SIXBIT /(FILE)/] + SETZ + +MFDIOT: SETZ + SIXBIT /IOT/ + MOVEI MFDI + SETZ [-2000,,MFDBLK] + +GDATE: SETZ ; CALL TO GET FUNNY FORMAT DATE + SIXBIT/RQDATE/ + SETZM A + +DINSRT: PUSH P,A ; SAVE FILE NAMES + PUSH P,B + SETOM C ; GC NOT TRIED YET +DINSR1: MOVE TT,ARCDIR+UDESCP ; SEE IF ENOUGH ROOM + IDIVI TT,UFDBPW ; SEE WHERE NEXT DESCRIPTOR GOES + AOS TT + ADDI TT,UDDESC+5 ; NOW (TT)=FIRST WORD NAME AREA CAN USE + CAMGE TT,ARCDIR+UDNAMP ; ENOUGH ROOM? + JRST DINSR2 ; YES - GO DO IT + AOJG C,DIRFUL ; HAVE WE ALREADY TRIED GC? + MOVSI A,(SKIPA) ; NO - TRY IT NOW + PUSHJ P,GCDIR + JRST DINSR1 ; SEE IF ENOUGH ROOM NOW? + +DINSR2: MOVE A,-1(P) ; GOT ROOM - GET FILE NAMES BACK + MOVE B,(P) + PUSHJ P,HLOCK ; HARD LOCK THE FILE + PUSHJ P,BLTSCR ; GET DIRECTORY INTO SCRATCH AREA + PUSHJ P,QLGLKB ; DO THE LOOKUP + MOVEI J,BLOCK3+2000 ; DIRECTORY EMPTY + MOVE Q,J + MOVEI C,-BLOCK3-5(Q) ; GET INDEX TO NEW NAME AREA SLOT + CAML C,BLOCK3+UDNAMP ; FARTHER BACK THAN POINTER? + JRST .+3 ; NO - GO AHEAD + MOVEM C,BLOCK3+UDNAMP ; UPDATE INDEX + JRST DINSR4 ; AND DON'T BLT + SKIPN -LUNBLK(Q) ; SEE IF ENTRY ZERO OR IF BLT NEEDED + JRST DINSR4 ; MUST HAVE BEEN DELETED - NO BLT + MOVE C,BLOCK3+UDNAMP ; NEED TO BLT - BUILD BLT POINTER + ADDI C,BLOCK3 ; GET ADDRESS OF START OF NAME AREA + HRLS C ; PUT IN BOTH HALVES OF C + SUBI C,LUNBLK ; BLT UP ONE NAME BLOCK + BLT C,-LUNBLK-1(Q) ; MAKE ROOM + MOVE C,BLOCK3+UDNAMP ; UPDATE START POINTER + SUBI C,LUNBLK + MOVEM C,BLOCK3+UDNAMP + PUSH P,A + .CALL GDATE ; GET CURRENT DATE + SETOM A + MOVEM A,BLOCK3+GCTAG ; CHANGE THE GC TAG - SINCE POSITIONS MOVED + MOVEM A,WHENGC ; Q TO BE FIXED UP HERE + POP P,A + +DINSR4: SUBI Q,LUNBLK ; BACK UP TO EMPTY ENTRY +DINSR5: MOVEM A,UNFN1(Q) ; STORE NEW INFORMATION + MOVEM B,UNFN2(Q) + SETZM UNRNDM(Q) ; INITIALZE RANDOM INFO + MOVE TT,BLOCK3+UDESCP ; GET INDEX OF NEXT DESC BYTE + DPB TT,[UNDSCP+UNRNDM(Q)] ; STORE INDEX + IDIVI TT,UFDBPW + ADDI TT,BLOCK3+UDDESC ; GET BYTE POINTER TO DESC BYTE + HLL TT,QBTBLI(I) + SETZM A ; MAKE SURE ITS ZERO + IDPB A,TT ; THAT INDICATES EMPTY FILE + AOS BLOCK3+UDESCP ; BUMP NEXT DESC BYTE INDEX + .CALL GDATE ; GET CURRENT DATE AND TIME + SETOM A + MOVEM A,UNDATE(Q) ; STORE IT + HLLZM A,UNREF(Q) ; AS REF DATE TOO + PUSH P,B + LDB B,[301400,,SYSTEM] + CAIE B,'DM + JRST NOAUTH + PUSHJ P,GTDRNM + DPB B,[UNAUTH+UNREF(Q)] +NOAUTH: POP P,B + MOVEM A,BLOCK3+GCTAG + MOVEM A,WHENGC + PUSHJ P,BLTBCK ; REPLACE THE DIRECTORY + MOVEI Q,ARCDIR-BLOCK3(Q) ; MAKE POINTER POINT INTO ARCDIR + PUSHJ P,HULOCK ; UNLOCK THE FILE + POP P,B ; REPLACE THE FILE NAMES + POP P,A + POPJ P, + + ; DISPATCH TABLES, ETC. USED BY 'BASIC' DEVICE CODE +STOPER: OPEN + IOT + BADOP ; STATUS DOESN'T COME ANY MORE + RESET + RCHST + ACCESS + FDELE1 + FDELE2 ; RENAME WHILE OPEN + +NOOP0: SKIPA H,[0] ; MAKE USERS CALL DO NOTHING - NO SKIP +NOOP1: MOVEI H,1 ; MAKE USERS CALL DO NOTHING BUT SKIP + SETZM I + .CALL JRET + JFCL + JRST LOOP + +RESET==NOOP0 + +; CALNAM - TABLE OF THE NAMES OF THE .CALLS HANDLED + +CALNAM: SIXBIT/FILBLK/ ; GET NAME AREA FROM DIRECTORY + SIXBIT/FILLEN/ ; GET FILE LENGTH + SIXBIT/RDMPBT/ ; READ DUMP BIT + SIXBIT/RESRDT/ ; RESET REFERENCE DATE + SIXBIT/RFDATE/ ; READ CREATION DATE/TIME + SIXBIT/SDMPBT/ ; SET DUMP BIT + SIXBIT/SFDATE/ ; SET CREATION DATE/TIME + SIXBIT/SRDATE/ ; SET REFERENCE DATE + SIXBIT/SREAPB/ + SIXBIT/SAUTH/ + SIXBIT/RAUTH/ +CALCNT==.-CALNAM ; CALCNT - NUMBER OF .CALLS HANDLED + +; CALXCT - NAMES OF ROUTINES TO HANDLE .CALLS + +CALXCT: FILBLK + FILLEN + RDMPBT + RESRDT + RDFDAT + SDMPBT + SFDATE + SRDATE + SREAPB + SAUTH + RAUTH + + +; ADDRESSES TO USE FOR PAGE MAPPING: + +DIRPAG==10 ; 2 PAGES FOR MAPPING IN DIRECTORY +SCRPAG==12 ; 1 PAGE FOR SCRATCH +DATPAG==13 ; n PAGES FOR MAPPING IN DATA BLOCKS +DBMSIZ==3 ; # OF PAGES TO TRY TO MAP IN FOR A DATA BLOCK + +ARCDIR=DIRPAG_10. ; PAGES FOR ARCHIVE DIRECTORY +BLOCK2=ARCDIR+2000 ; PAGES FOR ARCHIVE BLOCK 2 +BLOCK3=SCRPAG_10. ; SCRATCH PAGE +DATAB1=DATPAG_10. ; NEED THREE PAGES FOR DATA AREAS + + +FBTLEN==200. ; FIRST BLOCK ADDRESS TABLE LENGTH +FCHAIN=BLOCK2 ; POINTER TO START OF FREE CHAIN +FWORDS=BLOCK2+1 ; NUMBER OF WORDS IN ALL FREE BLOCKS +FBLCKS=BLOCK2+2 ; NUMBER OF BLOCKS IN FREE CHAIN +DWORDS=BLOCK2+3 ; NUMBER OF WORDS IN USE FOR DATA BLOCKS +DBLCKS=BLOCK2+4 ; NUMBER OF DATA BLOCKS IN USE +FBAT=BLOCK2+5 ; START OF THE FIRST BLOCK ADDRESS TABLE + +; .CALL BLOCKS + +DSKDIR: SETZ ;OPEN DISK DIRECTORY + SIXBIT/OPEN/ + A + [SIXBIT /DSK/] + [SIXBIT /.FILE./] + [SIXBIT /(DIR)/] + SETZ DIRECT + +ARCOPN: SETZ ; .CALL ARCOPN TO OPEN THE ARCHIVE FOR READING + SIXBIT/OPEN/ + A ; PUT MODE,,CHNL IN A + [SIXBIT/DSK/] + DEVICE + DEVFN2 + SETZ DIRECT + +ARCRN2: SETZ ; FIND OUT REAL SECOND NAME + SIXBIT /FILBLK/ + 1000,,ARC + 2000,,DEVICE ;FN1 + 2000,,DEVFN2 ;DEVICE SND NAME + 402000,,DEVRDM + +ARCACS: SETZ ; .CALL WITH ACCESS POINTER IN A TO ACCESS + SIXBIT/ACCESS/ + 1000,,ARC + SETZ A + +ARCLEN: SETZ ; .CALL ARCLEN TO GET LENGTH OF FILE IN A + SIXBIT/FILLEN/ + 1000,,ARC + SETZM A + +BLKMAP: SETZ ; .CALL BLKMAP W/ A CONTAINING EITHER -1,,DIRPAG+2 + SIXBIT/CORBLK/ ; OR -2,,DIRPAG+2 AND B CONTAINING THE + 1000,,100000 ; -2,,PAGE NUMBER IN THE DISK FILE + 1000,,-1 + A + 1000,,ARC + SETZ B + +SCRMAP: SETZ ; .CALL SCRMAP TO GET A FRESH SCRATCH PAGE + SIXBIT/CORBLK/ ; AT DIRPAG+2 + 1000,,100000 + 1000,,-1 + 1000,,DIRPAG+2 + 401000,,400001 ; ABSOLUTE PAGES + +SCRFLS: SETZ ; .CALL SCRFLS TO FLUSH SCRATCH PAGE + SIXBIT/CORBLK/ + 1000,,0 + 1000,,-1 + 401000,,DIRPAG+2 + + +; UTILITY ROUTINES AND ADDRESSES + +; DIRMAP - MAP IN THE DIRECTORY PAGES + +DIRMAP: PUSH P,A + PUSH P,B + MOVE A,[-2,,DIRPAG] + HRLZI B,-2 + .CALL BLKMAP + JRST DTAERR + MOVE A,ARCDIR+GCTAG ; GET GC TAG + EXCH A,WHENGC ; SAVE AND GET WHAT I THINK IT IS + CAME A,WHENGC ; THE SAME? + SETZM Q ; NO - Q IS NOW INVALID + POP P,B + POP P,A + POPJ P, + + +; OPNARC - OPEN THE ARCHIVE IN THE REQUESTED MODE (IN A). IF THE +; FILE IS LOCKED, WAIT AROUND UNTIL IT CAN BE OPENED. + +OPNARC: PUSH P,A +OPNAR1: HRLZS A ; GET MODE INTO LEFT HALF + HRRI A,ARC ; PUT CHANNEL IN RIGHT HALF + .CALL ARCOPN ; TRY THE OPEN + JRST ARCNOP ; OPEN FAILED? - GO SEE WHY + AOS -1(P) ; WON - SKIP RETURN +OPNAR2: POP P,A + POPJ P, + +ARCNOP: .STATUS ARC,A ; FIND OUT WHY + LDB A,[220600,,A] ; GET OPEN FAILURE BITS + CAIE A,23 ; FILE LOCKED? + JRST OPNAR3 ; NO - FILE NOT FOUND +ARCNP3: MOVEI A,15 ; WAIT A HALF SECOND AND TRY AGAIN + .SLEEP A, + MOVE A,(P) + JRST OPNAR1 ; GO TRY AGAIN + +OPNAR3: MOVE A,[6,,ARC] + .CALL DSKDIR ;MAP IN DIRECTORY, AND SEARCH FOR ARCHIVE + JRST OPNAR2 ; NO SUCH USER + .CALL SCRMAP ;ALLOCATE PAGE + JRST OPNAR2 ;CANT GET PAGE + MOVE A,[-2000,,BLOCK3] + .IOT ARC,A + MOVEI A,BLOCK3 + ADD A,BLOCK3+1 ;PNTR TO NAME AREA + PUSH P,B + MOVE B,DEVICE +ARCNP1: CAIL A,BLOCK3+2000 + JRST ARCNP2 + CAMN B,UNFN1(A) ;FOUND ONE? + JRST ARCNP4 ;YES + ADDI A,LUNBLK + JRST ARCNP1 + +ARCNP2: POP P,B + .CALL SCRFLS + JFCL + .CLOSE ARC, + JRST OPNAR2 + +ARCNP4: POP P,B ; FOUND FILE, WAIT AND TRY AGAIN + .CALL SCRFLS + JFCL + .CLOSE ARC, + JRST ARCNP3 + +; BLTSCR - COPY ARCDIR INTO BLOCK3 (AFTER MAKING BLOCK3 EXIST) + +BLTSCR: PUSH P,A + .CALL SCRMAP ; GET SCRATCH PAGE FOR BLOCK3 + PUSHJ P,RETRY ; TRY IT AGAIN AFTER SLEEPING + MOVE A,[ARCDIR,,BLOCK3] + BLT A,BLOCK3+1777 + POP P,A + POPJ P, + +; BLTBCK - COPY BLOCK3 BACK INTO ARCDIR (AND FLUSH BLOCK3 PAGE) + +BLTBCK: PUSH P,A + MOVE A,[BLOCK3,,ARCDIR] + PUSHJ P,INTOFF ; BLT MUST NOT BE INTERRUPTED + BLT A,ARCDIR+1777 + .CALL SCRFLS + PUSHJ P,RETRY + PUSHJ P,INTON ; INTERRUPTS OK NOW + POP P,A + POPJ P, + +; RETRY - SLEEP AWHILE, THEN RETRY INSTRUCTION BEFORE THE CALL TO +; RETRY (USEFUL MAINLY FOR DYING OPENS MAPS. CLOBBERS A. + +RETRY: MOVEI A,15 + .SLEEP A, + POP P,A + JRST -2(A) ; RETRY THE INSTRUCTION + +; DSCBPT - TAKES AN ABSOLUTE POINTER TO A FILE NAME BLOCK AND RETURNS +; A BYTE POINTER TO THE DESCRIPTOR AREA FOR THAT FILE. + +DSCBPT: PUSH P,B ; SAVE B + LDB A,[UNDSCP+UNRNDM(Q)] ; GET THE INDEX + IDIVI A,UFDBPW ; CONVERT TO WORD COUNT + ADDI A,ARCDIR+UDDESC ; CONVERT TO ADDRESS + HLL A,QBTBLI(B) ; CONVERT TO BYTE POINTER + POP P,B + POPJ P, + +; DSCALO - ALLOCATE DESCRIPTOR BYTES - CALLED WITH A POINTER +; TO A NAME BLOCK IN Q AND A BYTE COUNT IN B - RETURNS A BYTE +; POINTER TO A SEQUENCE OF (B) CONSECUTIVE BYTES THAT CAN BE +; USED BY THE CALLER. DSCALO WILL INSURE THAT BYTE (B)+1 +; CONTAINS ZERO AND IS NOT USED BY ANYBODY. DSCALO HARD LOCKS +; THE FILE - COPIES IT TO BLOCK3 - MODIFIES IT - AND COPIES +; IT BACK. + +DSCALO: PUSHJ P,HLOCK ; HARD LOCK THE FILE + PUSHJ P,BLTSCR ; COPY DIRECTORY TO SCRACH AREA + PUSH P,C + SETZM C ; NO GC TRIED YET + MOVEI A,BLOCK3-ARCDIR(Q) ; RELOCATE POINTER +DSCAL0: MOVE TT,BLOCK3+UDESCP ; GET INDEX OF FREE BYTE + ADDI TT,1(B) ; INCREMENT BY # DESIRED (+ ZERO TRAILER) + IDIVI TT,UFDBPW ; GET WORD INDEX + SKIPE I ; (I = TT+1) + AOS TT + ADDI TT,UDDESC ; GET INDEX + CAMGE TT,BLOCK3+UDNAMP ; ENOUGH ROOM BEFORE NAME AREA? + JRST DSCAL1 ; YES - GO ALLOCATE + JUMPN C,DIRFUL ; ERROR DIRECTORY FULL + PUSH P,A + HRLZI A,(SKIPA) ; TAKE EVERYTHING + PUSHJ P,GCDIR + POP P,A + JRST DSCAL0 ; TRY AGAIN + +DSCAL1: AOS B ; INCREMENT B - TOTAL # OF BYTES NEEDED + MOVE TT,BLOCK3+UDESCP ; GET INDEX OF FIRST FREE ONE + DPB TT,[UNDSCP+UNRNDM(A)] ; STORE NEW BYTE INDEX + ADDM B,BLOCK3+UDESCP ; UPDATE INDEX + IDIVI TT,UFDBPW ; MAKE BYTE POINTER TO FIRST BYTE + ADDI TT,BLOCK3+UDDESC + HLL TT,QBTBLI(I) ; (I = TT+1) + PUSH P,TT ; SAVE THE BYTE POINTER + SETZM A ; ZERO ALL THE BYTES + IDPB A,TT + SOJG B,.-1 + PUSHJ P,BLTBCK ; REPLACE UPDATED DIRECTORY + PUSHJ P,HULOCK ; UNLOCK FILE + POP P,A ; GET BYTE POINTER INTO A + SUBI A,BLOCK3-ARCDIR ; CONVERT BYTE POINTER TO POINT TO ARCDIR + POP P,C ; RESTORE C + POPJ P, ; DONE + + +; FBTALO - ALLOCATE A FBAT TABLE ENTRY (ASSUMES FBAT IS ALREADY +; MAPPED INTO THE CORRECT AREA OF BLOCK2) +; RETURNS FBAT TABLE INDEX OF ALLOCATED ENTRY IN A + +FBTALO: PUSHJ P,HLOCK ; FILE MUST BE SOFT LOCKED TO DO THIS + MOVE A,FBAT ; GET FBAT CHAIN POINTER + JUMPE A,DEVFUL ; IF IT POINTS TO ITSELF - DEVICE FULL + PUSH P,B + MOVE B,FBAT(A) ; GET LINK POINTER IN ENTRY TO BE ALLOCATED + SETOM FBAT(A) ; MARK ENTRY AS ALLOCATED + TLZ B,400000 ; TURN OFF IN USE BIT OF LINK POINTER + MOVEM B,FBAT ; MAKE FBAT CHAIN START WITH NEXT ENTRY + MOVEM A,IDXFBT + PUSHJ P,HULOCK + POP P,B + POPJ P, + +; FBTFRE - FREE A FBAT TABLE ENTRY +; CALLED WITH FBAT INDEX IN A + +FBTFRE: PUSHJ P,HLOCK ; FILE MUST BE HARD LOCKED + SKIPLE A ; DO BOUNDS CHECK ON INDEX + CAILE A,FBTLEN + .VALUE ; OUT OF BOUNDS - DEBUG + PUSH P,B ; OK - FREE IT + MOVE B,FBAT ; GET START OF CHAIN POINTER + MOVEM B,FBAT(A) ; MAKE NEW FREE ENTRY POINT TO START + TLZ A,400000 ; MAKE SURE "IN USE" BIT IS OFF + MOVEM A,FBAT ; MAKE CHAIN POINT TO NEWLY FREED ENTRY + PUSHJ P,HULOCK + POP P,B + POPJ P, + + +; BLKALO - ALLOCATE A DATA BLOCK. NO INPUT ARGUMENTS. RETURNS WITH +; THE NECESSARY BLOCKS MAPPED INTO DATAB1 (AND DATAB2 IF NECESSARY). +; BLKALO WILL RETURN THE ABSOLUTE ADDRESS OF THE BLOCK HEADER OF THE +; ALLOCATED BLOCK. BLKALO ASSUMES THAT BLOCK2 IS MAPPED IN. + +BLKALO: PUSHJ P,HLOCK ; FILE MUST BE HARD LOCKED TO DO THIS + AOS FC10 + PUSH P,A + PUSH P,B + SKIPN A,FCHAIN ; GET POINTER TO START OF FREE BLOCK CHAIN + JRST BLKXTN ; FREE CHAIN EMPTY - EXTEND FILE + SKIPE -1(P) ; DOES HE WANT ADDRESS STORED? + ADDM A,@-1(P) ; YES - ADD INTO THE WORD HE SAYS + PUSHJ P,MAPDBL ; MAP IN THE DATA BLOCKS + MOVEM A,BLKPOS ; SAVE IT + LDB B,[002700,,DATAB1(A)] ; GET ADDRESS OF NEXT BLOCK + MOVEM B,FCHAIN ; SPLICE FREE CHAIN + MOVE B,DATAB1(A) ; NOW FIX UP HEADER WORD + TDZ B,[500037,,777777] ; INITIALIZE BITS - ZERO SOME + TLO B,200000 ; AND SET OTHERS TO ONE + MOVEM B,DATAB1(A) + SOS FBLCKS ; ONE LESS FREE BLOCK NOW + AOS DBLCKS ; ONE MORE DATA BLOCK + LDB B,[271200,,DATAB1(A)] ; GET LENGTH OF BLOCK + ADDM B,DWORDS ; ADD THAT TO DATA WORD COUNT + MOVE A,FWORDS ; SUBTRACT FROM FREE WORD COUNT + SUB A,B + MOVEM A,FWORDS + MOVE A,BLKPOS + ADDI A,2(B) ; POINT TO END OF BLOCK + MOVE B,DATAB1(A) + TDZ B,[500037,,-1] + TLO B,200000 + MOVEM B,DATAB1(A) + MOVE A,DATOFF ; RETURN OFFSET POINTER + PUSHJ P,HULOCK ; CAN UNLOCK THE FILE NOW + POP P,B + POP P,(P) + POPJ P, ; DONE + + +; COME TO BLKXTN IF THE ARCHIVE NEEDS EXTENDING (I.E. THE FREE BLOCK +; CHAIN IS EMPTY). BLKXTN ASSUMES THAT THE ARCHIVE IS OPEN IN WRITE- +; OVER MODE. HLOCK (HARD LOCKING) THE FILE WILL LEAVE "ARC" OPEN IN +; THAT MODE. + +BLKXTN: AOS FC11 + .CALL ARCLEN ; FIND OUT LENGTH OF ARCHIVE FILE + JRST DTAERR ; ERROR IF CAN'T + MOVEM A,DATADR ; SAVE ACCESS POINTER OF TO-BE-BUILT BLOCK + SKIPE -1(P) ; DOES USER WANT ADDRESS TO GO SOMEWHERE? + ADDM A,@-1(P) ; YES- PUT IT AWAY + .CALL ARCACS ; ACCESS TO THE END OF THE FILE + JRST DTAERR ; WHY NOT? + TRZ A,1777 ; FLUSH SUB PAGE + ADDI A,2000 ; GO TO NEXT PAGE BOUNDARY + SUB A,DATADR ; GET TOTAL NUMBER OF WORDS + CAIN A,1 ; IS THERE ONLY 1 WORD LEFT? + MOVEI A,2001 ; YES - USE 2001 WORD BLOCK + CAIGE A,MINBLS ; OVER MINIMUM BLOCK SIZE? + MOVEI A,2002 ; NO - USE 2002 WORD BLOCK + PUSH P,A ; SAVE WORD COUNT + MOVN B,A + HRLZS B ; MAKE IOT POINTER TO IOT GARBAGE + .IOT ARC,B ; IOT IS JUST TO EXTEND THE FILE + PUSHJ P,HULOCK ; UNLOCK FILE + PUSHJ P,SLOCK ; SOFT LOCK FILE + MOVE B,DATADR ; NOW MAP IN THE NEW PAGES + LSH B,-10. + HRLI B,-2 ; ASK FOR TWO PAGES - MIGHT ONLY GET 1 + MOVE A,[-2,,DATPAG] ; MAP INTO DATAB1 + .CALL BLKMAP + JFCL ; PROBABLY FAILED BECAUSE ONLY 1 PAGE THERE + LDB A,[001200,,DATADR] ; GET OFFSET IN BLOCK + MOVEM A,DATOFF + MOVE B,(P) ; GET WORD COUNT + SUBI B,3 ; LESS 3 FOR HEADER, TRAILER AND 0=1 + LSH B,23. ; PUT INTO THE RIGHT POSITION + TLO B,200000 ; INDICATE LAST BLOCK + MOVEM B,DATAB1(A) ; STORE HEADER + AOS FC21 + AOS A ; POINT AT FIRST DATA WORD + SETZM DATAB1(A) ; MAKE IT ZERO + PUSH P,A ; SAVE DATA ADDRESS + ADD A,-1(P) ; ADD WORD COUNT TO GET ADDRESS OF TRAILER + MOVEM B,DATAB1-2(A) ; STORE TRAILER + PUSHJ P,SULOCK ; DATA BLOCK BOUNDED - UNLOCK FILE + POP P,B ; GET ADDRESS OF START OF DATA + HRLS B ; GET ADDRESS INTO LEFT HALF + AOS B ; MAKE BLT POINTER + ADD B,[DATAB1,,DATAB1] ; MAKE ABOSULTE + BLT B,DATAB1-3(A) ; ZERO THE ENTIRE DATA AREA + POP P,(P) ; FLUSH STACK + MOVE A,DATOFF ; RETURN OFFSET IN THE BLOCK + AOS DBLCKS ; ONE MORE DATA BLOCK + LDB B,[271200,,DATAB1(A)] ; GET BLOCK LENGTH + ADDM B,DWORDS ; INCREMENT NUMBER OF WORDS + POP P,B + POP P,(P) + AOS FC22 + POPJ P, + +; BLKFRE - CALL BLKFRE WITH AN INDEX TO A BLOCK MAPPED INTO DATAB1. +; BLKFRE WILL RETURN THE BLOCK TO THE FREE CHAIN. THE BLOCK IS NOT___ +; GUARANTEED TO BE IN CORE WHEN BLKFRE IS FINISHED. + +BLKFRE: PUSHJ P,HLOCK ; HARD LOCK THE FILE + PUSH P,B + HLLZ B,DATAB1(A) ; GET BLOCK HEADER (NOT ADDRESS) + TLZ B,700037 ; ISOLATE BLOCK LENGTH + TLO B,400000 ; TURN ON FREE BIT + ADD B,FCHAIN ; STICK IN POINTER TO NEXT BLOCK IN FREE CHAIN + MOVEM B,DATAB1(A) ; MAKE NEWLY FREED BLOCK POINT TO FREE CHAIN + MOVE B,DATADR ; GET ADDRESS OF CURRENTLY MAPPED IN BLOCK + SUB B,DATOFF ; GET ACCESS POINTER OF BEGINNING OF MAPPED STUFF + ADD B,A ; GET ACCESS POINTER OF BLOCK BEING FREED + MOVEM B,FCHAIN ; MAKE FREE CHAIN POINT TO IT + LDB B,[271200,,DATAB1(A)] ; GET LENGTH OF FREED BLOCK + PUSH P,B + MOVE B,DWORDS ; UPDATE NUMBER OF DATA WORDS + SUB B,(P) + MOVEM B,DWORDS + SOS DBLCKS ; ONE LESS DATA BLOCK + POP P,B + AOS FBLCKS ; ONE MORE FREE BLOCK + ADDM B,FWORDS + ADDI B,2(A) ; FIXUP FREE BLOCK'S TRAILER + PUSH P,C + MOVE C,DATAB1(A) + TDZ C,[37,,777777] ;CLEAR ADDRESS FIELD + MOVEM C,DATAB1(B) + POP P,C + PUSHJ P,HULOCK ; DONE - UNLOCK FILE + POP P,B + POPJ P, + + +; FILFRE - CALL FILFRE TO FREE ALL OF THE DATA BLOCKS OF THE CURRENT +; FILE. + +FILFRE: PUSH P,A + PUSH P,B + PUSH P,C + PUSHJ P,DSCBPT ; GET BYTE POINTER TO DESCRIPTOR AREA + ILDB B,A ; GET FIRST BYTE + CAIE B,40 ; IS IT FBAT INDEX? + JRST FILFR9 ; NO - FILE EMPTY - NOTHING TO DO + ILDB B,A ; GET FBAT INDEX + ILDB C,A + LSH B,6 + ADD B,C + PUSH P,B ; SAVE FBAT INDEX + SKIPG A,FBAT(B) ; GET ADDRESS OF FIRST BLOCK + JRST FILFR8 ; NO BLOCKS - GO FREE FBAT ENTRY +FILFR0: TLZ A,777740 ; FLUSH NON-ADDRESS BITS + PUSHJ P,MAPDBL ; MAP THE BLOCK IN + PUSH P,DATAB1(A) ; SAVE BLOCK HEADER + PUSHJ P,BLKFRE ; FREE THE BLOCK + POP P,A ; GET OLD BLOCK HEADER + TLNN A,200000 ; WAS IT LAST BLOCK? + JRST FILFR0 ; NO - KEEP FREEING +FILFR8: POP P,A ; YES - GET FBAT INDEX BACK + PUSHJ P,FBTFRE ; RETURN IT TO FREE CHAIN +FILFR9: POP P,C + POP P,B + POP P,A + POPJ P, + + ; ENDFRE - CALL ENDFRE WITH A WORD COUNT IN A TO FREE THE END OF THE +; CURRENTLY MAPPED DATA BLOCK. THE WORD COUNT SHOULD BE THE NUMBER +; OF DATA WORDS (NOT INCLUDING HEADER OR TRAILER) TO BE RETAINED. +; IF A IS ZERO - THE ENTIRE BLOCK WILL BE RELEASED. + +ENDFRE: PUSH P,A + PUSH P,B + PUSH P,C + JUMPE A,ENDFR1 ; 0 => FREE THE WHOLE THING + MOVE B,DATOFF ; GET OFFSET OF CURRENT DATA BLOCK + LDB C,[271200,,DATAB1(B)] ; GET LENGTH OF BLOCK + AOS C ; LENGTH STORED 0-1777 FOR 1-2000 + CAML A,C ; RETAINING LESS THAN ALL? + JRST ENDFR9 ; NO - DONE + SUB A,C ; GET NEW LENGTH OF DATA BLOCK + MOVMS A + PUSH P,A ; SAVE LENGTH OF REAL BLOCK + SOS A ; STORED AS LENGTH -1 + LSH A,23. ; MOVE LENGTH INTO RIGHT FIELD + TLO A,200000 ; SET LAST BLOCK BIT + MOVEM A,DATAB1(B) ; STORE NEW HEADER + ADDI C,1(B) ; GET INDEX OF CURRENT TRAILER + ADD B,(P) ; AND INDEX OF NEW TRAILER + AOS B + PUSH P,A ; FIX UP TRAILER + LDB A,[002700,,DATAB1(C)] + ADDM A,(P) ; FIX UP ITS BACKWARD POINTER + POP P,DATAB1(B) + POP P,(P) ; FLUSH LENGTH FROM STACK + AOS B ; MAKE B POINT TO HEADER OF NEW SUB-BLOCK + CAILE B,-2(C) ; ENOUGH ROOM FOR HEADER AND TRAILER? + JRST ENDFR8 ; NO - HELL - TWO LOST WORDS + AOS DBLCKS ; SPLITTING THE BLOCK HAS MADE 2 BLOCKS FROM 1 + SOS DWORDS ; TWO DATA WORDS GOING TO OVERHEAD + SOS DWORDS + MOVE A,-2(P) ; GET LENGTH OF NEW BLOCK + SUBI A,3 ; ALLOW FOR HEADER, TRAILER AND 0=1 + LSH A,23. ; SHIFT INTO LENGTH AREA + MOVEM A,DATAB1(B) ; MAKE IT HEADER AND TRAILER + MOVEM A,DATAB1(C) + SKIPA A,B ; PUT OFFSET OF TO BE FREED BLOCK INTO 1 +ENDFR1: MOVE A,DATOFF ; FREE THE ENTIRE CURRENT BLOCK + PUSHJ P,BLKFRE ; FREE THE END OF THE BLOCK +ENDFR9: POP P,C + POP P,B + POP P,A + POPJ P, + +ENDFR8: HRLZI A,600000 ; ONLY ONE WORD GAP - SET FREE AND LAST BITS + MOVEM A,DATAB1(B) + SOS DWORDS ; ONE DATA WORD GOING TO OVERHEAD + MOVEM A,DATAB1(C) + SOS DWORDS ; ONE DATA WORD GOING TO OVERHEAD + JRST ENDFR9 + + +; MAPDBL - MAP IN A DATA BLOCK - CALLED WITH ACCESS POINTER TO DATA +; BLOCK HEADER IN A. + +MAPDBL: CAMN A,DATADR ; IS THE REQUIRED BLOCK ALREADY IN? + JRST MAPDB2 ; YES - DON'T HAVE TO MAP + PUSH P,B + MOVEM A,DATADR ; SAVE NEW BLOCK ACCESS POINTER + LDB B,[001200,,A] ; GET OFFSET IN BLOCK + MOVEM B,DATOFF ; SAVE IT + PUSH P,B ; PUT ON STACK TO RETURN IT TO CALLER + LSH A,-10. ; TURN INTO A PAGE NUMBER + MOVE B,A + HRLI B,-DBMSIZ ; MAKE AOBJN POINTER + SKIPE LOCKSW ; IS FILE LOCKED? + JRST MAPDB1 ; YES - THEREFORE ITS OPEN + MOVEI A,6 ; NO - OPEN IT FOR MAPPING + PUSHJ P,OPNARC + JRST DTAERR ; WHAT? +MAPDB1: MOVEI A,DATPAG ; GET PAGE # OF DATA BLOCK AREA + HRLI A,-DBMSIZ + .CALL BLKMAP ; MAP IN THE PAGES + JFCL ; FAILURE MIGHT MEAN PARTIAL SUCCESS + SKIPN LOCKSW ; FILE LOCKED? + .CLOSE ARC, ; NO - MAPDBL OPENED IT - CLOSE IT + HLRE B,A ; NOW SEE WHAT WE GOT + ADDI B,DBMSIZ ; AND SEE IF ITS ENOUGH + LSH B,10. ; TURN INTO WORD COUNT + SUB B,(P) ; GET WORD COUNT AFTER START OF DATA BLOCK + MOVE A,DATOFF + LDB A,[271200,,DATAB1(A)] ; GET DATA BLOCK SIZE + CAML A,B ; DID WE GET ENOUGH PAGES MAPPED IN + JRST DTAERR ; NO - FILE MUST BE CLOBBERED + POP P,A ; YES - RETURN OFFSET IN DATAB1 + POP P,B + POPJ P, + +MAPDB2: MOVE A,DATOFF ; BLOCK ALREADY IN - RETURN OFFSET + POPJ P, + + + +; NOWIDX - CALLED TO INSURE THAT THE DIRECTORY ENTRY POINTER IN Q +; IS STILL VALID. IF IT IS NOT, A POINTER TO THE DIRECTORY ENTRY +; FOR THE FILE CURRENTLY WILL BE PLACED INTO Q (OR -1 IF THE ENTRY +; HAS DISAPPEARED). NOWIDX SHOULD BE CALLED WITH THE ARCHIVE LOCKED. + +NOWIDX: SKIPN IFOPEN ; DO NOTHING UNTIL FILE IS OPEN + POPJ P, + PUSH P,A + JUMPLE Q,NOWID1 ; IF Q=0, THEN ALWAYS GET NEW INDEX + MOVE A,WHENGC ; Q NON-ZERO, HAS GC OCCURED? + CAME A,ARCDIR+GCTAG ; FIND OUT BY SEEING IF GCTAG HAS CHANGED + JRST NOWID1 ; DIFFERENT - GET NEW INDEX + SKIPN UNFN1(Q) ; HAS SOMEBODY DELETED IT? + SETOM Q ; YES - Q NOT VALID + POP P,A ; NO CHANGE - Q STILL VALID + POPJ P, + +NOWID1: PUSH P,B + PUSH P,C + MOVE B,ARCDIR+UDNAMP ; GET POINTER TO FIRST ENTRY + ADDI B,ARCDIR ; MAKE ABSOLUTE + SETOM Q ; Q=-1 IF ENTRY IS GONE + MOVE A,CRDATE ; LOOK FOR MATCHING CREATION DATE +NOWID2: CAIL B,ARCDIR+2000 ; STILL IN BOUNDS? + JRST NOWID5 ; YES - ENTRY IS GONE + CAMN A,UNDATE(B) ; IS THIS POSSIBLE? + JRST NOWID4 ; YES - GO LOOK FURTHER +NOWID3: ADDI B,LUNBLK ; GO TO NEXT ENTRY + JRST NOWID2 ; AND TRY AGAIN + +NOWID4: MOVE A,FNAME1 ; POSSIBILITY - CHECK FURTHER + CAME A,UNFN1(B) ; DO NAMES MATCH? + JRST NOWID6 ; NO - NOT IT + MOVE A,FNAME2 + CAME A,UNFN2(B) + JRST NOWID6 + LDB A,[UNBOJN+UNRNDM(B)] ; GET CREATOR INDEX + LDB C,[UNBOJN+RANDOM] ; GET INDEX OF OUR CREATOR + CAME A,C ; MATCH? + JRST NOWID6 ; NO - NOT IT + MOVE Q,B ; THIS IS IT - UPDATE Q +NOWID5: POP P,C + POP P,B + POP P,A + POPJ P, + +NOWID6: MOVE A,CRDATE + JRST NOWID3 + + + +; NEWBLK - THIS ROUTINE IS CALLED TO MAP IN THE DATA BLOCK THAT +; FOLLOWS THE DATA BLOCK CURRENTLY MAPPED. IF THE CURRENT DATA +; BLOCK IS THE LAST DATA BLOCK IN THE SUB-FILE, NEWBLK WILL +; EXAMINE THE OPEN MODE. IF THE SUB-FILE IS OPEN FOR OUTPUT, A +; NEW DATA BLOCK WILL BE ALLOCATED. IF THE SUB-FILE IS OPEN FOR +; INPUT, THEN NEWBLK WILL FAIL TO SKIP. + +NEWBLK: AOS FC12 + MOVE B,DATOFF ; GET OFFSET OF CURRENT BLOCK + MOVE A,DATAB1(B) ; GET HEADER OF CURRENT BLOCK + TLNE A,200000 ; IS IT LAST BLOCK? + JRST NEWBL1 ; YES - GO HANDLE DIFFERENT + AOS FC15 + TLZ A,777740 ; NO - JUST MAP IN NEXT BLOCK + PUSHJ P,MAPDBL +NEWBL0: AOS FC16 + AOS A ; GET POINTER TO DATA AREA + MOVEM A,BLKPOS + AOS FC17 + LDB B,[271200,,DATAB1-1(A)] ; GET LENGTH OF BLOCK + AOS B ; LENGTH STORE WITH ONE SUBTRACTED + MOVEM B,WDLFIB ; SAVE AS # OF WORDS LEFT + IMULI B,5 ; SAVE # OF CHARS LEFT + MOVEM B,CHLFIB + MOVEI B,DATAB1(A) ; MAKE BPTR TO BEGINNING OF BLOCK + HRLI B,440700 + MOVEM B,BLBPTR + AOS (P) ; SKIP RETURN + AOS FC18 + POPJ P, + +NEWBL1: MOVE C,OPMODE ; AT END OF FILE - WHAT MODE ARE WE IN + AOS FC19 + TRNN C,1 ; OPEN FOR OUTPUT? + POPJ P, ; NO - DON'T EXTEND - DON'T SKIP + AOS FC20 + TLZ A,200037 ; ISOLATE LENGTH FIELD + TRZ A,-1 + MOVEM A,DATAB1(B) ; RESET HEADER + LSH A,-23. + ADDI A,2(B) ; GET ADDRESS OF TRAILER + HRLZI C,200000 ; TURN OFF LAST BLOCK BIT + ANDCAM C,DATAB1(B) + ANDCAM C,DATAB1(A) + PUSH P,DATADR ; SAVE ACCESS POINTER OF CURRENT DATA BLOCK + MOVEI A,DATAB1(B) ; MAKE BLKALO UPDATE CHAIN + AOS FC13 + PUSHJ P,BLKALO ; ALLOCATE A NEW BLOCK + AOS FC14 + SETZM NEWFIL ;CONSIDER AS A NEW FILE + LDB B,[271200,,DATAB1(A)] ; GET NEW LENGTH + MOVE C,B + ADDI C,DATAB1+2(A) ; GET ABSOLUTE ADDRESS OF TRAILER + EXCH C,(P) ; SAVE ADDRESS - GET BACK ADDRESS OF OLD POINTER + ADDM C,@(P) ; MAKE NEW BLOCK TRAILER LINK BACKWARDS + POP P,(P) + JRST NEWBL0 + + +; NOSUCH - COME HERE TO REPORT "NO SUCH DEVICE" UNLESS NEW ARCHIVE CAN BE STARTED + +NOSUCH: MOVE A,OPMODE ; SEE IF OPEN FOR WRITING + TRNE A,1 + JRST NEWARC ; YES - START A NEW ARCHIVE IF POSSIBLE + +; NOSDEV - COME HERE TO ALWAYS REPORT "NO SUCH DEVICE" + +NOSDEV: HRLZI H,1 + JRST OPFAIL + +; OPFAIL - COME HERE WITH FAILURE CODE IN LEFT HALF OF H TO REPORT +; OPEN FAILURE + +OPFAIL: SETZM I ; COME HERE TO REPORT OPEN FAILURE + SKIPL CLSINP ; ERROR WHILE CLOSE IN PROGRESS? + JRST CLSDIE ;THEN JUST GO AWAY + .CALL JRET + JFCL + SKIPN IFOPEN ; IS THIS .CALL FAILURE? + JRST CLOSE ; NO - OPEN FAILURE - DIE + JRST LOOP ; .CALL FAILURE - STAY IN LOOP + +; COME HERE TO REPORT "WRONG DIRECTION" ERROR + +WRGDIR: HRLZI H,2 ; WRONG DIRECTION + JRST OPFAIL + +; COME HERE TO REPORT "DEVICE NOT IN READY STATE" TO INDICATE +; CLOBBERED ARCHIVE + +DTAERR: HRLZI H,7 + JRST OPFAIL + +; COME HERE TO REPORT "DIRECTORY FULL" + +DIRFUL: HRLZI H,5 + JRST OPFAIL + + +; COME HERE TO REPORT "DEVICE FULL" + +DEVFUL: HRLZI H,6 + JRST OPFAIL + +; COME HERE TO REPORT ACCESS BEYOND END OF FILE + +PSTEOF: MOVEI I,2 ; REPORT ACCESS BEYOND EOF + .CALL JIOC ; BY GENERATING IOC ERR + JFCL + JRST LOOP ; BUT DON'T DIE (HE MIGHT ACCESS) + +; COME HERE TO REPORT A MODE ERROR (ILLEGAL MODE MADE +; IT TO AN IOT ROUTINE. + +MODERR: HRLZI H,2 + JRST OPFAIL + +; TOOFEW - COME HERE TO INDICATE TOO FEW ARGS ON A .CALL + +TOOFEW: HRLZI H,30 + JRST OPFAIL + + + +; THIS PAGE CONTAINS ROUTINES USED TO LOCK AND UNLOCK THE ARCHIVE + +; SLOCK - SOFT LOCK - ALLOW OTHER SOFT LOCKS, BUT NO HARD LOCKS. +; FAIL IF ANYBODY ELSE HAS A HARD LOCK. + +; SULOCK - UNDO SOFT LOCK + +; HLOCK - HARD LOCK - ALLOW NO OTHER LOCKS OF ANY KIND, BUT FAIL IF +; ANYBODY ELSE HAS A LOCK OF EITHER KIND ON THE +; ARCHIVE. + +; HULOCK - UNDO A HARD LOCK + +; BULOCK - UNDO HARD AND SOFT LOCK + +SLOCK: PUSHJ P,INTOFF ; LOCK IMPLIES NO INTERRUPTS + PUSH P,A + MOVE A,LOCKSW ; GET LOCK STATE + TRNE A,1 ; DO I ALREADY HAVE IT SOFT LOCKED? + JRST LOCKRT ; YES - DO NOTHING + TRO A,1 ; GOING TO SOFTLOCK - SET THE FLAG + MOVEM A,LOCKSW + TRNE A,2 ; DO I ALREADY HAVE IT HARD LOCKED? + JRST LOCKRT ; YES - DO NOTHING ELSE +SLOCK1: MOVEI A,6 ; OTHERWISE - OPEN FOR READING TO + PUSHJ P,OPNARC ; SOFT LOCK IT + JRST NOSDEV ; REALLY REPORT NO SUCH DEVICE? + PUSHJ P,NOWIDX ; MAKE SURE Q IS CORRECT +LOCKRT: POP P,A ; DONE + POPJ P, + +SULOCK: PUSH P,A + MOVE A,LOCKSW ; GET LOCK STATE + TRNN A,1 ; SOFT LOCKED? + JRST ULOCRT ; NO - IGNORE UNLOCK + TRZ A,1 ; YES - UNLOCK IT + MOVEM A,LOCKSW + TRNN A,2 ; HARD LOCKED TOO? + .CLOSE ARC, ; NO - CLOSE FILE TO UNLOCK +ULOCRT: PUSHJ P,INTON + JRST LOCKRT + +HLOCK: PUSHJ P,INTOFF + PUSH P,A + MOVE A,LOCKSW ; GET LOCK STATE + TRNE A,2 ; ALREADY HARD LOCKED? + JRST LOCKRT ; YES - DO NOTHING + TRO A,2 ; SET HARD LOCK FLAG + MOVEM A,LOCKSW + MOVEI A,100007 ; NO - OPEN FOR WRITE OVER TO HARD LOCK + PUSHJ P,OPNARC ; - USES SAME CHANNEL SO SOFT LOCK GETS CLOSED + JRST NOSDEV ; SHOULDN'T HAPPEN - REPORT NO SUCH DEVICE + PUSHJ P,NOWIDX ; MAKE SURE Q IS CORRECT + JRST LOCKRT + +HLOCK1: PUSHJ P,INTON + JRST SLOCK1 + +HULOCK: PUSH P,A + MOVE A,LOCKSW ; GET LOCK STATE + TRNN A,2 ; HARD LOCKED? + JRST ULOCRT ; NO - IGNORE UNLOCK + TRZ A,2 ; TURN OFF FLAG + MOVEM A,LOCKSW + TRNE A,1 ; ALSO SOFT LOCKED? + JRST HLOCK1 ; YES - GO REOPEN IN SOFTLOCK MODE + .CLOSE ARC, ; NO - CLOSE FILE TO UNLOCK + JRST ULOCRT + +BULOCK: PUSH P,A + SKIPN LOCKSW ; ANY LOCKS AT ALL? + JRST LOCKRT + .CLOSE ARC, ; YES - CLOSE WHATEVER IT IS + MOVE A,LOCKSW ; SEE WHAT WAS LOCKED + TRNE A,1 ; UNLOCK INTERRUPTS INTS ONCE FOR EACH + PUSHJ P,INTON + TRNE A,2 + PUSHJ P,INTON + SETZM LOCKSW ; AND ERASE LOCK FLAGS + JRST LOCKRT + + +; OPEN - PROCESS A REQUEST FOR AN OPEN ON THE ARC DEVICE + +OPEN: MOVE A,WD3 ; COPY SUB-FILE NAMES + MOVEM A,FNAME1 + MOVE A,WD4 + MOVEM A,FNAME2 + MOVE A,WD5 + MOVEM A,DIRECT + MOVE A,WD6 + MOVEM A,DEVICE + MOVE A,WD7 ; SAVE OPEN MODE + MOVEM A,OPMODE + HRLZ A,OPMODE ; GET OPEN MODE + TLZ A,777770 ; ISOLATE BASIC OPEN MODES + TLC A,1 ; COMPLEMENT READ/WRITE MODE + TLO A,10 ; MAKE SURE OPPOSITE DIRECTION BIT IS ON + HRRI A,(SIXBIT/BOJ/) + .OPEN BOJC,A ; OPEN BOJ IN THE CORRECT MODE + JRST DTAERR ; ERROR IF CANT + .CALL RFBLK + JFCL + MOVEI A,6 ; NOW TRY TO OPEN ARCHIVE + PUSHJ P,OPNARC + JRST NOSUCH ; ARCHIVE DOESN'T EXIST + .CALL ARCRN2 ; RESOLE REAL FILE NAMES + JFCL + PUSHJ P,DIRMAP ; MAP IN THE DIRECTORY + .CLOSE ARC, ; CLOSE THE ARCHIVE + MOVE A,FNAME1 ; MY KIND OF ARCHIVE + MOVE B,FNAME2 ; SEE IF HE ASKED FOR DIRECTORY + CAMN A,[SIXBIT/.FILE./] + CAME B,[SIXBIT/(DIR)/] + JRST FILOPN ; NO - GO OPEN THE FILE + SETOM OPTYPE ; SET DIRECTORY OPEN FLAG + MOVE A,OPMODE ; GET OPEN MODE + TRNE A,777771 ; OPEN FOR WRITING? + JRST WRGDIR ; WRONG DIRECTION - LOSE + TRNE A,4 ; ASCII OR IMAGE DIRECTORY? + JRST OPNWIN ; THAT'S ALL FOR IMAGE DIRECTORY + LDB A,[360600,,SYSTEM] + ADDI A,40 + DPB A,[350700,,DIRHDR] + LDB A,[300600,,SYSTEM] + ADDI A,40 + DPB A,[260700,,DIRHDR] + MOVE A,[100700,,DIRHDR] + MOVE I,DIRECT ; PUT DEVICE NAME INTO HEADER +OPDIR1: SETZM TT + LSHC TT,6 + ADDI TT,40 + IDPB TT,A + JUMPN I,OPDIR1 + MOVE A,[350700,,DIRHDR+2] + MOVE I,DEVICE ; NOW PUT IN DIRECTORY NAME +OPDIR2: SETZM TT + LSHC TT,6 + ADDI TT,40 + IDPB TT,A + JUMPN I,OPDIR2 + MOVE A,[260700,,DIRHDR+3] + MOVE I,DEVFN2 ; NOW PUT IN DIRECTORY NAME +OPDIRX: SETZM TT + LSHC TT,6 + ADDI TT,40 + IDPB TT,A + JUMPN I,OPDIRX + MOVE A,[ASCII/ 0% /] ; NOW PUT IN STATISTICS + SKIPN TT,DBLCKS ; OVERHEAD FIRST + JRST OPDIR3 ; NO DATA - 0% OVERHEAD + IMULI TT,200. ; ALLOW FOR PERCENTAGE AND 2 WORD OVERHEAD + IDIV TT,DWORDS ; OVERHEAD (DBLCKS*200)-DWORDS + IDIVI TT,10. + ADDI I,"0 + DPB I,[170700,,A] + JUMPE TT,OPDIR3 ; QUIT WHEN NO MORE DIGITS + IDIVI TT,10. + ADDI I,"0 + DPB I,[260700,,A] + JUMPE TT,OPDIR3 + ADDI TT,"0 + DPB TT,[350700,,A] +OPDIR3: MOVEM A,DIRHDR+5 + MOVE A,[ASCII/ 100%/] + SKIPN B,DWORDS ; IF NO DATA - 100% EMPTY + JRST OPDIR4 + MOVE A,[ASCII/ 0%/] + SKIPN TT,FWORDS ; ANY FREE WORDS + JRST OPDIR4 ; NO - 0% EMPTY + ADD B,TT + IMULI TT,100. ; ALLOW FOR PERCENTAGE + IDIV TT,B ; % EMPTY - FWORDS/(DWORDS+FWORDS) + IDIVI TT,10. + ADDI I,"0 + DPB I,[100700,,A] + JUMPE TT,OPDIR4 + ADDI TT,"0 + DPB TT,[170700,,A] +OPDIR4: MOVEM A,DIRHDR+10 + MOVEI A,ARCDIR ; INITIALIZE THE LISTF + MOVE B,[440700,,DIRHDR] + PUSHJ P,SLISTF +OPNWIN: SETOM IFOPEN ; SET NOW OPEN SWITCH +SKPWIN: MOVEI H,1 ; MAKE HIM SKIP + SETZM I ; NO - RETURNS + .CALL JRET + JFCL ; WHAT? + JRST LOOP ; GO BACK INTO THE LOOP + + + +; FILOPN - COME HERE TO OPEN A SUB-FILE IN THE ARCHIVE + +FILOPN: SETOM BLKPOS ; NO DATA BLOCK HERE YET + MOVE C,OPMODE ; GET OPEN MODE + TRNE C,1 ; OPEN FOR READING? + JRST OPNWRT ; NO - GO OPEN FOR WRITING + PUSHJ P,SLOCK ; SOFT LOCK THE FILE + MOVEI T,OPFAIL ; FNF IS AN OPEN FAILURE + PUSHJ P,QLOOK ; ATTEMPT A LOOK UP + JRST RDFNF ; FILE NOT FOUND +FILOP0: HRLZI A,UNWRIT ; IF OPEN FOR WRITING - SET BIT + MOVE C,OPMODE + TRNN C,1 + JRST FILOP6 ; OPEN FOR READING + IORM A,UNRNDM(Q) + MOVEI A,CLSOUT ; SET UP SPECIAL CLOSE CODE + MOVEM A,CLSCOD ; TO TURN OFF IN CORE BIT + .SUSET [.RJNAM,,A] ; GET BOJ'S JNAME + LDB B,[060600,,A] ; GET FIRST DIGIT + ANDI A,77 ; ISOLATE SECOND DIGIT + SUBI A,'0 ; MAKE INTO NUMBER + SUBI B,'0 + IMULI B,10. + ADD B,A + MOVEM A,BOJNUM ; SAVE FOR LATER + DPB A,[UNBOJN+UNRNDM(Q)] ; AND PUT INTO NAME BLOCK + JRST FILOP3 ; GO COMPLETE OPEN + +FILOP6: LDB A,[UNRNUM+UNREF(Q)] + AOS A ; DECREMENT OPEN COUNT + DPB A,[UNRNUM+UNREF(Q)] ; GET OPEN COUNT + MOVEI A,CLSIN ; SET UP INPUT CLOSE ROUTINE + MOVEM A,CLSCOD + +FILOP3: MOVE A,UNFN1(Q) ; STORE REAL INFO ABOUT THE FILE + MOVEM A,FNAME1 + MOVE A,UNFN2(Q) + MOVEM A,FNAME2 + .CALL JSTS ; GIVE REAL NAMES TO SYS + JFCL + MOVE A,UNRNDM(Q) ; RANDOM INFO + MOVEM A,RANDOM + MOVE A,UNDATE(Q) ; CREATION DATE + MOVEM A,CRDATE + MOVE A,UNREF(Q) ; REFERENCE DATE + MOVEM A,RFDATE + MOVEM A,ORFDAT + HLLZ B,A ; SAVE ISOLATED REFERENCE DATE + MOVE A,OPMODE ; DOES HE WANT REFERENCE DATE UPDATED + TRNE A,10 ; IF 3.4=1 - DON'T CHANGE REFERENCE DATE + JRST FILOP5 + .CALL GDATE ; NOW UPDATE REFERENCE DATE + SETZM A + HLLZS A + CAMN A,B ; HAS REFERENCE DATE CHANGED? + JRST FILOP5 ; NO - DON'T CHANGE THE PAGE + HLLM A,UNREF(Q) ; UPDATE DIRECTORY + HLLM A,RFDATE ; AND CORE COPY +FILOP5: MOVE A,Q ; GET BYTE POINTER TO DESCRIPTOR AREA + PUSHJ P,DSCBPT + SETZB D,LENGTH ; INITIALIZE LENGTH + ILDB B,A ; GET FIRST BYTE + JUMPE B,FILOP2 ; IF FIRST BYTE IS ZERO - FILE EMPTY + CAIE B,40 ; BETTER BE A FORTY + JRST DTAERR ; NOPE - FILE CLOBBERED + ILDB B,A ; OK - GET NEXT TWO BYTES + ILDB C,A + LSH B,6 ; COMBINE THEM + ADD C,B + MOVEM C,IDXFBT ; SAVE FBAT INDEX + AOS D +FILOP1: ILDB B,A ; NOW GET TOTAL FILE LENGTH (IN BLOCKS) + JUMPE B,FILOP2 + ADD D,B ; ANY NON ZERO IS A BLOCK COUNT + JRST FILOP1 ; KEEP GOING UNTIL A ZERO + +FILOP2: PUSHJ P,SULOCK ; UNLOCK THE FILE + JUMPE D,FILOP4 ; IF EMPTY - DON'T COMPUTE + SOS D + IMULI D,2000 ; CONVERT TO WORD COUNT + LDB B,[UNWRDC+RANDOM] ; GET # OF WORDS IN LAST BLOCK + SKIPN B + MOVEI B,2000 ; FULL BLOCK + ADD D,B +FILOP4: MOVEM D,LENGTH ; MAKE LENGTH BE IN WORDS + SETZM POSPTR ; MAKE ACCESS POINTER POINT TO BEGINNING + SETOM BLKPOS ; INDICATE NO ACTIVE DATA BLOCK + SKIPE A,IDXFBT ; GET FBAT INDEX + SKIPG A,FBAT(A) ; GET FIRST BLOCK ADDRESS + JRST OPNWIN ; NO FIRST BLOCK + PUSHJ P,MAPDBL ; MAP FIRST BLOCK IN + PUSHJ P,FIOTO2 ; GO FIX POINTERS + JRST OPNWIN ; DONE - OPEN HAS WON + + +; GO FILE NOT FOUND - CHECK TO SEE IF BECAUSE OPEN FOR WRITING? + +RDFNF: HRLZI H,4 ; BE PREPARED TO REPORT FNF + ADDI Q,5 ; ON FNF Q POINTS TO ENTRY BEFORE + ; MATCH IF THERE WAS ONE + CAIL Q,ARCDIR ; SO SEE IF (Q)+5 IS IN BOUNDS + CAIL Q,ARCDIR+2000 + JRST (T) + CAMN A,UNFN1(Q) ; SEE IF THE FILE NAMES MATCH + CAME B,UNFN2(Q) + JRST (T) ; NO - REALLY A FNF + HRLZI H,23 ; YES - REPORT FILE LOCKED INSTEAD OF FNF + JRST OPFAIL + + +; HANDLE OPENS FOR OUTPUT + +; NEWARC - OPEN FOR OUTPUT IN ARCHIVE THAT DOES NOT YET EXIST. +; MAKE IT FIRST. + +NEWARC: HRLZI H,1 ; GET READY TO FAIL + PUSHJ P,ARCINI ; TRY TO INITIALIZE THE ARCHIVE + JRST OPFAIL ; CAN'T - GIVE "NO SUCH DEVICE" + MOVE A,FNAME1 ; DONE - NOW TO STANDARD OPEN + MOVE B,FNAME2 + +; OPNWRT - OPEN FOR WRITE OR WRITE OVER + +OPNWRT: PUSHJ P,SLOCK ; SOFT LOCK THE FILE + LDB C,[170300,,OPMODE] ; GET EXTRA MODE BITS + CAIE C,1 ; OPEN FOR WRITE-OVER? + JRST OPNOUT ; NO - GO OPEN FOR OUTPUT + MOVEI T,OPNOUT ; MAKE REAL FNF CAUSE OPEN FOR OUTPUT + PUSHJ P,QLOOK ; DO LOOK TO SEE IF ALREADY EXISTS + JRST RDFNF ; NO - GO SEE WHY + SETOM NEWFIL ; FILE IS NOT NEW - SET SWITCH + JRST FILOP0 ; FOUND - GO COMPLETE OPEN + +; OPNOUT - OPEN NEW FILE FOR OUTPUT + +OPNOUT: PUSHJ P,QFNG ; FIXUP ">" AND "<" IF ANY + JFCL ; DON'T CARE IF FAIL (DINSRT KNOWS WHAT TO DO) + PUSHJ P,DINSRT ; MAKE NEW DIRECTORY ENTRY + JRST FILOP0 ; GO COMPLETE THE OPEN + + +; CLSOUT - SPECIAL CLOSE CODE USED WHEN FILE IS OPEN FOR OUTPUT - +; IT TAKES CARE OF TURNING OFF THE IN CORE BIT. + +CLSOUT: .SUSET [.SPICLR,,[0]] + AOSE CLSINP ;CLOSE IN PROGRESS + JRST CLSDIE ; ALREADY STARTED + SETZM IFOPEN ; NOT OPEN ANY MORE + SKIPE A,FNAME1 ; GET NAMES + SKIPN B,FNAME2 + JRST CLSDIE ; IF EITHER NAME STILL ZERO - FORGET IT + PUSHJ P,SLOCK ; SOFT LOCK THE FILE + PUSHJ P,DIRMAP + MOVEI Q,ARCDIR ; GET DIRECTORY + ADD Q,UDNAMP(Q) ; GET POINTER TO START OF NAME AREA + SETOM D ; INDICATE MY ENTRY NOT FOUND YET +CLSOU1: MOVE A,FNAME1 ; MAKE SURE NAMES ARE IN A AND B + MOVE B,FNAME2 + CAIL Q,ARCDIR+2000 ; STILL IN BOUNDS? + JRST CLSEND ; END OF DIRECTORY + CAME A,UNFN1(Q) ; SAME FIRST FILE NAME? + JRST CLSOU0 ; NO - GO SEE IF DONE + CAME B,UNFN2(Q) ; YES - SAME SECOND FILE NAME? + JRST CLSOU2 ; NO - KEEP LOOKING + AOJA D,CLSOU3 ; YES - GO CHECK CLOSER + +CLSOU0: SKIPE UNFN1(Q) ; IGNORE IF DELETED + JUMPGE D,CLSDON ; IF LEAVING FNAME1 AREA - DONE + ; OTHERWISE - HAVEN'T FOUND IT YET +CLSOU2: ADDI Q,LUNBLK ; NO - GO ON TO NEXT ONE + JRST CLSOU1 + +CLSOU3: MOVE C,UNRNDM(Q) ; NAMES MATCH - CHECK FURTHER + TLNE C,UNWRIT ; OPEN FOR WRITING + JRST CLSOU4 ; YES - GO SEE IF BY ME + PUSHJ P,DELFIL ; NO - DELETE IT + JRST CLSOU2 ; AND CONTINUE THE SCAN + +CLSOU4: LDB C,[UNBOJN+C] ; GET # OF LAST BOJ HACKER + CAME C,BOJNUM ; IS THIS MY NUMBER? + JRST CLSOU2 ; NO - DON'T TOUCH IT + MOVE C,UNDATE(Q) ; IS THIS THE ONE I MADE? + CAME C,CRDATE + JRST CLSOU2 ; NO - DON'T TOUCH IT + MOVEI D,1 ; INDICATE OPEN FILE FOUND + MOVE C,UNRNDM(Q) ; YES - GET RANDOM INFO + TLNE C,DELBTS ; HAS SOMEONE DELETED IT? + JRST CLSDEL ; YES - GO DO IT + TLZ C,UNWRIT ; TURN OFF WRITE BIT + MOVEM C,UNRNDM(Q) ; AND RESTORE + LDB E,[001200,,LENGTH] ; GET LENGTH IN LAST "PAGE" + DPB E,[UNWRDC+UNRNDM(Q)] + LDB A,[000300,,OPMODE] ; GET BASIC OPEN MODE + CAIE A,1 ; ASCII UNIT OUTPUT? + JRST CLSOU5 ; NO - OK + MOVE TT,CHLFIB ; GET NUMBER OF CHARACTERS LEFT + IDIVI TT,5 ; SEE IF PART OF A WORD EMPTY + JUMPE I,CLSOU5 ; IF NOT - DONE + MOVEI A,^C ; YES - FILL OUT WITH EOFS + IDPB A,BLBPTR + SOJG I,.-1 +CLSOU5: SKIPE NEWFIL ;WRITE OR WRITE-OVER + JRST CLSOU2 ;WRITE-OVER + SKIPGE BLKPOS ; IS THERE A BLOCK IN NOW? + JRST CLSOU2 ; NO - DON'T FREE END + SKIPE A,WDLFIB ;ANYTHING TO RETURN + PUSHJ P,ENDFRE + MOVE A,FNAME1 ; PUT NAME 1 BACK INTO A + JRST CLSOU2 ; LOOK THROUGH EVERYTHING + +CLSEND: JUMPGE D,CLSDON ; IF AT LEAST ONE WAS FOUND - ITS OK + .VALUE ; OTHERWISE - STOP FOR DEBUGGING + +CLSDON: SKIPG D ; MAKE SURE OPEN FILE FOUND + .VALUE ; NO - .VALUE FOR DEBUGGING + PUSHJ P,SULOCK ; UNLOCK THE FILE NOW +CLSDIE: .LOGOU ; AND GO AWAY + .VALUE + +CLSDEL: PUSHJ P,DELFIL ; DELETE THE FILE + JRST CLSDON ; DONE + + + +; CLSIN - CLOSE A FILE THAT WE HAVE OPEN FOR INPUT + +CLSIN: .SUSET [.SPICLR,,[0]] + AOSE CLSINP ;CLOSE NOW IN PROGRES + JRST CLSDIE + PUSHJ P,SLOCK + PUSHJ P,DIRMAP + PUSHJ P,NOWIDX + JUMPLE Q,CLSDIE ;FILE STILL IN SAME PLACE? +CLSIN2: MOVE A,UNRNDM(Q) ; ARE WE GOING TO DELETE MAYBE? + TLNN A,DELBTS + JRST CLSIN1 ; NO - JUST DECREMENT COUNT + PUSHJ P,HLOCK ; CHANGE TO HARD LOCK + PUSHJ P,INTOFF + LDB A,[UNRNUM+UNREF(Q)] + SOS A ; DECREMENT OPEN COUNT + DPB A,[UNRNUM+UNREF(Q)] ; GET OPEN COUNT + JUMPN A,CLSIN0 ; IF ANYBODY ELSE HAS IT - LEAVE IT ALONE + PUSHJ P,FILFRE ; RELEASE ALL THE BLOCKS + SETZM UNFN1(Q) ; YES - DELETE THE FILE + SETZM UNFN2(Q) + PUSHJ P,QSQSH + PUSHJ P,INTON +CLSIN0: PUSHJ P,BULOCK ; UNDO HARD LOCK AND SOFT LOCK + JRST CLSDIE ; DONE - QUIT + +CLSIN1: SOS UNREF(Q) ; JUST DECREMENT COUNT + PUSHJ P,SULOCK ; UNLOCK + JRST CLSDIE ; DONE + + +; IOT - COME HERE TO PROCESS JOB'S IOTS. + +IOT: SKIPGE IOCERR ; I/O CHANNEL ERROR PENDING? + JRST PSTEOF ; YES - GO REPORT IT + MOVEI A,DIRIOT ; NO - DISPATCH TO THE RIGHT IOT ROUTINE + SKIPN OPTYPE ; DIRECTORY OPEN? + MOVEI A,FILIOT ; NO - USE FILE IOT TABLE + LDB B,[000300,,OPMODE] ; GET BASIC OPEN MODE + ADD A,B ; SPACE TO RIGHT ENTRY IN TABLE + JRST @(A) ; DISPATCH TO AN IOT ROUTINE + +; DIRIOT - DISPATCH TABLE FOR DIRECTORY IOTS + +DIRIOT: DAUI ; ASCII, UNIT, INPUT + MODERR ; OUTPUT TO DIRECTORY NOT ALLOWED + DABI ; ASCII, BLOCK, INPUT + MODERR + DIUI ; IMAGE, UNIT, INPUT + MODERR + DIBI ; IMAGE, BLOCK, INPUT + MODERR + +; FILIOT - DISPATCH TABLE FOR NON-DIRECTORY IOTS + +FILIOT: FAUI ; ASCII UNIT INPUT + FAUO ; ASCII UNIT OUTPUT + FABI ; ASCII BLOCK INPUT + FABO ; ASCII BLOCK OUTPUT + FIUI ; IMAGE UNIT INPUT + FIUO ; IMAGE UNIT OUTPUT + FIBI ; IMAGE BLOCK INPUT + FIBO ; IMAGE BLOCK OUTPUT + + +; THIS PAGE CONTAINS THE IOT ROUTINES FOR DIRECTORY IOTS. + +; DAUI - DIRECTORY ASCII UNIT INPUT - SEND ONE CHARACTER + +DAUI: PUSHJ P,LFCHR ; GET NEXT CHARACTER + CAIN A,3 ; EOF? + HRLI A,-1 ; MAKE -1,,3 + .IOT BOJC,A ; SEND IT + JUMPGE A,LOOP ; DID WE JUST SEND EOF? + SETOM IOCERR ; YES - SET ERROR FLAG FOR NEXT IOT + JRST LOOP + +; DIUI - DIRECTORY IMAGE UNIT INPUT - SEND NEXT WORD OF IMAGE +; DIRECTORY. + +DIUI: MOVE A,BLKPOS ; GET POSITION IN DIRECTORY BLOCK + CAIL A,2000 ; IN BOUNDS? + JRST DIUI1 ; NO - GO SEND EOF + AOS BLKPOS ; BUMP POSITION + CAIN A,2 ; IS HE ASKING FOR DIRECTORY NAME? + JRST DIUI0 ; YES - GO GIVE IT TO HIM + CAIG A,1 ; IS HE ASKING FOR WORD 0 OR 1 + AOS A ; ADJUST TO DISK FORMAT + .IOT BOJC,ARCDIR(A) ; SEND NEXT WORD + JRST LOOP + +DIUI0: .IOT BOJC,DIRECT ; SEND DIRECTORY NAME + JRST LOOP + +DIUI1: .IOT BOJC,[-1,,3] ; SEND EOF (??) + SETOM IOCERR ; ERROR NEXT TIME + JRST LOOP + +; DABI - DIRECTORY ASCII BLOCK INPUT - SEND ASCII CHARACTERS PACKED +; FIVE TO A WORD. + +DABI: SKIPG IOCERR ; DID WE JUST SEND EOF? + JRST DABI1 ; NO - GO SEND MORE +DABI0: SETZM I ; YES - MAKE HIS IOT BE A NOOP + SETZM H + .CALL JRET + JFCL + SETOM IOCERR ; GIVE ERROR NEXT TIME + JRST LOOP + +DABI1: HLRE A,WD2 ; SEE HOW MUCH HE WANTS + SKIPL A ; DOES HE WANT ANY? + JRST LOOP ; NO (OR WE'VE SENT IT ALL) + MOVNS A + CAILE A,BFRSZ ; WILL IT FIT IN ONE BUFFER? + MOVEI A,BFRSZ ; NO - SEND ONE BUFFER FULL NOW + HRLZS A + ADDM A,WD2 ; UPDATE HIS IOT POINTER + HLRZS A + PUSH P,A + IMULI A,5 ; TURN INTO CHARACTER COUNT + MOVE B,A + MOVE C,[440700,,IOTBFR] +DABI2: PUSHJ P,LFCHR ; FILL UP BUFFER WITH CHARACTERS + IDPB A,C + CAIE A,3 ; KEEP GOING EOF PUT INTO BUFFER + SOJG B,DABI2 ; OR UNTIL BUFFER IS FULL + PUSH P,A + IDIVI B,5 ; SEE HOW MUCH IS REALLY THERE + MOVNS B + ADD B,-1(P) + MOVNS B + HRLS B + HRRI B,IOTBFR ; SEND BUFFER (OR PARTIAL BUFFER) + .IOT BOJC,B + POP P,A ; GET BACK LAST CHARACTER PUT INTO BUFFER + POP P,B ; GET BACK NUMBER OF WORDS SENT + CAIE A,3 ; DID WE ALREADY SEND EOF? + JRST DABI1 ; NO - GO SEND MORE UNTIL HIS IOT DONE + SETZM H ; YES - MAKE HIM FALL OUT OF IOT + SETZM I + .CALL JRET + JFCL + MOVEI A,1 ; MARK EOF SENT + MOVEM A,IOCERR ; TO CAUSE NOOP IOT NEXT + JRST LOOP + + +; DIBI - DIRECTORY IMAGE BLOCK INPUT - SEND HIM AS MUCH OF THE IMAGE +; DIRECTORY AS HE WANTS. + +DIBI: MOVE A,BLKPOS ; GET POSITION IN DIRECTORY BLOCK + CAIG A,2 ; ONE OF FIRST THREE WORDS? + JRST DIBI1 ; YES - GO HANDLE DIFFERENTLY + CAIL A,2000 ; STILL IN BOUNDS? + JRST DABI0 ; NO - GIVE HIM NOOP IOT + HLRE B,WD2 ; SEE HOW MUCH HE WANTS + SUBI A,2000 ; GET NEGATIVE OF HOW MUCH IS LEFT + CAML A,B ; SEE WHICH ONE TO USE + MOVE B,A + PUSH P,B ; SAVE THE ONE USED + HRLS B ; MAKE AN IOT POINTER + MOVE A,BLKPOS ; TO POINT TO CURRENT WORD IN DIRECTORY + HRRI B,ARCDIR(A) + PUSH P,INIOT + MOVEI A,IOTCLN ; MAKE INTERRUPTS GO TO IOT CLEANUP + MOVEM A,INIOT ; NO MESS WITH B UNTIL THIS IS CHANGED + .IOT BOJC,B ; SEND DATA TO HIM + POP P,INIOT ; RESET IOT HANDLER + POP P,B ; GET NEGATIVE OF # OF WORDS SENT +DIBI0: MOVMS B + ADDM B,BLKPOS ; UPDATE POINTER + HRLS B ; PUT COUNT IN BOTH HALVES + ADDM B,WD2 ; UPDATE JOB'S IOT POINTER + SKIPGE WD2 ; SEE IF HE STILL WANTS MORE + JRST DIBI ; YES - GO TRY AGAIN + JRST LOOP ; NO - DONE + +DIBI1: JRST @.+1(A) ; DISPATCH TO POSITION + DIBI2 + DIBI3 + DIBI4 + +DIBI2: PUSH P,ARCDIR+1 ; PUT STUFF ON STACK + PUSH P,ARCDIR+2 + PUSH P,DIRECT + JRST DIBI5 + +DIBI3: PUSH P,ARCDIR+2 ; PUT STUFF ON STACK + PUSH P,DIRECT + PUSH P,ARCDIR+3 ; MIGHT HAVE TO SEND FIRST WORD OF REAL DATA + JRST DIBI5 + +DIBI4: PUSH P,DIRECT + PUSH P,ARCDIR+3 ; SEND FIRST TWO WORDS OF REAL DATA + PUSH P,ARCDIR+4 +DIBI5: HLRE B,WD2 + MOVMS B + CAILE B,3 ; DON'T SEND MORE THAN 3 WORDS RIGHT NOW + MOVEI B,3 + MOVNS B ; MAKE NEGATIVE + PUSH P,B + HRLS B + HRRI B,-3(P) ; MAKE IOT POINTER + PUSH P,INIOT ; SET UP SPECIAL INTERRUPT HANDLER + MOVEI A,IOTCLN + MOVEM A,INIOT + .IOT BOJC,B + POP P,INIOT + POP P,B + SUB P,[3,,3] + JRST DIBI0 ; GO JOIN REGULAR IOT CODE TO CONTINUE + + +; IOTCLN - CLEAN UP IF BLOCK DIRECTORY IOT IS INTERRUPTED + +IOTCLN: POP P,INIOT ; RESET INTERRUPT DISPATCH WORD + POP P,A ; GET ATTEMPTED LENGTH + HLRES B ; SEE HOW MUCH WAS REALLY SENT + SUB A,B + MOVMS A + ADDM A,BLKPOS ; UPDATE POSITION + .DISMIS INIOT ; DISMISS INTERRUPT AND CONTINUE + +; FIOTO - THIS ROUTINE IS CALLED BY FILE OUTPUT ROUTINES TO INSURE +; THAT THERE IS A BLOCK CURRENTLY IN DATAB1. IF THERE IS NOT, ONE +; IS ALLOCATED. FIOTO RETURNS RELATIVE POINTER (WITHIN DATAB1) TO +; THE NEXT DATA WORD OF THE BLOCK. +FC1: 0 +FC2: 0 +FC3: 0 +FC4: 0 +FC5: 0 +FC6: 0 +FC7: 0 +FC8: 0 +FC9: 0 +FC10: 0 +FC11: 0 +FC12: 0 +FC13: 0 +FC14: 0 +FC15: 0 +FC16: 0 +FC17: 0 +FC18: 0 +FC19: 0 +FC20: 0 +FC21: 0 +FC22: 0 + +FPAT: BLOCK 200 + +FIOTO: SKIPL A,BLKPOS ; IS THERE A BLOCK ACTIVE? + POPJ P, ; YES - RETURN OFFSET + SKIPE A,IDXFBT ; DO WE HAVE AN FBAT ENTRY? + JRST FIOTO1 ; YES - USE IT + PUSHJ P,FBTALO ; NO - ALLOCATE ONE + PUSHJ P,SLOCK ; LOCK THE FILE + MOVEI B,3 ; NEED THREE BYTES + PUSHJ P,DSCALO ; ALLOCATE THEM + MOVEI B,40 ; FIRST BYTE MUST BE 40 + IDPB B,A + LDB B,[060600,,IDXFBT] ; NEXT TWO BYTES ARE FBAT INDEX + IDPB B,A + LDB B,[000600,,IDXFBT] + IDPB B,A + MOVE A,IDXFBT ; PUT FBAT INDEX BACK + PUSHJ P,SULOCK +FIOTO1: MOVE B,FBAT(A) ; IS THERE ANYTHING IN THE FBAT ENTRY + CAME B,[-1] ; (-1 == NOTHING) + JRST FIOTO3 ; ALREADY HAVE SOMETHING + SETZM A ; DON'T STORE BLOCK ADDRESS WHEN ALLOCATED + PUSHJ P,BLKALO ; ALLOCATE A NEW BLOCK + MOVE C,IDXFBT ; PUT IT AWAY IN FBAT + MOVE B,DATADR ; BLOCK'S ACCESS POINTER IN DATADR + MOVEM B,FBAT(C) +FIOTO2: AOS A ; BUMP POINTER TO POINT TO FIRST DATA WORD + MOVEM A,BLKPOS ; THAT'S WHERE IOTS SHOULD START + LDB B,[271200,,DATAB1-1(A)] ; GET BLOCK LENGTH + AOS B + MOVEM B,WDLFIB ; STORE WORDS IN BLOCK + IMULI B,5 + MOVEM B,CHLFIB ; STORE CHARACTERS IN BLOCK + MOVEI B,DATAB1(A) ; MAKE BYTE POINTER TO BLOCK + HRLI B,440700 + MOVEM B,BLBPTR + POPJ P, + +FIOTO3: MOVE A,B ; ALREADY HAVE A BLOCK (WRITE-OVER MAYBE?) + PUSHJ P,MAPDBL ; MAP IT IN + JRST FIOTO2 + + + +; FABO - FILE ASCII BLOCK OUTPUT SAME AS, +; FIBO - FILE IMAGE BLOCK OUTPUT + +FABO: +FIBO: JFCL + AOS FC1 + PUSHJ P,INTOFF + PUSHJ P,FIOTO ; CHECK FOR CURRENT BLOCK + PUSH P,LENGTH ; SAVE STARTING LENGTH +FIBO0: AOS FC2 + HLRE B,WD2 ; HOW MANY WORDS DOES HE WANT + MOVMS B + CAMLE B,WDLFIB ; MORE THAN IN CURRENT BLOCK? + MOVE B,WDLFIB ; YES - SEND REST OF CURRENT BLOCK + JUMPE B,FIBO1 ; SENDING ANYTHING AT ALL? + PUSH P,B ; YES - GO AHEAD + MOVNS B + HRLS B + HRRI B,DATAB1(A) ; MAKE IOT POINTER TO STUFF TO SEND + PUSH P,INIOT ; SET UP SPECIAL INTERRUPT HACKING + MOVEI A,FIBCLN + MOVEM A,INIOT + MOVEM P,PSAV ; SAVE P INCASE OF INTERUPT + AOS FC3 + PUSHJ P,INTON + .IOT BOJC,B + PUSHJ P,INTOFF ; INTERRUPTS OFF FOR CLEAN UP + AOS FC4 + SKIPGE B + AOS FC5 + POP P,INIOT + POP P,A ; GET NUMBER OF WORDS BACK + ADDM A,BLKPOS ; UPDATE ACCESS POINTER + SKIPN NEWFIL ; ARE WE WRITING A NEW FILE? + ADDM A,LENGTH ; YES - THEN THIS CHANGES THE LENGTH + ADDM A,POSPTR ; ALSO CHANGES CURRENT ACCESS POINTER + HRLS A + ADDM A,WD2 ; UPDATE USER'S IOT POINTER + HRRZS A + MOVNS A + ADDM A,WDLFIB ; DON'T WORRY ABOUT CHLFIB SINCE IN BLOCK MODE + SKIPL A,(P) ; DO WE NEED LENGTH ADJUST? + PUSHJ P,LENADJ ; YES - ADJUST LENGTH +FIBO1: AOS FC6 + AOS FC7 + SKIPL WD2 ; DOES USER WANT ANY MORE? + JRST FIBO4 ; NO - GO FINISH UP + MOVE A,LENGTH ; YES - UPDATE SAVED LENGTH + MOVEM A,(P) + AOS FC8 + PUSHJ P,NEWBLK ; MAP IN NEXT BLOCK + JRST FIBO5 ; NONE - MUST BE FINISHED WITH SUB-FILE + AOS FC9 + JRST FIBO0 ; OK - GO ON +FIBO5: PUSHJ P,INTON ; REENABLE INTS + JRST FIBI1 ; GO BACK TO INPUT HANDLER + + +FIBO4: POP P,A ; ADJUST LENGHT PARAMETERS + PUSHJ P,INTON ; TURN INTERRUPTS BACK ON + JRST LOOP + + +; FIBCLN - CLEAN UP AFTER INTERRUPTING OUT OF FILE BLOCK IOT + +FIBCLN: MOVE P,PSAV + PUSHJ P,INTOFF + POP P,INIOT ; RESTORE INTERRUPT DISPATCH WORD + POP P,A ; GET ATTEMPTED LENGTH BACK + HLRES B + ADD A,B ; SEE HOW MUCH ACTUALLY MADE IT + ADDM A,BLKPOS ; UPDATE POSITION + SKIPN NEWFIL + ADDM A,LENGTH ; LENGTH AND OTHER STUFF + ADDM A,POSPTR + MOVNS A + ADDM A,WDLFIB + POP P,A ; GET ORIGINAL LENGTH BACK + PUSHJ P,LENADJ ; UPDATE LENGTH + PUSHJ P,INTON + .DISMIS INIOT ; DISMISS AND CONTINUE + + +; LENADJ - THIS FUNCTION IS CALLED WITH AN OLD LENGTH IN A. IT ADJUSTS +; EVERYTHING NECESSARY TO REFLECT A CHANGE IN LENGTH. + +LENADJ: MOVE B,OPMODE ; READ OR WRITE MODE? + TRNN B,1 ; ONLY UPDATE IN WRITE MODE + POPJ P, ; DONE + MOVE B,POSPTR ; SEE IF WE HAVE ACCESSED PAST LENGTH + CAMLE B,LENGTH ; (CAN ONLY HAPPEN IF OPEN FOR WRITE-OVER) + MOVEM B,LENGTH ; YES - UPDATE IT + PUSHJ P,SLOCK ; LOCK THE DIRECTORY FOR EXAMINATION + JUMPLE A,LENAD0 ; IF NOT POSITIVE - FIRST TIME THROUGH + CAML A,LENGTH ; HAS IT INCREASED? + JRST LENAD9 ; NO - DONE + SOS A ; GET OLD PAGE COUNT + LSH A,-10. + MOVE B,LENGTH + SOS B + LSH B,-10. ; GET NEW PAGE COUNT + CAMN A,B ; HAS PAGE COUNT CHANGED? + JRST LENAD8 ; NO - JUST UPDATE LAST BLOCK COUNT + MOVE TT,B ; SEE HOW MANY SLOTS NEEDED + IDIVI TT,UDTKMX + IDIVI A,UDTKMX + SKIPE B ; WAS OLD DESCRIPTOR COUNT EXACT + CAME TT,A ; SAME NUMBER OF SLOTS? + JRST LENAD1 ; NO - HAVE TO EXPAND AREA + PUSHJ P,DSCBPT ; GET DESCRIPTOR BYTE POINTER + IBP A ; GO PAST FBAT INDEX + IBP A + IBP A + ILDB B,A ; GET NEXT BYTE + CAIL B,UDTKMX ; IS THIS BYTE FULL? + JRST .-2 ; YES - KEEP ON + AOS B ; NO - BUMP + DPB B,A ; AND REDEPOSIT + JRST LENAD8 ; DONE + +LENAD0: MOVE TT,LENGTH + JUMPE TT,LENAD8 + SOS TT ; GET PAGE COUNT + LSH TT,-10. + JUMPE TT,LENAD8 ; IF ZERO - INDEX FIXES THAT + SOS TT ; OTHERWISE - HOW MANY PAGES PAST FIRST? + IDIVI TT,UDTKMX ; GET NUMBER OF BYTES NEEDED +LENAD1: PUSH P,TT ; SAVE NUMBER OF FULL BYTES + PUSH P,I ; AND NUMBER IN LAST BYTE + MOVEI B,3(TT) ; GET ENOUGH BYTES FOR HEADER TOO + SKIPE (P) ; DID WE NEED A HALF-FILLED SLOT? + AOS B ; YES - GET EXTRA BYTE + PUSHJ P,DSCALO ; ALLOCATE ENOUGH BYTES + MOVEI B,40 ; PUT AWAY FBAT INDEX + IDPB B,A + LDB B,[060600,,IDXFBT] + IDPB B,A + LDB B,[000600,,IDXFBT] + IDPB B,A + POP P,I ; GET BACK COUNT IN LAST BYTE + POP P,TT ; AND NUMBER OF FULL BYTES + JUMPE TT,LENAD2 ; ANY FULL BYTES? + MOVEI B,UDTKMX ; GET FULL BYTE COUNT + IDPB B,A + SOJG TT,.-1 ; PUT AWAY ALL FULL BYTES +LENAD2: JUMPE I,LENAD8 ; ANY PARTLY FULL BYTES? + IDPB I,A ; YES - PUT IT AWAY +LENAD8: LDB A,[001200,,LENGTH] + DPB A,[UNWRDC+UNRNDM(Q)] +LENAD9: PUSHJ P,SULOCK ; UNLOCK DIRECTORY + POPJ P, + + + +; FABI - FILE ASCII BLOCK INPUT SAME AS, +; FIBI - FILE IMAGE BLOCK INPUT + + +FABI: +FIBI: PUSHJ P,INTOFF + PUSH P,LENGTH ;NOT NECESSARY, BUT MAKES PDL PNTR HAPPY + SETOM NEWFIL ; IOTS DON'T CHANGE FILE LENGTH + SKIPL A,BLKPOS ; IS THERE A BLOCK IN NOW? + JRST FIBO0 ; YES - CAN HANDLE MUCH LIKE A WRITE NOW +FIBI1: SETZM H ; MAKE LOSER FALL OUT OF HIS IOT + SETZM I + PUSHJ P,INTON + .CALL JRET + JFCL + JRST LOOP + + + +; FAUO - FILE ASCII UNIT OUTPUT + +FAUO: PUSHJ P,INTOFF + PUSHJ P,FIOTO ; MAKE SURE THERE IS A BLOCK MAPPED IN + SKIPE CHLFIB ; ARE THERE ANY CHARACTER SLOTS LEFT + JRST FAUO2 ; YES - GO PROCESS NEXT ONE + PUSHJ P,NEWBLK ; GO TO NEXT BLOCK + .VALUE ; OPEN FOR OUTPUT - SHOULDN'T EVER FAIL +FAUO2: PUSHJ P,INTON + .IOT BOJC,B ; GET NEXT CHARACTER + PUSHJ P,INTOFF + IDPB B,BLBPTR ; PUT AWAY IN BUFFER +FAUO3: SOS CHLFIB ; ONE LESS SLOT AVAILABLE + MOVE TT,CHLFIB ; PASS OVER WORD BOUNDARY? + IDIVI TT,5 + CAIE I,4 ; CHECK FOR JUST WRITTEN FIRST CHARACTER IN WORD + JRST FAUO4 ; NO - DONE + AOS BLKPOS ; YES - UPDATE ACCESS POINTER + AOS POSPTR + MOVE A,LENGTH + PUSHJ P,LENADJ +FAUO4: PUSHJ P,INTON + JRST LOOP + +; FAUI - FILE ASCII UNIT INPUT + +FAUI: PUSHJ P,INTOFF + SKIPGE A,BLKPOS ; MAKE SURE THERE IS A BLOCK MAPPED IN + JRST FAUI3 ; NO - FILE MUST BE EMPTY + SKIPE CHLFIB ; ANY MORE CHARACTERS? + JRST FAUI2 ; YES - GO GET NEXT ONE + PUSHJ P,NEWBLK ; GO TO NEXT BLOCK + JRST FAUI3 ; NO NEXT BLOCK - GIVE EOF +FAUI2: MOVE C,BLBPTR + ILDB B,C ; GET NEXT CHARACTER + CAIN B,^C ; EOF? + JRST FAUI3 ; YES - GO SEND EOF + PUSHJ P,INTON + .IOT BOJC,B ; NO - SEND CHARACTER + PUSHJ P,INTOFF + IBP BLBPTR + JRST FAUO3 ; GO UPDATE COUNTS + +FAUI3: PUSHJ P,INTON + .IOT BOJC,[-1,,3] ; SEND EOF + SETOM IOCERR ; IOC ERROR NEXT TIME + JRST LOOP + + + +; FIUO - FILE IMAGE UNIT OUTPUT + +FIUO: PUSHJ P,INTOFF + PUSHJ P,FIOTO ; MAKE SURE THERE IS A BLOCK IN +FIUO1: SKIPE WDLFIB ; ANY WORDS LEFT? + JRST FIUO2 ; YES - GO SEND IT + PUSHJ P,NEWBLK ; NO - GET NEXT BLOCK + JRST FIUO3 ; NO MORE - SEND EOF +FIUO2: MOVE A,BLKPOS ; GET CURRENT POINTER INTO DATA BLOCK + PUSHJ P,INTON + .IOT BOJC,DATAB1(A) ; SEND THE NEXT WORD + PUSHJ P,INTOFF + AOS BLKPOS ; BUMP INDEX + AOS POSPTR ; AND ACCESS POINTER + SOS WDLFIB ; DECREASE WORDS LEFT + MOVE A,LENGTH ; UPDATE LENGTH + PUSHJ P,LENADJ + PUSHJ P,INTON + JRST LOOP + +FIUO3: PUSHJ P,INTON + .IOT BOJC,[-1,,3] ; SEND EOF + SETOM IOCERR ; IOC ERROR NEXT TIME + JRST LOOP + +; FIUI - FILE IMAGE UNIT INPUT + + +FIUI: PUSHJ P,INTON + SKIPGE A,BLKPOS ; MAKE SURE THERE IS A BLOCK IN + JRST FIUO3 ; NO BLOCKS - FILE IS EMPTY + JRST FIUO1 ; OK - GO SEND WORD + + + +; RCHST - HANDLE THE .RCHST UUO - RETURN NAMES AND ACCESS POINTER + +RCHST: MOVEI I,1(P) ; GET POINTER TO ROOM ON STACK + MOVS H,DEVICE + PUSH P,H ; SEND DEVICE + PUSH P,FNAME1 ; REAL FILE NAMES + PUSH P,FNAME2 + PUSH P,DIRECT ; DIRECTORY NAME + PUSH P,POSPTR ; CURRENT ACCESS POINTER + PUSH P,[0] ; UNKNOWN + PUSH P,[0] ; UNKNOWN + HRLI I,-7 + SETZM H ; NO SKIP NEEDED + .CALL JRET ; SEND INFO AND UNHANG USER + JFCL + SUB P,[7,,7] + JRST LOOP + + +; FDELE - RENAME DIRECTORY ENTRY POINTED TO BY Q + +FDELE: JUMPL Q,FDELEA ; IF Q INVALID - USE SAVED INFO + PUSH P,UNRNDM(Q) ; SAVE RANDOM INFO + PUSH P,UNDATE(Q) ; AND CREATION AND REFERENCE DATES + PUSH P,UNREF(Q) + PUSHJ P,INTOFF + SETZM UNFN1(Q) ; AND FLUSH OLD ENTRY + SETZM UNFN2(Q) ; (SO RENAME DOESN'T GET DIR FULL) + PUSHJ P,QSQSH + PUSHJ P,INTON + JRST FDELEB ; GO MAKE NEW ENTRY + +FDELEA: PUSH P,RANDOM ; FILE IS GONE - USE SAVE INFO + PUSH P,CRDATE + PUSH P,RFDATE + +FDELEB: MOVE A,WD2 ; GET NEW FILE NAMES + MOVE B,WD7 + PUSHJ P,QFNG ; FIXUP ">" "<" + JFCL + MOVEM A,FNAME1 ; STORE NEW NAMES + MOVEM B,FNAME2 + PUSHJ P,DINSRT ; INSERT ENTRY UNDER NEW NAMES + POP P,UNREF(Q) ; PUT OLD INFORMATION INTO NEW ENTRY + POP P,UNDATE(Q) + POP P,A ; GET RANDOM + TLZ A,UNDUMP ; MAKE IT GET DUMPED UNDER NEW NAME + MOVEM A,UNRNDM(Q) + .CALL GDATE ; GET DATE + SETOM A + MOVEM A,ARCDIR+GCTAG ; UPDATE GC TAG TO INVALIDATE ALL Q'S + POPJ P, + +; FDELE2 - RENAME WHILE OPEN + +FDELE2: PUSHJ P,SLOCK ; LOCK FILE + PUSHJ P,FDELE ; GO DO THE DELETE + PUSHJ P,SULOCK ; UNLOCK THE FILE + .CALL JSTS ; UPDATE SYS COPY OF NAMES + JFCL + JRST SKPWIN + +; FDELE1 - RENAME WHILE CLOSED AND DELETE + +FDELE1: MOVE A,WD5 ; GET DIRECTORY AND DEVICE + MOVEM A,DIRECT + MOVE A,WD6 + MOVEM A,DEVICE + PUSHJ P,SLOCK ; LOCK FILE + MOVE A,WD3 ; GET CURRENT NAMES + MOVE B,WD4 + PUSHJ P,DIRMAP ; MAKE SURE DIRECTORY IS MAPPED IN + SKIPN WD2 ; RENAME OR DELETE? + JRST DELETE ; 0 => DELETE + MOVEI T,OPFAIL ; RENAME + PUSHJ P,QLOOK ; DO THE LOOKUP + JRST RDFNF ; NO SUCH FILE + PUSHJ P,FDELE ; GO RENAME + PUSHJ P,SULOCK ; UNLOCK FILE +SKPDIE: SETZM I + MOVEI H,1 ; MAKE USER SKIP + .CALL JRET + JFCL + JRST CLOSE ; DON'T STAY UP + +; DELETE - DELETE FILE WHILE CLOSED + +DELETE: PUSHJ P,QLOOK ; LOOK IT UP + JRST DELFNF ; NO SUCH FILE? + PUSHJ P,DELFIL ; DELETE THE FILE + JRST SKPDIE ; DON'T STAY UP + +DELFNF: HRLZI H,4 ; NOT FOUND - OPEN FOR WRITING? + ADDI Q,5 ; FOUND OUT + CAIL Q,ARCDIR + CAIL Q,ARCDIR+2000 + JRST OPFAIL ; OUT OF BOUNDS - FNF + CAMN A,UNFN1(Q) ; NAMES MATCH? + CAME B,UNFN2(Q) + JRST OPFAIL ; NO - FNF +DELOPN: HRLZI A,UNCDEL ; YES - JUST SET DELETE WHEN CLOSED BIT + IORM A,UNRNDM(Q) + PUSHJ P,SULOCK ; UNLOCK FILE + JRST SKPDIE ; DON'T STAY UP + +DELFIL: PUSH P,A + PUSHJ P,HLOCK ; HARD LOCK FILE + MOVE A,UNRNDM(Q) ; SEE IF OPEN FOR WRITING + TLNN A,UNWRIT + JRST DELFI1 ; NO +DELCLS: HRLZI A,UNCDEL ; YES - MARK AS TOBE DELETED + IORM A,UNRNDM(Q) + PUSHJ P,HULOCK ; UNLOCK FILE + POP P,A + POPJ P, + +DELFI1: LDB A,[UNRNUM+UNREF(Q)] ; GET READ OPEN COUNT + JUMPN A,DELCLS ; IF ANYBODY HAS IT - WAIT + PUSHJ P,INTOFF + SETZM UNFN1(Q) ; FLUSH DIRECTORY ENTRY + SETZM UNFN2(Q) + PUSHJ P,FILFRE ; FREE ALL THE DATA BLOCKS + PUSHJ P,QSQSH + PUSHJ P,INTON + PUSHJ P,BLTSCR + PUSHJ P,HULOCK ; UNLOCK FILE + POP P,A + POPJ P, + + +; .CALL HANDLERS + +; FILBLK - SEND 5 WORD NAME AREA + +FILBLK: PUSH P,FNAME1 ; FILE NAMES FIRST + PUSH P,FNAME2 + PUSH P,RANDOM ; THEN RANDOM INFO + PUSH P,CRDATE ; THEN CREATION DATE + PUSH P,RFDATE ; AND REFERENCE DATE + MOVEI A,5 +CALWIN: SKIPN I,A ; ANY RETURNS? + JRST CALWN1 + MOVN B,A ; GET NEGATIVE OF COUNT + MOVEI I,1(P) ; GET POINTER TO TOP OF P + SUB I,A ; GET POINTER TO FIRST ONE + HRL I,B ; MAKE CPTR +CALWN1: MOVEI H,1 ; MAKE LOSER SKIP + .CALL JRET + JFCL + HRLS A + SUB P,A ; RESET P + JRST LOOP + +; FILLEN - SEND FILE'S LENGTH + +FILLEN: PUSH P,LENGTH ; SEND HIM THE LENGTH + MOVEI A,1 + JRST CALWIN + +; RDMPBT - READ THE DUMP BIT + +RDMPBT: PUSH P,[0] ; 0 => NOT BACKUP UP + MOVE A,RANDOM + TLNE A,UNDUMP ; IS BIT SET? + AOS (P) ; YES - BACKED UP - RETURN 1 + MOVEI A,1 + JRST CALWIN + +; RESRDT - RESET REFERENCE DATE TO WHAT IT WAS BEFORE OPEN. + +RESRDT: PUSHJ P,SLOCK ; LOCK DIRECTORY + JUMPL Q,RESRD1 ; HAS FILE BEEN DELETED? + MOVE A,ORFDAT ; GET OLD REFERENCE DATE + HLLM A,UNREF(Q) ; RESET IT IN DIRECTORY + HLLM A,RFDATE ; AND IN CORE COPY +RESRD1: PUSHJ P,SULOCK ; UNLOCK DIRECTORY + SETZM A ; JUST SKIP - NO RETURNS + JRST CALWIN + +; RFDATE - READ CREATION DATE + +RDFDAT: PUSH P,CRDATE ; SEND CREATION DATE + MOVEI A,1 + JRST CALWIN + +; RAUTH - READ THE FILE AUTHOR + +RAUTH: .CALL MFDOPN + JFCL + .CALL MFDIOT + JFCL + .CLOSE MFDI, + LDB A,[UNAUTH+RFDATE] + MOVEI B,0 ;RETURN VALUE IS 0 IF UNKNOWN OR ILLEGAL AUTHOR + CAIL A,NUDSL + JRST RAUTH1 + LSH A,1 + MOVEI A,2000-(A) + ADDI A,MFDBLK + MOVE B,(A) +RAUTH1: PUSH P,B + MOVEI A,1 + JRST CALWIN + +; SAUTH - SET THE FILE AUTHOR + +SAUTH: MOVE A,WD4 + CAIGE A,2 + JRST TOOFEW + PUSHJ P,SLOCK + JUMPL Q,RESRD1 + MOVE C,WD6 + PUSHJ P,GTDRNC + DPB B,[UNAUTH+UNREF(Q)] + DPB B,[UNAUTH+RFDATE] + JRST RESRD1 + +; SREAPB - SET THE REAP BIT (WHY??) + +SREAPB: MOVE A,WD4 + CAIGE A,2 + JRST TOOFEW + HRLZI A,UNREAP + JRST SDMPIN + +; SDMPBT - SET THE DUMP BIT + +SDMPBT: MOVE A,WD4 ; GET ARG COUNT + CAIGE A,2 ; MUST BE AT LEAST TWO + JRST TOOFEW ; GIVE ERROR + PUSHJ P,SLOCK ; LOCK THE DIRECTORY + HRLZI A,UNDUMP ; GET DUMP BIT +SDMPIN: JUMPL Q,RESRD1 ; DO NOTHING IF ITS GONE + MOVE B,WD6 ; GET NEW VALUE FOR DUMP BIT + TRNN B,1 ; DOES HE WANT IT SET? + JRST SDMPB1 ; NO - GO TURN IT OFF + IORM A,UNRNDM(Q) ; SET IT IN DIRECTORY + IORM A,RANDOM ; AND IN CORE + JRST RESRD1 + +SDMPB1: ANDCAM A,UNRNDM(Q) ; TURN OFF DUMP BIT + ANDCAM A,RANDOM + JRST RESRD1 + +; SFDATE - SET FILE CREATION DATE + +SFDATE: MOVE A,WD4 ; GET ARG COUNT + CAIGE A,2 ; MUST BE AT LEAST TWO + JRST TOOFEW ; GIVE TOO FEW ARGUMENT FAILURE + PUSHJ P,SLOCK ; LOCK DIRECTORY + JUMPL Q,RESRD1 ; DO NOTHING IF FILE IS GONE + MOVE A,WD6 ; GET NEW CREATION DATE + MOVEM A,UNDATE(Q) ; INTO DIRECTORY + MOVEM A,CRDATE ; AND CORE COPY + JRST RESRD1 ; DONE + +; SRDATE - SET REFERENCE DATE + +SRDATE: MOVE A,WD4 ; GET ARG COUNT + CAIGE A,2 + JRST TOOFEW + PUSHJ P,SLOCK + MOVE A,WD6 + HLLM A,UNREF(Q) ; STORE INTO DIRECTORY + HLLM A,UNREF(Q) + JRST RESRD1 + + +; ACCESS - THIS ROUTINE HANDLES ACCESSING WITHIN THE FILE + +ACCESS: SKIPN NEWFIL + PUSHJ P,ACCESW ;CHANGE TO WRITEOVER + PUSHJ P,INTOFF + SETZM IOCERR ; CLEAR I/O ERROR FLAG + MOVE A,WD2 ; GET POSITION HE WANTS + CAMN A,POSPTR ; DOES HE WANT WHERE WE ARE? + JRST NOOP1A ; YES - DO NOTHING + JUMPN A,ACCES1 ; DOES HE WANT BEGINNING? + SKIPE A,IDXFBT ; YES - THAT'S EASY + SKIPG A,FBAT(A) ; GET ADDRESS OF FIRST BLOCK + JRST NOOP1A ; NO FIRST BLOCK + PUSHJ P,MAPDBL ; MAP IN FIRST BLOCK + PUSHJ P,FIOTO2 ; FIXUP WORD COUNTS + SETZM POSPTR ; ACCESS TO ZERO + JRST NOOP1A + +ACCESW: SKIPE A,WDLFIB + PUSHJ P,ENDFRE + SETOM NEWFIL + POPJ P, + +ACCES1: CAMGE A,LENGTH ; ACCESS PAST EOF? + JRST ACCES5 ; NO - GO TRY TO ACCESS + CAME A,LENGTH ; ACCESS TO LENGTH + 1? + JRST ACCES4 ; NO - SET IOC ERROR FLAG + MOVE B,OPMODE ; ONLY LEGAL FOR OUTPUT + TRNN B,1 + JRST ACCES4 ; INPUT CHANNEL - GO SET IOC ERROR FLAG + PUSH P,A ; SAVE ACCESS POINTER + MOVE A,DATOFF ; GET OFFSET OF CURRENT BLOCK +ACCES2: MOVE A,DATAB1(A) ; GET HEADER OF CURRENT BLOCK + TLNE A,200000 ; IS THIS LAST BLOCK IN FILE? + JRST ACCES3 ; YES - POINT TO END OF THIS ONE + TLZ A,777740 ; NO - GO TO NEXT BLOCK + PUSHJ P,MAPDBL ; MAP IT IN + JRST ACCES2 ; AND LOOK AGAIN + +ACCES3: POP P,POSPTR ; AT END OF FILE - SET NEW ACCESS POINTER + SETZM WDLFIB ; MARK NOTHING LEFT IN FILE + SETZM CHLFIB + SETZM NEWFIL + JRST NOOP1A ; DONE + +ACCES4: SETOM IOCERR ; ACCESS BEYOND EOF - SET FLAG FOR + JRST NOOP1A ; IOC ERROR ON NEXT IOT + +ACCES5: MOVE B,DATOFF ; ACCESS WITHIN THE EXISTING FILE + LDB B,[271200,,DATAB1(B)] ; GET LENGTH OF CURRENT BLOCK + MOVE C,POSPTR ; GET ACCESS POINTER NOW + SUB C,BLKPOS ; CALCULATE ACCESS POINTER OF START OF BLOCK + ADD C,DATOFF + AOS C ; ALLOW FOR HEADER + ADD B,C ; GET ACCESS POINTER TO START OF NEXT BLOCK + CAMGE A,C ; WHERE DOES HE WANT TO GO? + JRST ACCES7 ; HE WANTS A LOWER DATA BLOCK + CAMLE A,B + JRST ACCES9 ; HE WANTS A HIGHER DATA BLOCK + MOVEM A,POSPTR ; HE WANTS THIS DATA BLOCK + MOVE D,DATOFF ; COMPUTE NEW OFFSET + ADDI D,1(A) ; ADD NEW ACCESS POINTER - ALLOW FOR HEADER + SUB D,C ; SUBTRACT OFF STARTING ACCESS POINTER + EXCH D,BLKPOS + SUB D,BLKPOS ; SEE HOW MUCH WE HAVE MOVED + ADDM D,WDLFIB ; UPDATE WORD/CHARACTER COUNTS + IMULI D,5 + ADDM D,CHLFIB +ACCES6: MOVE A,BLKPOS ; MAKE BYTE POINTER + MOVEI A,DATAB1(A) + HRLI A,440700 ; ALWAYS ACCESS TO START OF WORD + MOVEM A,BLBPTR + JRST NOOP1A ; DONE + +ACCES7: PUSH P,A ; ACCESS BACKWARDS +ACCES8: MOVE B,DATOFF ; GET POINTER TO CURRENT DATA BLOCK + LDB A,[271200,,DATAB1(B)] ; GET LENGTH + ADDI B,2(A) ; GET POINTER TO TRAILER + LDB A,[002700,,DATAB1(B)] ; GET BACKWARDS POINTER FROM TRAILER + PUSHJ P,MAPDBL ; MAP IN PREVIOUS BLOCK + LDB B,[271200,,DATAB1(A)] ; GET LENGTH OF NEW BLOCK + AOS B + SUBI C,(B) ; UPDATE ACCESS POINTER OF START OF BLOCK + CAML C,(P) ; DOES HE WANT THIS DATA BLOCK? + JRST ACCES8 ; NO - KEEP GOING BACKWARDS + AOS A + MOVEM A,BLKPOS ; YES - SAVE OFFSET POINTER + POP P,A ; GET ACCESS POINTER HE WANTS BACK + MOVEM A,POSPTR + SUB A,C ; GET WORDS INTO BLOCK + ADDM A,BLKPOS ; UPDATE POINTER + SUB B,A ; GET WORDS LEFT COUNT + MOVE A,B +ACCESR: MOVEM A,WDLFIB ; UPDATE COUNTS + IMULI A,5 + MOVEM A,CHLFIB + JRST ACCES6 ; GO FIX BYTE POINTER + +ACCES9: PUSH P,A ; SAVE ACCESS POINTER DESIRED + PUSH P,B ; SAVE ACCESS POINTER OF BEGINNING OF NEXT BLOCK +ACCES0: MOVEM B,(P) + PUSHJ P,NEWBLK ; GO TO NEXT BLOCK + .VALUE ; BUT WE WERE IN BOUNDS? + LDB B,[271200,,DATAB1-1(A)] ; GET LENGTH OF IT + ADD B,(P) ; GET ADDRESS OF END OF NEXT BLOCK + AOS B + CAMGE B,-1(P) ; IS THIS THE RIGHT BLOCK? + JRST ACCES0 ; NO - KEEP SCANNING + POP P,C ; GET BACK ADDRESS OF BEGINNING + POP P,A ; GET BACK DESIRED ACCESS POINTER + MOVEM A,POSPTR + SUBI B,-1(A) ; GET WORDS LEFT + SUB A,C ; GET OFFSET POINTER + ADD A,DATOFF + MOVEM A,BLKPOS ; SAVE NEW OFFSET POINTER + MOVE A,B ; GET WORDS LEFT INTO A + JRST ACCESR ; GO UPDATE INFO + +NOOP1A: PUSHJ P,INTON + JRST NOOP1 + + +LOC <<<.+1777>/2000>*2000> +MFDBLK: BLOCK 2000 + + +END START +