|
|
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: 10918 (0x2aa6)
Notes: pts_type(SC)
Names: »WRIT12.SC«
└─⟦48601905a⟧ Bits:30009668 Philips computer tape "600121"
└─⟦this⟧ »S:DU/WRIT12.SC«
└─⟦79fbed147⟧ Bits:30009697 Philips computer tape "600414"
└─⟦this⟧ »S:DU/WRIT12.SC«
└─⟦d2a299635⟧ Bits:30009698 Philips computer tape "600415"
└─⟦this⟧ »S:DU/WRIT12.SC«
IDENT WRIT12 UPD 80-03-10/CHST *************************************** * * * WRITES RECORD 1 AND * * FREE-SPACE RECORDS * * ON SYSTEM- AND USER-FILES * * * * BIN1 = WORKITEM * * BIN2 = NO.OF RECORDS * * BIN3 = NO.OF FREE RECORDS * * BIN4 = NO.OF FREE-SPACE REC. * * BIN5 = NO.OF FS.IN LAST REC. * * BIN6 = INDEX * * BIN7 = NO.OF USED RECORDS * * BIN8 = CONTER TO MATCH - FS-IND * * BIN9 = WORKITEM - FREE-SPACE IND. * * BIN10 = COUNTER IN BIN9 * * BIN11 = NO.OF SECTORS/RECORD * * BIN12 = SIZE OF SECTORS * * * *************************************** * * IF THE CREATED FILE IS A SYSTEM FILE THEN * THERE ARE WRITTEN 4 INITIAL RECORD MORE *RECORD 3 CALLED JD, JOB DEF * 4 FC, FORMAT CHAIN * 5 SV, SYSTEM VARIABLES * 7 TC, VALUE SETS * * IF THE CREATED FILE IS A USERFILE * THEN IT IS NESESARY TO INITIATE * RECORD 3,THE BEGINNING OF THE JOB CHAIN *RECORD 3 CALLED JC, JOB CHAIN * DDUM DDINIT PDIV ENTRY REC1 ENTRY REC2 ENTRY RECSYS * EXT DSKERR EXT SETB EXT WRITDK EJECT REC1 PROC ********************** * WRITE 1:ST RECORD * ********************** MOVE RBUF,=X'00' MOVE RECNUM,W1 RECORD NO MOVE BIN1,W0 MOVE BIN2,NOREC XCOPY RBUF,W0,W1,BIN1,W0 FILE OPEN/CLOSED XCOPY RBUF,W1,W2,BIN2,W0 NO.OF RECORDS IN FILE MOVE BIN3,NOREC MUL BIN3,BIN11 ADD BIN7,W1 ADD BIN7,BIN11 CBNE FTYPE,=D'1',RE10 IF NOT SYSTEMFILE ADD BIN7,W5 RE10 SUB BIN3,BIN7 - NO. OF USED RECORDS DIV BIN3,BIN11 XCOPY RBUF,W3,W2,BIN3,W0 NO. OF FREE RECORDS MOVE ACK(W1),NOREC CALC 5% OF MUL ACK(W1),=D'5' NO. OF RECORDS DIV ACK(W1),=D'100' MOVE BIN4,ACK(W1) XCOPY RBUF,W5,W2,BIN4,W0 * XCOPY RBUF,W7,W2,BIN11,W0 NO.OF SECTORS/RECORD XCOPY RBUF,W9,W2,SECLEN,W0 SECTOR LENGTH * CALL WRITDK,DISK,FILECODE(W1),RBUF,SECLEN,RECNUM BERR ERROR RET PEND EJECT REC2 PROC ************************ * FREE-SPACE RECORDS * ************************ MOVE BIN7,W0 NO. OF USED RECORDS MOVE FS,=C'FS' MOVE LPREV,W0 LINK PREV. MOVE LNEXT,W0 LINK NEXT MOVE BIN2,NOREC MOVE BIN3,=W'1496' CBE FTYPE,=D'2',F10 IF USERFILE SUB BIN2,W8 SYSTEMFILE MOVE BIN11,W1 NO.OF SECTORS/RECORD B F20 F10 * *** USERFILE *** MOVE BIN11,BLFACT NO.OF SECTORS/RECORD MUL BIN2,BIN11 NO.OF SECTORS IN FILE SUB BIN2,W2 SUB BIN2,BIN11 DIV BIN3,BIN11 CALC.NO.OF FREE SPACE MUL BIN3,BIN11 INDICATIONS IN EACH FREE SPACR REC *********************************** * FREE RECORD INDICATION * * MAX. 187 X 8 = 1496 PER RECORD * CALCULATE NO. OF RECORDS (BIN4) * FOR FREE-RECORD INDICATION *********************************** F20 MOVE BIN4,W0 MOVE BIN5,W0 F25 ADD BIN4,W1 NO.OF FREE-SPACE RECORDS SUB BIN2,W1 SUB BIN2,BIN3 CBG BIN2,BIN11,F25 CHECK IF SPACE FOR 1 FS-REC * AND RECORDS CBNL BIN2,W0,F32 BZ F32 ADD BIN2,BIN3 ADD BIN2,W1 MOVE BIN5,BIN2 DIV BIN5,BIN11 * ********************************************* * BIN5 = NO. OF FREE-RECORD-IND. * IN LAST FREE-SPACE RECORD * * PREPARE RECORD 2 (1:ST FREE-SPACE REC) ********************************************* F32 MOVE FRSTNO,BIN4 1:ST RECORD NO. CBE FTYPE,=D'2',F34 IF USERFILE ADD FRSTNO,W8 B F35 F34 ADD FRSTNO,W2 RECORD 1+2 ADD FRSTNO,BIN11 F35 CBE BIN4,W1,F37 ONLY 1 RECORD MOVE LNEXT,W4 LINK NEXT CBE FTYPE,=D'2',F36 IF USERFILE MOVE LNEXT,W9 B F37 F36 * *** USERFILE *** ADD LNEXT,BIN11 SUB LNEXT,W1 F37 MOVE NOFREE,BIN3 NO. OF FREE = 1496 DIV NOFREE,BIN11 CBNE BIN4,W1,F40 MOVE NOFREE,BIN5 IF LAST RECORD F40 MOVE RECNUM,W2 EJECT F50 ***************************************************** * FILL RECORD WITH FREE-SPACE-INDICATIONS : 1=FREE * ***************************************************** MOVE BIN1,NOFREE MOVE BIN6,W0 INDEX MOVE BIN8,W0 COUNTER TO MATCH - FS-IND. MOVE NOOCCB,W12 NO. OF OCCUPIED BYTES * F55 ADD NOOCCB,W1 1 BYTE / 8 RECORDS ADD BIN6,W1 CBE FTYPE,=D'2',F60 **************** * SYSTEMFILE * **************** SUB BIN1,W8 8 RECORDS BN F57 MOVE FF(BIN6),=X'FF' CBE BIN1,W0,F70 B F55 F57 ADD BIN1,W8 MOVE FF(BIN6),HEXTAB(BIN1) B F70 ************** * USERFILE * ************** F60 MOVE BIN9,W0 WORKITEM - FREE-SPACE MOVE BIN10,W0 COUNTER IN BIN9 F62 ADD BIN8,W1 CBNE BIN8,W1,F63 CBE BIN1,W0,F63 CALL SETB,BIN9,BIN10 BIN10:POS.0-7 SUB BIN1,W1 F63 ADD BIN10,W1 CBNE BIN8,BIN11,F64 MOVE BIN8,W0 F64 CBNE BIN10,W8,F62 XCOPY FF(BIN6),W0,W1,BIN9,W0 CBE BIN1,W0,F70 B F55 * F70 ADD BIN6,W1 CBG BIN6,=W'187',F80 MOVE FF(BIN6),=X'00' B F70 ****************************** * WRITE FREE-SPACE RECORDS * ****************************** F80 CALL WRITDK,DISK,FILECODE(W1),RBUF,SECLEN,RECNUM BERR ERROR ADD BIN7,W1 NO. OF USED RECORDS SUB BIN4,W1 BZ F99 IF LAST RECORD * ADD FRSTNO,BIN3 MOVE LPREV,RECNUM MOVE RECNUM,LNEXT ADD LNEXT,W1 CBNE BIN4,W1,F90 MOVE LNEXT,W0 LAST RECORD CBE BIN5,W0,F90 MOVE NOFREE,BIN5 F90 B F50 F99 RET PEND * * ERROR PERF DSKERR,W3 'I/O-ERROR' B F99 *********************************************** * * WRITE RECORDS NEADED IF THE CREATED FILE * IS A SYSTEM FILE * OR A USERFILE RECSYS MOVE RBUF,=X'00' XCOPY RBUF,W6,W2,W10,W0 MOVE BIN1,W1 CBNE FTYPE,=D'2',RECJD BRANCH IF SYSFIL * * USERFILE * JOB CHAIN * REC 3 * WORD 1 'JC' * 4 10 NO OF USED BYTES IN THIS FILE * MOVE RECNUM,W3 MOVE BIN6,=X'4A43' 'JC' MOVE BIN1,W10 WRITE ONLY THIS REC B RECWR * * JOB DEF * REC 3 * WORD 1 'JD' * 4 10 NO OF USED BYTES IN THIS RECORD * RECJD MOVE RECNUM,W3 MOVE BIN6,=X'4A44' ADD BIN1,W1 B RECWR * * FORMAT CHAIN * REC 4 * WORD 1 'FC' * 4 10 NO OF USED BYTES IN THIS RECORD RECFC MOVE RECNUM,W4 MOVE BIN6,=X'4643' ADD BIN1,W1 B RECWR * * SYSTEM VARIABLES * REC 5 * WORD 1 'SV' * 4 10 NO OF USED BYTES IN THIS RECORD RECSV MOVE RECNUM,W5 MOVE BIN6,=X'5356' ADD BIN1,W1 B RECWR * * VALUE SETS * REC 7 * WORD 1 'SV' * 4 10 NO OF USED BYTES IN THIS RECORD RECTC MOVE RECNUM,W7 MOVE BIN6,=X'5443' ADD BIN1,W1 * WRITE THE CREATED RECORD TO DISC RECWR XCOPY RBUF,W0,W2,BIN6,W0 CALL WRITDK,DISK,FILECODE(W1),RBUF,SECLEN,RECNUM BERR ERROR IB BIN1,RECJD,RECFC,RECSV,RECTC B F99 * * END