|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 7680 (0x1e00)
Types: TextFile
Names: »RBLOCK.SRC«
└─⟦c9df7130d⟧ Bits:30005915 Pascal MT+ Release 5.2 (Jet-80)
└─ ⟦this⟧ »RBLOCK.SRC«
;FILL AND FLUSH BUFFER FOR RANDOM ACCESS OPERATIONS ; NAME RBLOCK ENTRY RBLOCK EXT BYTIN,BYTOT,POPHDB,SELDSK,PUSHBD,DERR INCLUDE DEFLT.SRC ; ;RECORD NUMBER IN DE, RECORD SIZE IN HL. MULTIPLY NUMBERS AND DIVIDE ;BY 128 TO GET BLOCK NUMBER AND OFFSET. RETURNS BLOCK NUMBER ;IN REGISTERS D(HIGH BYTE),E, AND C(LOW BYTE), AND OFFSET IN B. ;FILLS AND FLUSHES FILE BUFFER DEPENDING ON PRESENT AND PREVIOUS ;I/O OPERATIONS. ; RBLOCK: CALL PUSHBD ;SAVE ALL REGISTERS EXCEPT A ;SEE IF BUFFER SHOULD BE FLUSHED PUSH PSW ;SAVE PRESENT OP CODE,1-WRITE,0-READ PUSH B ;SAVE FILE BUFFER ADDRESS PUSH H ;RECORD SIZE PUSH D ;RECORD NUMBER MOV H,B ;HL <- FBA MOV L,C PUSH H INX H INX H INX H CALL SELDSK ;SELECT PROPER DRIVE POP H ;FBA BIT 2,M ;HAS FILE BEEN WRITTEN TO? JRZ RNMULT ;NO, DON'T NEED TO FLUSH BUFFER BIT 4,M ;WRITTEN TO. WAS IT DIRECT OR SEQUENTIAL? JRNZ DRCWRT ;FILE HAS BEEN RANDOMLY WRITTEN ; ; ACCESSING A FILE WHICH HAS BEEN SEQUENTIALLY WRITTEN. MUST FLUSH ; BUFFER SEQUENTIALLY BEFORE DOING ANY DIRECT ACCESS. INX H INX H INX H ;FCB PUSH H LXI D,DATAB DAD D ;HL NOW POINTS TO START OF DATA BUFFER. XCHG MVI C,26 ;CP/M CODE TO SET DMA ADDRESS. CALL CPM POP H ;FCB PUSH H XCHG MVI C,21 ;CP/M CODE TO WRITE A SECTOR CALL CPM ORA A ;TEST FOR ERROR CODE JNZ DERR POP H PUSH H LXI D,128+DATAB DAD D ;HL NOW POINTS TO SECOND HALF OF DATA BUFFER XCHG MVI C,26 ;CP/M CODE TO SET DMA ADDRESS CALL CPM POP H PUSH H XCHG MVI C,21 ;CP/M CODE TO WRITE A SECTOR CALL CPM ORA A JNZ DERR POP H ;FCB DCX H DCX H DCX H ;FBA JRZ RNMULT ;NOW CALCULATE DIRECT RECORD NUMBER DRCWRT: BIT 3,M ;INDICATES WHETHER PREV.I/O WAS READ OR WRITE JRZ RNMULT ;DON'T FLUSH BUFFER,PREVIOUS OP. WAS READ ;PREVIOUS I/O A WRITE. MUST FLUSH BUFFER WHETHER PRESENT I/O IS ;A READ OR WRITE. BUFFER MUST BE FLUSHED USING DIRECT ACCESS. ; ; WRITE SECOND 128-BYTE BUFFER FIRST RFLUSH: PUSH H LXI D,DATAB+3+128 DAD D ;FIRST BYTE FOR OUTPUT XCHG MVI C,26 ;CODE TO SET DMA CALL CPM POP D ;FILE BUFFER ADDRESS INX D INX D INX D PUSH D ;SAVE FCB ADDRESS MVI C,SETRAN-2 ;WRITE RANDOM,128 BYTES FROM BUFFER CALL CPM POP H ;FILE CONTROL BLOCK PUSH H ;WRITE FIRST 128-BYTE BLOCK FROM BUFFER LXI D,RANREC DAD D ;LOW BYTE OF BLOCK NUMBER DCR M ;SUBTRACT ONE FOR PREVIOUS BLOCK MOV A,M INR A ;CHECK FOR A BORROW JRNZ W2SET ;NO BORROW INX H ;HIGH BYTE DCR M JRNZ W2SET ;NO BORROW INX H ;OVERFLOW BYTE DCR M W2SET: POP H ;FCB PUSH H ;SAVE FCB LXI D,DATAB ;FIRST FREE BYTE DAD D XCHG MVI C,26 ;SET DMA FOR FIRST BLOCK CALL CPM POP D ;FCB MVI C,SETRAN-2 ;RANDOM WRITE CALL CPM ;IS PRESENT OPERATION SEQ OR RANDOM POP B ;RECORD NUMBER PUSH B MOV A,B ORA C ;IF RECORD NUMBER ZERO, SEQUENTIAL WRITE JZ SEQOP ;SEQ. OP. ;MULTIPLY RECORD SIZE BY RECORD-1 TO GET LOCATION OF RECORD IN BYTES RNMULT: POP D ;RECORD NUMBER POP B ;RECORD SIZE POP H ;FBA DCX D ;DECRE. RECORD NUMBER TO TEST FOR 1ST REC. MOV A,D ;WHICH MUST BE HANDLED SLIGHTLY DIFFERENTLY ORA E INX D ;BACK TO REAL VALUE INX H INX H ;GO TO SECOND 'FLAGS' BYTE JRNZ NOTFST ;NOT FIRST RECORD BSET 0,M ;SET FIRST BIT TO INDICATE FIRST REC. XRA A LXI D,RANREC+1 DAD D ;LOW BYTE OF BLOCK NUMBER MOV M,A ;ZERO BLOCK FOR FIRST RECORD INX H ;HIGH BYTE MOV M,A INX H ;OVERFLOW BYTE MOV M,A LXI D,-RANREC-5 DAD D ;FBA PUSH H XCHG JMP FSTREC NOTFST: RES 0,M ;RESET BIT FOR NOT FIRST RECORD DCX H DCX H PUSH H ;FBA MOV H,B ;RECORD SIZE INTO HL FOR CALCULATIONS MOV L,C XRA A MVI B,17 ;FAST MULTIPLY--NO ERROR CHECKING DCX D ;RECORD NUMBERS BEGIN AT ONE CMP D ;OPTIMIZATION SECTION JRZ RAOPT ;CHECK FOR A ZERO HIGH BYTE CMP H JRNZ RANOPT ;CAN'T FIND ONE XCHG RAOPT: MVI B,9 ;ONLY DO NINE SHIFTS MOV D,E MOV E,A RANOPT: MOV A,B ;NUMBER OF SHIFTS MOV B,H MOV C,L LXI H,0 ;CLEAR RESULT RALOOP: DCR A JRZ BLKCAL ;CHECK SHIFT COUNTER DAD H ;SHIFT PARTIAL RESULT XCHG JRC INXDE DAD H ;SHIFT MULTIPLIER XCHG RA: JRNC RALOOP ;NEXT SHIFT DAD B ;ADD IN MULTIPLICAND JRNC RALOOP ;NEXT SHIFT INX D ;CARRY TO DE JR RALOOP ;NEXT SHIFT INXDE: DAD H XCHG INX D ;CARRY TO DE JR RA ;FOUR BYTE NUMBER WITH HIGH BYTES IN DE AND LOW BYTES IN HL IS ;DIVIDED BY 128.OFFSET IS LOW SEVEN BITS OF L. H,E,AND D ARE EACH ;SHIFTED LEFT ONE BIT AND CARRY FROM PREVIOUS REGISTER SHIFT IS ADDED. ;BLOCK NUMBER IS RETURNED IN D,E,C. OFFSET IN B. BLKCAL: DCX H ;DECR BYTE COUNT TO CORRECTLY PLACE MOV A,L ;OFFSET INTO BUFFER FOR READ OR WRITE ANA H ADI 1 JRNZ RBCAL DCX D RBCAL: XRA A MOV B,L RES 7,B ;OFFSET IN B ;BLOCK NUMBER CALCULATION SLAR H PUSH PSW ;SAVE FLAGS BIT 7,L ;TEST HIGH BIT OF L JRZ LMSB INR H ;FROM HIGH BIT OF L LMSB: POP PSW JRNC ESHIFT SLAR E INR E ;FROM HIGH BIT OF H JR DBIT ESHIFT: SLAR E DBIT: JRNC DSHIFT SLAR D INR D ;FROM HIGH BIT OF E JR DMSB DSHIFT: SLAR D DMSB: MOV C,H ;LOW BYTE POP H ;FBA PUSH H ;SET BLOCK NUMBER IN FILE CONTROL BLOCK PUSH D ;HIGH BYTES OF BLOCK NUMBER LXI D,RANREC+3 DAD D POP D MOV M,C ;LOW BYTE OF BLOCK NUMBER INX H MOV M,E ;HIGH BYTE OF BLOCK NUMBER INX H MOV M,D ;OVERFLOW BYTE OF BLOCK NUMBER POP D ;FILE BUFFER ADDRESS JR RRFILL SEQOP: POP H ;RECORD NUMBER POP H ;RECORD SIZE POP D ;FBA LXI H,BYTPT+3 DAD D ;BYTE POINTER MOV B,M ;GET OFFSET RRFILL: PUSH B ;SAVE OFFSET PUSH D ;FBA FSTREC: LXI H,RANREC+2 DAD D ;SET CURRENT RECORD TO ZERO MVI M,0 LXI H,DATAB+3 DAD D ;FIRST BYTE FOR INPUT XCHG MVI C,26 ;CODE TO SET DMA CALL CPM POP D ;FILE BUFFER ADDRESS INX D INX D INX D PUSH D ;FILE CONTROL BLOCK MVI C,SETRAN-3 ;READ RANDOM,128 BYTES INTO BUFFER CALL CPM POP H ;FILE CONTROL BLOCK PUSH H ;READ SECOND 128-BYTE BLOCK INTO BUFFER LXI D,RANREC DAD D ;LOW BYTE OF BLOCK NUMBER INR M ;ADD ONE FOR NEXT BLOCK JRNZ R2SET ;NO CARRY INX H ;HIGH BYTE INR M JRNZ R2SET ;NO CARRY INX H ;OVERFLOW BYTE INR M R2SET: POP D ;FILE CONTROL BLOCK PUSH D LXI H,DATAB+128 ;FIRST FREE BYTE DAD D XCHG MVI C,26 ;SET DMA FOR SECOND BLOCK CALL CPM POP D ;FCB PUSH D MVI C,SETRAN-3 ;RANDOM READ CALL CPM ;SET BYTE POINTER POP H ;FCB DCX H ;SECOND 'FLAGS' BYTE BIT 0,M ;RECORD NUMBER 1 ? LXI D,BYTPT+1 ;BUFFER BYTE POINTER/COUNTER DAD D JRZ R2SET1 ;NOT REC. # 1 POP PSW ;PRESENT OPERATION? ORA A JRNZ R2SET2 ;DOING A WRITE MVI M,0 ;SET OFFSET TO ZERO INX H INX H ;FIRST BYTE OF DATA MOV C,M LXI D,-BYTPT-4 DAD D ;READ AHEAD BYTE MOV M,C ;FILL WITH FIRST BYTE DCX H ;FBA PUSH PSW ;SAVE PRESENT OPERATION JR RPREV R2SET2: MVI M,0FFH ;SET OFFSET FOR WRITE JR NOHEAD R2SET1: POP B ;OFFSET IN B MOV M,B ;SAVE POINTER POP PSW ;PRESENT OPERATION ORA A JRNZ NOHEAD ;DOING A WRITE PUSH PSW ;READING LXI D,-BYTPT DAD D ;FCB PUSH H CALL BYTIN ;FILL READ AHEAD BYTE AND ADVANCE OFFSET POP H LXI D,RANREC-1 DAD D ;CURRENT RECORD BYTE MVI M,0 ;SET CURRENT RECORD TO ZERO LXI D,-RANREC-1 DAD D ;READ AHEAD BYTE MOV M,A DCX H ;'FLAGS' BYTE JR RPREV NOHEAD PUSH PSW ;SAVE OP. INDICATOR LXI D,-BYTPT-3 DAD D ;'FLAGS' BYTE RPREV: POP PSW ;A REG. INDICATES OPERATION ORA A JRZ RR BSET 3,M ;SET 'PREV.WRITTEN' INDICATOR FOR NEXT I/O JMP POPHDB ;RESTORE REGISTERS AND RETURN RR: RES 3,M ;RESET 'PREV.WRITTEN' INDICATOR FOR NEXT I/O RRRET: JMP POPHDB ;RESTORE REGISTERS AND RETURN «eof»