mirror of
https://github.com/PDP-10/its.git
synced 2026-01-20 09:55:52 +00:00
3457 lines
87 KiB
Plaintext
3457 lines
87 KiB
Plaintext
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 /</]
|
||
JRST QLOOKA ;4.9 BIT OF J SET IF >
|
||
CAMN B,[SIXBIT />/]
|
||
TLOA J,400000
|
||
CAMN B,[SIXBIT /</]
|
||
AOJA C,QLOOK1
|
||
PUSHJ P,QLGLK
|
||
JRST POPJJ ;FNF
|
||
TRNN J,1777
|
||
JRST POPJJ ;J IS OFF THE END OF THE BLOCK
|
||
PUSH P,C
|
||
QLK4: CAIL J,ARCDIR+2000-LUNBLK
|
||
JRST QLK5
|
||
CAMN B,UNFN2+5(J)
|
||
CAME A,UNFN1+5(J)
|
||
JRST QLK5
|
||
ADDI J,LUNBLK
|
||
JRST QLK4
|
||
QLK5: EXCH Q,J
|
||
QLK1: CAMN A,UNFN1(Q)
|
||
CAME B,UNFN2(Q)
|
||
JRST QLK3 ;FNF
|
||
MOVE C,UNRNDM(Q)
|
||
TLNN C,UNIGFL ;BEING WRITTEN OR DELETED
|
||
JRST QLK2 ;FOUND IT
|
||
SUBI Q,LUNBLK ;SEARCH THROUGH * FILES
|
||
CAML Q,J
|
||
JRST QLK1
|
||
QLK3: POP P,C
|
||
POPJJ: POP P,J
|
||
POPJ P,
|
||
|
||
QLK2: AOS -2(P)
|
||
JRST QLK3
|
||
|
||
|
||
QLOOKA: CAME B,[SIXBIT /</]
|
||
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,[-<FBTLEN-1>,,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,[-<FBTLEN+5>,,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-<NUDSL*2>(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
|
||
|