|
DataMuseum.dkPresents historical artifacts from the history of: Philips Data Systems |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Philips Data Systems Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 14028 (0x36cc)
Notes: pts_type(SC)
Names: »DKRUT1.SC«
└─⟦48601905a⟧ Bits:30009668 Philips computer tape "600121"
└─⟦this⟧ »S:DE/DKRUT1.SC«
└─⟦5c22ed822⟧ Bits:30009675 Philips computer tape "600209"
└─⟦this⟧ »DEN10/DKRUT1.SC«
└─⟦79fbed147⟧ Bits:30009697 Philips computer tape "600414"
└─⟦this⟧ »S:DE/DKRUT1.SC«
└─⟦bf903a231⟧ Bits:30009665 Philips computer tape "600109"
└─⟦this⟧ »DEN10/DKRUT1.SC«
└─⟦d2a299635⟧ Bits:30009698 Philips computer tape "600415"
└─⟦this⟧ »S:DE/DKRUT1.SC«
IDENT DKRUT1 REL10.0 80-04-11 80-01-18/CHST * ********************************************************** * * THIS MODULE HANDLES ALL DISC IN- AND OUTPUT. * * AFTER EXECUTION, THE DATA-ITEM DEBINW4 WILL BE SET AS * FOLLOWS: * 0 = NO ERROR * 20 = NO SYSTEMDISC IN SYSTEM * 21 = NO DISC IN SPECIFIED UNIT * 22 = DISC I/0-ERROR * 23 = DISC NOT OPERABLE * *********************************************************** DDUM DEDDIV PDIV EXT WAIT EXT RELEAS EXT EMPTYT EXT MASK EXT DEPOOL EXT GETFRE EXT SETFRE EXT SETOCC EXT RETURN EXT ATTWB EXT RESTOR EXT COND EXT READDK EXT WRITDK ENTRY RDDS ENTRY WRDS ENTRY DISU ENTRY WRFSP ENTRY REFSP ENTRY WRIACC ENTRY WRICUR ENTRY FREESP ENTRY WRTCO ENTRY CLSBTH ENTRY RECURR ENTRY RD ENTRY WR ENTRY RFRSP ENTRY RDACC ENTRY OFRSP ENTRY GTNEXT ENTRY GTPREV ENTRY DLCURR ENTRY DLRCCH EJECT DISU PROC FUZ,RECNO,BUF PBIN FUZ PBIN RECNO PSTRG BUF IB FUZ C READSY C WRITSY C READUS C WRITUS READSY CALL READDK,DISK,FILECODE(W1),BUF,SECLEN,RECNO BOK READSY01 PERF DKER TBT NEWVOL,READSY READSY01 PERF COND RET WRITSY CALL WRITDK,DISK,FILECODE(W1),BUF,SECLEN,RECNO BOK WRITSY01 PERF DKER TBT NEWVOL,WRITSY WRITSY01 PERF COND RET READUS CALL READDK,DISK,FILECODE(FILINDUS),BUF,SECLEN,RECNO BOK READUS01 PERF DKER TBT NEWVOL,READUS READUS01 PERF COND RET WRITUS CALL WRITDK,DISK,FILECODE(FILINDUS),BUF,SECLEN,RECNO BOK WRITUS01 PERF DKER TBT NEWVOL,WRITUS WRITUS01 PERF COND RET PEND EJECT * * SUBROUTINE RDDS AND WRDS: READ AND WRITE D/E-RECORDS WITH A LENGTH O * MORE DATASECTORS ON DISC. THE LENGTH OF THE D/E-RECORD IS GIVEN BY ' * 'USELEN' IS SET AFTER FILE-ASSIGNMENT FOR RESP. TASK DEPENDING ON A * FIRST RECORD OF THE USERFILE. * RDDS PROC RNR PBIN RNR CALL READDK,DISK,FILECODE(FILINDUS),RBUF,USELEN,RNR PERF COND RET PEND * WRDS PROC RNR PBIN RNR CALL WRITDK,DISK,FILECODE(FILINDUS),RBUF,USELEN,RNR PERF COND RET PEND EJECT ************************************************************ * * SUBROUTINE DKER * * PURPOSE: SPECIFIES DISK-ERROR * * CHANGED ITEMS: DKBIN1,DKBIN2,DEBINW4 * ************************************************************ * DKER PROC CLEAR NEWVOL XSTAT DISK,DKBIN1 MOVE BCD13A,DKBIN1 MOVE DKBIN2,=X'8022' CALL MASK,DKBIN1,DKBIN2 BZ DKER10 MOVE DEBINW4,W22 I/O-ERROR RET DKER10 MOVE DKBIN2,=X'800' CALL MASK,DKBIN1,DKBIN2 BZ DKER20 MOVE DEBINW4,=W'30' NO DATA RET DKER20 MOVE DKBIN2,W128 CALL MASK,DKBIN1,DKBIN2 BZ DKER30 SET NEWVOL NEW VOLUME LOADED RET DKER30 MOVE DKBIN2,W1 CALL MASK,DKBIN1,DKBIN2 BZ DKER40 MOVE DEBINW4,=W'23' DISC NOT OPERABLE DKER40 RET PEND * * WRITE FREESPACE-RECORD * WRFSP PROC MAX PERF WAIT MOVE DKBIN1,FINDEXPO(MAX) COPY SYSBUF,W0,W10,RPOOL(DKBIN1),W9 COPY SYSBUF,W10,W188,BPOOL(DKBIN1),W0 MOVE DKBIN1,FFSNR(MAX) CALL WRITDK,DISK,FILECODE(MAX),SYSBUF,SECLEN,DKBIN1 BNERR WRFRET PERF DKER WRFRET PERF COND RET PEND * * * REFSP PROC FSRNR,FIND PERF WAIT REFS01 CALL READDK,DISK,FILECODE(FIND),SYSBUF,SECLEN,FSRNR BNERR REFCOP PERF DKER TBT NEWVOL,REFS01 REFCOP MOVE DKBIN1,FINDEXPO(FIND) MOVE FFSNR(FIND),FSRNR COPY RPOOL(DKBIN1),W9,W10,SYSBUF,W0 COPY BPOOL(DKBIN1),W0,W188,SYSBUF,W10 REFEND PERF COND RET PEND EJECT * RD PROC BIN,BUF TBT SWIT04,US01 PERF DISU,W1,BIN,BUF B DRET US01 PERF DISU,W3,BIN,BUF DRET RET PEND WR PROC BIN,BUF TBT SWIT04,US02 PERF DISU,W2,BIN,BUF B DRET US02 PERF DISU,W4,BIN,BUF B DRET PEND EJECT * * * SUBROUTINE RDACC, READ ACCUMULATORS * RDACC PROC PERF WAIT PERF DISU,W3,DEBIN1,SYSBUF BERR RDARET COPY BPOOL(PINACC),W0,W188,SYSBUF,W10 XCOPY RPOOL(PINACC),W9,W2,DEBIN1,W0 RDARET PERF COND RET PEND * * SUBROUTINE WRACC, WRITE ACCUMULATORS * WRACC PROC PERF WAIT MOVE SYSBUF,=X'414300' COPY SYSBUF,W10,W188,BPOOL(PINACC),W0 XCOPY DEBIN1,W0,W2,RPOOL(PINACC),W9 PERF DISU,W4,DEBIN1,SYSBUF PERF COND RET PEND * EJECT * * DUMPROC PROC FC WRICUR PERF FREESP,DEBIN1,FILINDUS BNERR WRIT01 SET SWIT01 NO MORE SECTORS AVAILABLE WRIT01 MOVE STR2A,=X'4453' COPY RBUF,W0,W2,STR2A,W0 PTR NEXT SCTR TO CURR REC XCOPY RBUF,W4,W2,DEBIN1,W0 WRIT05 PERF WRDS,CURSEC WRITE RECORDAREA BNERR WRIT02 * * WRITING - ERROR * PERF FREESP,DEBIN2,FILINDUS GET NEW FREESP MOVE CURSEC,DEBIN2 NEW FREESP = CURRENT SCTRNO GET LINK PREV SCTR XCOPY DEBIN3,W0,W2,RBUF,W2 CBE DEBIN3,W0,ENDERR FIRST RECORD? PERF RDDS,DEBIN3 READ PREV RECORD(S) BERR ENDERR SET CONTINUATION IN PREV SCTR XCOPY RBUF,W4,W2,CURSEC,W0 PERF WRDS,DEBIN3 WRITE PREV RECORD(S) BNERR WRIT05 GET LINK PREV OF PREV XCOPY DEBIN3,W0,W2,SYSBUF,W2 CBE DEBIN3,W0,ENDERR FIRST RECORD? PERF RDDS,DEBIN3 READ PREV OF PREV BERR ENDERR PREV OF PREV = END OF CHAIN XCOPY RBUF,W4,W2,W0,W0 PERF WRDS,DEBIN3 WRITE PREV OF PREV ENDERR MOVE DEBINW4,W21 INDICATE DISC-ERROR B WRIT07 * * OKAY * WRIT02 SET LINK PREV SCTR XCOPY RBUF,W2,W2,CURSEC,W0 XCOPY RBUF,W4,W2,W0,W0 LINK TO NEXT = 0 SET NO OF OCC BYTES XCOPY RBUF,W6,W2,W10,W0 MOVE CURSEC,DEBIN1 SET CURRENT SCTRNO TBF SWIT01,WRIT07 MOVE DEBINW4,W10 'NO MORE SPACE ON DISC' WRIT07 B RETURN * * * * WRIACC PERF WRACC PERF WRFSP,FILINDUS B RETURN * * * WRTCO PERF WRDS,CURSEC WRITE SECTOR(S) B RETURN * * * CLSBTH CLOSE BATCH MOVE DEBIN1,W0 B WRIT01 * * * RECURR PERF RDDS,CURSEC READ SCTR(S) CBNE DEBINW4,=W'30',BRETTA MOVE DEBINW4,W0 BRETTA B RETURN * * * GTNEXT XCOPY DEBIN1,W0,W2,RBUF,W4 GT001 PERF RDDS,DEBIN1 READ SECTOR(S) BERR RETURN CBE FC,W16,GT003 JUMP IF GETPREV GET LINK PREV FOR CONTROL XCOPY DEBIN2,W0,W2,RBUF,W2 CBE DEBIN2,W0,GT002 CBE CURSEC,DEBIN2,GT003 IF NOT OK, ZEROISE LINK TO NEXT SCTR(S) IN CURRENT ONE. XCOPY RBUF,W4,W2,W0,W0 PERF WRDS,DEBIN1 GT002 MOVE DEBINW4,W9 B RETURN GT003 MOVE CURSEC,DEBIN1 CURRENT SECTORNUMBER B RETURN * * * GTPREV XCOPY DEBIN1,W0,W2,RBUF,W2 B GT001 * * * DLCURR SET SWIT04 PERF DLRCCH,RBUF MOVE CURSEC,DEBIN2 B RETURN * * * PEND EJECT * * * SUBR FREESP, GET RECORDNUMBER OF NEXT FREE RECORD IN FILE * * FREESP PROC RECN,INDEX MOVE DEBINW4,W0 CLEAR SWIT06 CLEAR SWIT07 FREE01 MOVE DKBIN1,FINDEXPO(INDEX) CALL GETFRE,BPOOL(DKBIN1),RPOOL(DKBIN1),RECN CBE RECN,W0,NOFN SUB FNOOFREC(INDEX),W1 CBG FNOOFREC(INDEX),F95PROC(INDEX),FND SET SW95PR B FND NOFN XCOPY DKBIN3,W0,W2,RPOOL(DKBIN1),W13 CBE DKBIN3,W0,EOFCHN FSP02 PERF SAVESB PERF WRFSP,INDEX BERR RESSY PERF REFSP,DKBIN3,INDEX BERR RESSY PERF RESTSB B FREE01 RESSY PERF RESTSB B FND EOFCHN TBT SWIT06,NOFSP SET SWIT06 MOVE DKBIN3,W2 B FSP02 NOFSP MOVE DEBINW4,W10 FND CBG INDEX,W1,NEFE SET SWITFS NEFE PERF COND RET PEND * * * SUBROUTINE RFRSP, FREE RECORDS ARE PASSED TO * FREESPACE-TABLE. RECORDNUMBER IN PM RECNO. * RFRSP PROC RECNO,INDEX PERF GFRSPR,RECNO,INDEX GET FSP-REC WITH RECNO IN IT CALL SETFRE,BPOOL(DEBIN4),RPOOL(DEBIN4),RECNO ADD FNOOFREC(INDEX),W1 CBNE INDEX,W1,RFRSP1 JUMP IF NOT SET SWITFS SYSTEMFILE RFRSP1 PERF COND RET PEND * * SUBROUTINE GFRSPR * GET FREESPACE-RECORD WITH RECORDNUMBER ACCORDING * TO RECNO IN IT * * SYNTAX: PERF GFRSPR,RECNO,INDEX * INDEX = INDEX TO CURRENT FILE * GFRSPR PROC RECNO,INDEX ANFANG MOVE DKBIN1,W1 CBE INDEX,W1,SYSFLE MOVE DKBIN1,USELEN DIV DKBIN1,SECLEN GET NO OF SCTRS/REC SYSFLE MOVE DEBIN4,FINDEXPO(INDEX) GET INDEX TO FREESP-POOL XCOPY DKBIN2,W0,W2,RPOOL(DEBIN4),W15 OCC SPACE SUB DKBIN2,W12 MUL DKBIN2,W8 DIV DKBIN2,DKBIN1 MUL DKBIN2,DKBIN1 GET RID OF UNUSED BITS XCOPY DKBIN1,W0,W2,RPOOL(DEBIN4),W17 1ST INDICATED RNR MOVE DKBIN3,DKBIN1 SAVE 1ST INDICATED RNR ADD DKBIN1,DKBIN2 GET LAST INDICATED RNR SUB DKBIN1,W1 CBG RECNO,DKBIN1,NEXT CBL RECNO,DKBIN3,PREV GFRET MOVE DEBIN4,FINDEXPO(INDEX) RET NEXT GET NEXT FREESP-RECORD MOVE DKBIN1,W13 READ XCOPY DEBIN4,W0,W2,RPOOL(DEBIN4),DKBIN1 GET LINK CBE DEBIN4,W0,GFRET PERF SAVESB PERF WRFSP,INDEX BERR GFREST PERF REFSP,DEBIN4,INDEX BERR GFREST PERF RESTSB B ANFANG GFREST PERF RESTSB B GFRET PREV MOVE DKBIN1,W11 B READ PEND * * * SUBROUTINE OFRSP * SET RECORD ACCORDING TO RECNO OCCUPIED * OFRSP PROC RECNO,INDEX PERF GFRSPR,RECNO,INDEX CALL SETOCC,BPOOL(DEBIN4),RPOOL(DEBIN4),RECNO RET PEND * * SAVESB PROC SAVE SYSBUF TO POOL MOVE WORK(W1),DEBINW4 SAVPOO MOVE DKBIN1,W1 MOVE DKBIN2,W1 PERF DEPOOL,W2,DKBIN1,DKBIN2,STRG10A BNERR SAVOK SWITCH B SAVPOO SAVOK MOVE WORK(W2),DKBIN1 COPY RPOOL(DKBIN1),W9,W10,SYSBUF,W0 COPY BPOOL(DKBIN1),W0,W188,SYSBUF,W10 MOVE DEBINW4,WORK(W1) RET PEND * * RESTSB PROC RESTORE SYSBUF FROM POOL MOVE DKBIN1,WORK(W2) COPY SYSBUF,W0,W10,RPOOL(DKBIN1),W9 COPY SYSBUF,W10,W188,BPOOL(DKBIN1),W0 PERF DEPOOL,W6,DKBIN1,DKBIN1,STRG10A RET PEND EJECT * * SUBROUTINE DLRCCH, REMOVE RECORD FROM CHAIN. SWIT04 ON: USERFILE * DLRCCH PROC BUF CLEAR BOOL8 CLEAR BOOL9 XCOPY DEBIN2,W0,W2,BUF,W2 XCOPY DEBIN1,W0,W2,BUF,W4 CBNE DEBIN1,W0,DL001 SET BOOL9 B RREPRE DL001 PERF RD,DEBIN1,BUF BERR DLRET XCOPY DEBIN5,W0,W2,BUF,W2 XCOPY BUF,W2,W2,DEBIN2,W0 CBNE DEBIN2,W0,DL004 PERF WR,DEBIN5,BUF XCOPY DEBIN2,W0,W2,BUF,W4 GET LINK FORWARD CBE DEBIN2,W0,DL003 IF NO MORE IN CHAIN PERF RD,DEBIN2,BUF READ NEXT RECORD BERR DLRET XCOPY BUF,W2,W2,DEBIN5,W0 SET LINK BACKWARD PERF WR,DEBIN2,BUF WRITE WITH UPDATED LINK DL003 MOVE DEBIN5,DEBIN1 B DL006 DL004 PERF WR,DEBIN1,BUF RREPRE CBNE DEBIN2,W0,DL008 DL006 SET BOOL8 TBT BOOL9,DLRET B DLR2 DL008 PERF RD,DEBIN2,BUF BERR DLRET XCOPY DEBIN5,W0,W2,BUF,W4 XCOPY BUF,W4,W2,DEBIN1,W0 PERF WR,DEBIN2,BUF BERR DLRET DLR2 MOVE DEBIN1,FILINDUS TBT SWIT04,DLR1 MOVE DEBIN1,W1 DLR1 PERF RFRSP,DEBIN5,DEBIN1 DLRET PERF COND RET PEND * * * END