DataMuseum.dk

Presents historical artifacts from the history of:

Philips Data Systems

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Philips Data Systems

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦a19e128f6⟧

    Length: 10918 (0x2aa6)
    Notes: pts_type(SC)
    Names: »WRIT12.SC«

Derivation

└─⟦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« 

PTS(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

Full view