|
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: 11104 (0x2b60)
Notes: pts_type(SC)
Names: »DEDISU.SC«
└─⟦48601905a⟧ Bits:30009668 Philips computer tape "600121"
└─⟦this⟧ »S:DU/DEDISU.SC«
└─⟦79fbed147⟧ Bits:30009697 Philips computer tape "600414"
└─⟦this⟧ »S:DU/DEDISU.SC«
└─⟦d2a299635⟧ Bits:30009698 Philips computer tape "600415"
└─⟦this⟧ »S:DU/DEDISU.SC«
IDENT DEDISU PRR 1.0 79-06-19/AST * * ************************************************************************ * * * THIS MODULE CONTENTS ALL SUBROUTINES, USED BY * * D E D I S C * * ************************************************************************ * * DDUM DDINIT PDIV EXT DISU EXT DEPOOL EXT GETFRE EXT SETFRE EXT SETOCC EXT REFSP EXT WRFSP EXT CHANFC EXT COND EXT RDDS ENTRY POOL ENTRY MATCH ENTRY NOFFRE ENTRY NOFFRE ENTRY WAIT ENTRY RELEAS ENTRY FREESP ENTRY SCHPOO ENTRY DLRCCH ENTRY RD ENTRY WR ENTRY RFRSP ENTRY OFRSP ENTRY SFMTCH ENTRY LOCKE ENTRY RDACC ENTRY WRACC ENTRY POOL ENTRY READJB ENTRY MATCH ENTRY ENTR ENTRY ALGO ATTACH EQU X'0E' DETACH EQU X'0F' EJECT NOFFRE PROC CNTR,INDFIL GET NO OF FREE RECORDS MOVE CNTR,W0 MOVE DEBIN5,W2 CLEAR SWIT04 US002 CBL INDFIL,W2,US001 SET SWIT04 US001 PERF RD,DEBIN5,RBUF BERR NOFRET XCOPY DEBIN5,W0,W2,RBUF,W4 XCOPY DEBIN4,W0,W2,RBUF,W10 ADD CNTR,DEBIN4 CBNE DEBIN5,W0,US002 MOVE FNOOFREC(INDFIL),CNTR NOFRET PERF COND RET PEND * * WAIT PROC SUBROUTINE WAIT TBT SWITWT,WARE MOVE DEBINW4,W0 CLEAR SWIT08 MOVE DKBIN1,=X'D0' CALL CHANFC,DISK,DKBIN1 DSC1 DISK,ATTACH,W128 BNERR WARE2 MOVE DEBINW4,W3 WARE PERF COND RET WARE2 SET SWITWT SWITCH B WARE * * PEND RELEAS PROC SUBROUTINE RELEAS CLEAR SWITWT BZ RELRET MOVE DKBIN1,=X'D0' CALL CHANFC,DISK,DKBIN1 DSC1 DISK,DETACH,W0 RELRET RET PEND * * 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 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 SCHPOO, SEARCH POOL * SCHPOO PROC $IND,STRG,WX MOVE STRG10A,$IND COPY STRG10A,W1,W6,STRG,W0 PERF DEPOOL,WX,DEBIN3,DEBIN4,STRG10A RET PEND * * 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 XCOPY DEBIN5,W0,W2,BUF,W2 XCOPY BUF,W2,W2,DEBIN2,W0 CBNE DEBIN2,W0,DL004 PERF WR,DEBIN5,BUF MOVE DEBIN5,DEBIN1 B RREPRE DL004 PERF WR,DEBIN1,BUF RREPRE CBNE DEBIN2,W0,DL008 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 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 * * 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 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 * * SUBROUTINR SFMTCH, SEARCH CHAIN. SWIT04 ON: USERFILE * SFMTCH PROC WX,BUF,STEG MOVE DEBIN1,WX RID0 MOVE DEBIN2,W10 TBF SWIT04,RID3 PERF RDDS,DEBIN1 B BNERR RID3 PERF RD,DEBIN1,BUF BNERR BNERR RID1 CBE DEBINW4,=W'30',RID2 B RETR RID1 ADD DEBIN2,W2 XCOPY DKBIN1,W0,W2,BUF,W6 PERF MATCH,BUF,DEBIN2,DKBIN1,STR6A,STEG BNERR FOND MOVE DEBINW4,W0 XCOPY DKBIN1,W0,W2,BUF,W4 CBE DKBIN1,W0,RID2 MOVE DEBIN1,DKBIN1 B RID0 RID2 MOVE DEBINW4,W9 INDICATE 'NOT IN CHAIN' B RETR FOND ADD DEBIN2,W6 XCOPY DEBIN3,W0,W2,BUF,DEBIN2 RETR PERF COND RET PEND * * * LOCKE PROC MOVE DEBIN1,W0 XCOPY DEBIN1,W1,W1,RPOOL(DEBIN3),W0 ADD DEBIN1,W128 XCOPY RPOOL(DEBIN3),W0,W1,DEBIN1,W1 RET PEND * * 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 * * SUBR POOL, GET ONE BUFFER, LOCKED * POOL PROC MOVE DKBIN1,W1 MOVE DKBIN2,W1 PERF DEPOOL,W2,DKBIN1,DKBIN2,STRG10A RET PEND * * READJB PROC MOVE DEBIN4,W3 REDJCH MOVE DEBIN3,DEBIN4 PERF DISU,W1,DEBIN3,SYSBUF BERR RETRED MOVE DEBIN5,=W'92' COPY STR6A,W0,W6,SYSBUF,DEBIN5 CBE STR6A,JOBNAME,RETRED XCOPY DEBIN4,W0,W2,SYSBUF,W4 CBNE DEBIN4,W0,REDJCH MOVE DEBINW4,W9 RETRED PERF COND RET PEND * MATCH PROC BUF1,START,END,KEY,STEP MTCH MATCH BUF1,START,W6,KEY,W0,W6 BNERR MTCHED ADD START,STEP SUB START,W1 CBNG START,END,MTCH MOVE DEBINW4,W9 MTCHED PERF COND RET PEND * * ENTR PROC ITEM XCOPY RBUF,DEBIN2,W2,W0,W0 ADD DEBIN2,W2 COPY RBUF,DEBIN2,W6,ITEM,W0 ADD DEBIN2,W6 RET PEND * * SUBROUTINE ALGO: SET OR CHECK FORMAT-IDENTIFICATION ON DESCRIPTOR- * RECORD FOR DIRECT DISC-ACCESS IN 'GET FORMAT' * FC = 1 FOR SET (ENTER FORMAT) * FC = 2 FOR GET (GET FORMAT) IN THIS CASE, THE CONDITIONREGISTER IS * SET TO 0 IF IDENTIFICATION OKAY * SET TO 2 IF IDENTIFICATION NOT OKAY * ALGO PROC FC MOVE DKBIN3,W0 MOVE DKBIN1,W0 XCALGO XCOPY DKBIN2,W0,W2,STR6A,DKBIN1 ADD DKBIN3,DKBIN2 ADD DKBIN1,W2 CBNE DKBIN1,W6,XCALGO IB FC C ALTO C ALFRO ALTO XCOPY SYSBUF,W0,W2,DKBIN3,W0 RET ALFRO XCOPY DKBIN2,W0,W2,SYSBUF,W0 CBE DKBIN2,DKBIN3,NOERR CMP W1,W2 RET NOERR CMP W1,W1 RET PEND SAVESB PROC SAVE SYSBUF TO POOL MOVE FLIND(W20),DEBINW4 SAVPOO PERF POOL BNERR SAVOK SWITCH B SAVPOO SAVOK MOVE FLIND(W21),DKBIN1 COPY RPOOL(DKBIN1),W9,W10,SYSBUF,W0 COPY BPOOL(DKBIN1),W0,W188,SYSBUF,W10 MOVE DEBINW4,FLIND(W20) RET PEND * * RESTSB PROC RESTORE SYSBUF FROM POOL MOVE DKBIN1,FLIND(W21) COPY SYSBUF,W0,W10,RPOOL(DKBIN1),W9 COPY SYSBUF,W10,W188,BPOOL(DKBIN1),W0 PERF DEPOOL,W6,DKBIN1,DKBIN1,STRG10A RET PEND END