|
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: 10948 (0x2ac4)
Notes: pts_type(SC)
Names: »DEDI01.SC«
└─⟦48601905a⟧ Bits:30009668 Philips computer tape "600121"
└─⟦this⟧ »S:DU/DEDI01.SC«
└─⟦79fbed147⟧ Bits:30009697 Philips computer tape "600414"
└─⟦this⟧ »S:DU/DEDI01.SC«
└─⟦d2a299635⟧ Bits:30009698 Philips computer tape "600415"
└─⟦this⟧ »S:DU/DEDI01.SC«
IDENT DEDI01 PRR 1.0 78-05-31/AST * * ************************************************************************ * * * ALL COMMENTS TO DEDISC ARE FOUND IN MODULE * * D E D I C O M M * * ************************************************************************ * * DDUM DDINIT PDIV ENTRY DEDISC ENTRY NXPRFM ENTRY GETT01 EXT COND EXT DISU EXT DEPOOL EXT WRFSP EXT WAIT EXT RELEAS EXT FREESP EXT SCHPOO EXT DLRCCH EXT SFMTCH EXT WRACC EXT ENTJOB EXT GETJOB EXT SCHJOB EXT DELJOB EXT ENTFMT EXT DELFMT EXT GETSYS EXT ENTSYS EXT NEXJOB EXT PREJOB EXT PREFMT EXT NEXFMT EXT ENTTBL EXT DELTBL EXT ENTT01 EXT ENTCOR EXT ENTT03 EXT DELT01 EXT OPNEBC EXT OPNNBC EXT NXJOB EXT NXBTH EXT ALGO EXT RDDS EXT WRDS EJECT DEDISC PROC FC * * BRANCH TO PROGRAM INDICATED BY FC * CLEAR SWIT01 CLEAR SWIT02 CLEAR SWIT03 CLEAR SWIT05 CLEAR SWIT07 CLEAR SWITFS CLEAR SW95PR MOVE DEBINW4,W0 STRT01 IB FC C0000000000000 ENTJOB ENTER JOBDEF C GETJOB GET JOBDEF C DUMMY C SCHJOB SEARCH JOBDEF C DELJOB DELETE JOBDEF C OPNNBC OPEN NEW BATCH C OPNEBC OPEN EXISTING BATCH C CLSBTH CLOSE BATCH C ENTFMT ENTER FORMAT C GETFMT GET FORMAT C DUMMY C SCHFMT SEARCH FORMAT C DELFMT DELETE FORMAT C WRICUR WRITE CURRENT DATA-SECTOR C GTNEXT GET NEXT DATA-SECTOR C GTPREV GET PREVIOUS DATA-SECTOR C DLCURR DELETE CURRENT DATARECORD C WRIACC WRITE ACCUMULATOR-RECORD C GETSYS GET SYSTEM-VARIABLES C ENTSYS ENTER SYSTEM-VARIABLES C NXJOB GET NEXT JOBNAME C DUMMY GET PREVIOUS JOBNAME C WRTCO WRITE SECTOR (CORR) C GETTBL GET TABLE C DELTBL DELETE TABLE C ENTTBL ENTER TABLE C DELBTCH DELETE BATCH C DUMMY GET NO OF FREESPACES C NEXJOB GET NEXT JOBDEFINITION C PREJOB GET PREVIOUS JOBDEF C NEXFMT GET NEXT FORMAT C PREFMT GET PREVIOUS FORMAT C RECURR READ CURRENT SCTR C NXBTH GET NEXT BATCHNAME C DUMMY GET PREV BATCHNAME EJECT GETFMT GET FORMAT MOVE RNRFMCH,W0 MOVE STR6A,DEINPUT PERF WAIT BERR RETURN NXPRFM PERF SCHPOO,=C'F ',STR6A,W7 IB DEBIN4,GOTFFR,FLOCKE SEARCH ON DISC RDDK MOVE DEBINW4,W0 CBNE FRMTPNTR,W0,MAXI CLEAR SWIT04 PERF SFMTCH,W4,SYSBUF,W10 BERR RETURN RDDK98 TEST SWIT02 BNZ RETURN READ 1ST REC OF FMT MOVE SYSBUF,HEX00 PERF DISU,W1,DEBIN3,SYSBUF PERF ALGO,W2 BNERR CHOK MOVE FRMTPNTR,W0 SET SWIT07 BNZ SETER PERF RELEAS B STRT01 SETER MOVE DEBINW4,W9 B RETURN CHOK MOVE FRMTPNTR,DEBIN3 SET FRMTPNTR GET LINK NEXT XCOPY DEBIN5,W0,W2,SYSBUF,W4 GET NO OF REC MOVE DEBIN3,W0 XCOPY DEBIN3,W1,W1,SYSBUF,W8 MOVE DEBIN1,DEBIN3 MOVE DEBIN4,W0 GET NO OF CONSEC XCOPY DEBIN4,W1,W1,SYSBUF,W9 PERF DEPOOL,W1,DEBIN3,DEBIN4,STRG10A BNERR GET21 MOVE DEBINW4,W13 'NO BUFFERS FREE' B RETURN MAXI MOVE DEBIN3,FRMTPNTR B RDDK98 GET21 MOVE DEBIN4,DEBIN3 GET20 XCOPY BPOOL(DEBIN3),W0,W188,SYSBUF,W10 XCOPY RPOOL(DEBIN3),W9,W10,SYSBUF,W0 SUB DEBIN1,W1 CBE DEBIN1,W0,TBFAL PERF DISU,W1,DEBIN5,SYSBUF BERR RETURN GET LINK NEXT XCOPY DEBIN5,W0,W2,SYSBUF,W4 XCOPY DEBIN3,W1,W1,RPOOL(DEBIN3),W8 B GET20 TBFALL MOVE DEBIN4,DEBIN3 TBFAL PERF DEPOOL,W4,DEBIN4,DEBIN1,STRG10A CBE PINDFR,W0,SETPFR PERF DEPOOL,W6,PINDFR,DEBIN1,STRG10A SETPFR MOVE PINDFR,DEBIN4 B RETURN FLOCKE MOVE DEBINW4,W11 'LOCKED' B RETURN GOTFFR MOVE DEBIN1,W0 XCOPY DEBIN1,W1,W1,RPOOL(DEBIN3),W7 CBL DEBIN1,W1,FUNUSE NOT USED USED TBT SWIT02,INDUSE FGETUN PERF SCHPOO,=C'F ',STR6A,W5 SET B TBFALL FUNUSE TBF SWIT02,FGETUN MOVE RPOOL(DEBIN3),HEX00 B RDDK INDUSE MOVE DEBINW4,W11 B RETURN SCHFMT SEARCH FORMAT SET SWIT02 B GETFMT * * * 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 * * * 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 * * * 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 * * * DELBTCH SET SWIT01 B OPNEBC * * * RECURR PERF RDDS,CURSEC READ SCTR(S) CBNE DEBINW4,=W'30',BRETTA MOVE DEBINW4,W0 BRETTA B RETURN * * * GETTBL PERF SCHPOO,=C'T ',TABLE,W5 IB DEBIN4,GTF,LCK NOT IN POOL, READ GETT01 PERF WAIT BERR RETURN COPY STR2A,W0,W2,TABLE,W1 GET TABLE-NO MOVE BCD13A,STR2A MOVE DEBIN5,BCD13A CONVERT TO BINARY CBL DEBIN5,=W'95',DKTBL MOVE DEBINW4,W1 INDICATE ERROR B RETURN DKTBL PERF DISU,W1,W7,SYSBUF READ TABLE-PTR-REC BOK MUL CMP DEBINW4,=W'30' BNE RETURN MOVE DEBINW4,W0 TBF SWIT01,NOINSY MOVE SYSBUF,=X'544300' PERF DISU,W2,W7,SYSBUF BERR RETURN MUL MUL DEBIN5,W2 ADD DEBIN5,W10 XCOPY DEBIN1,W0,W2,SYSBUF,DEBIN5 CBNE DEBIN1,W0,DT002 TBF SWIT01,NOINSY PERF FREESP,DEBIN1,W1 BERR RETURN XCOPY SYSBUF,DEBIN5,W2,DEBIN1,W0 PERF DISU,W2,W7,SYSBUF BERR RETURN MOVE DEBIN4,DEBIN1 B ENTT01 DT002 TEST SWIT02 BNZ DELT01 RDN PERF DISU,W1,DEBIN1,SYSBUF BNOK RETURN MOVE DEBIN4,DEBIN1 MOVE DEBIN1,W0 XCOPY DEBIN1,W1,W1,SYSBUF,W9 LAST ELEMENT-NO CBNG ELMNO,DEBIN1,FNDTBL XCOPY DEBIN1,W0,W2,SYSBUF,W4 GET LINK NEXT CBG DEBIN1,W0,RDN READ NEXT RECORD TBF SWIT01,NOINSY JUMP IF NOT ENTER MOVE DEBIN2,W17 MATCH RPOOL(PINDTB),DEBIN2,W1,SYSBUF,W8,W1 BOK ENTT01 INSERT IN CURRENT SECTOR B ENTT03 INSERT NEW SECTOR NOINSY MOVE DEBINW4,W9 'NOT IN SYSTEM' B RETURN FNDTBL TEST SWIT01 BNZ ENTCOR MOVE DEBIN3,W1 MOVE DEBIN2,W1 PERF DEPOOL,W1,DEBIN3,DEBIN2,STRG10A BNOK RETURN COPY RPOOL(DEBIN3),W9,W10,SYSBUF,W0 COPY BPOOL(DEBIN3),W0,W188,SYSBUF,W10 GTF PERF DEPOOL,W4,DEBIN3,DEBIN2,STRG10A PERF DEPOOL,W6,PINDTB,DEBIN2,STRG10A RELEASE BUFFER MOVE PINDTB,DEBIN3 B RETURN LCK MOVE DEBINW4,W3 B RETURN * * * DUMMY RETURN TBF SWITFS,RETUNF PERF WRFSP,W1 RETUNF PERF RELEAS CBNE DEBINW4,W0,RETUN9 TBF SW95PR,RETUN9 MOVE DEBINW4,=W'-1' RETUN9 PERF COND RET PEND END