TITLE ARCDEV -- BOJ HANDLER FOR ARCHIVE DEVICE ; Version 66 reconstructed from SYSENG; ARCDEV 23 (timestamped 1976-12-26) ; and DEVICE; OARCDV BIN (1977-07-04) disassembly. ; 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 BYTSIZ: 0 ; BYTE SIZE BYTPWD: 0 ; BYTES PER WORD 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 MOVE A,[SIXBIT /ARC!!!/] MOVEM A,BLOCK3+ARCTYP 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+ARCTYP CAME A,[-1] CAMN A,[SIXBIT /ARC!!!/] CAIA JRST [MOVSI H,46 ? JRST OPFAIL] MOVE A,[SIXBIT /ARC!!!/] MOVEM A,ARCDIR+ARCTYP 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 CAIN A,4 JRST OPNAR2 CAIE A,23 ; FILE LOCKED? JRST ARCNP4 ; 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 ARCNP4: HRLZ H,A JRST OPFAIL ; 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 TRNE A,6 SKIPA A,[44] MOVEI A,7 MOVEM A,BYTSIZ MOVEI B,44 IDIVM B,A MOVEM A,BYTPWD 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? JRST SEOF .IOT BOJC,A ; SEND IT DAUI1: SOSG WD2 JRST LOOP LDB B,[000300,,OPMODE] JRST @DIRIOT(B) ; 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 SEOF ; 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 DAUI1 DIUI0: .IOT BOJC,DIRECT ; SEND DIRECTORY NAME JRST DAUI1 ; 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 FISI1: 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: SOSLE WD2 JRST FAUO5 PUSHJ P,INTON JRST LOOP FAUO5: LDB B,[000300,,OPMODE] JRST @FILIOT(B) ; 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 SEOF: MOVEI H,1 MOVSI A,1000 TDNE A,WD1 JRST FISI1 .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 SOSLE WD2 JRST FAUO5 PUSHJ P,INTON JRST LOOP FIUO3: PUSHJ P,INTON JRST SEOF ; 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 MOVE A,POSPTR IMUL A,BYTPWD PUSH P,A 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: MOVE A,LENGTH IMUL A,BYTPWD PUSH P,A PUSH P,BYTSIZ PUSH P,LENGTH PUSH P,[44] MOVEI A,4 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 IDIV A,BYTPWD JUMPN B,ACCES4 MOVEM A,WD2 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