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

⟦9861496a8⟧ 

    Length: 10862 (0x2a6e)
    Notes: pts_type(SC)
    Names: »DBUOPR.SC«

Derivation

└─⟦f350e1b7a⟧ Bits:30009678 Philips computer tape "600219"
    └─⟦this⟧ »PTSDEMO/DBUOPR.SC«

PTS(SC)

         IDENT    DBUOPR                UPDATE OPERATOR 
	DDUM	DEMODD
	PDIV 
	EXPROC	EAIOPR
	EXPROC	EBZACC
	EXPROC	QEMOVE
	EXPROC	XBFMT 
	EXPROC	XEERR 
 EXPROC ZCRDD 
	EXPROC	ZDRWRD
	EXPROC	ZGREA 
	EXPROC	ZHWRID
	EXPROC	ZYRLNG
	EXPROC	MASK
	ENTRY	DBUOPR 
	ENTRY	SPAP06 
************************************************************************
* 
* UPDATE OPERATOR 
* 
************************************************************************
DBUOPR	PROC				
DB000					
	CBNE	YDSTATUS,=D'1',DB200			 
* *
* SYSTEM START PROGRESSING,*
*    READ ALL OPERATOR RECORDS AND RESET STATUS TO*
*    'OPERATOR NOT IN USE'*
* 
* START SEARCHING OF OPERATOR RECORDS BY READING THE SYSTEM RECORD
* AND THEN CONTINUE BY INDEXED READ NEXT. 
* 
	MOVE	ODOPRRNR,=D'1'
	MUL	ODOPRRNR,KDSHIFT	SYSTEM RECORD KEY 
	SET	SBNOCOPY	DON'T COPY RECORD TO UWB
	PERF	ZCRDD,ODOPRRNR,NDLRN1,KW1 
	TBT	SBCANCEL,DB900 
* 
* NOW SET NWRECLNG TO THE LENGTH OF AN OPERATOR RECORD
* 
	MOVE	ODOPRRNR,=D'10001'	ARBITRARY OPERATOR NUMBER
	MUL	ODOPRRNR,KDSHIFT	RECORD KEY
	PERF	ZYRLNG,ODOPRRNR	RECORD LENGTH IN NWRECLNG 
* 
* READ NEXT RECORD IN THE DATABASE AND CHECK WHETHER OR NOT IT IS 
* AN OPERATOR RECORD
* 
DB100 
	PERF	ZGREA	RELEASE EXCL ACCES
	MOVE	WW1,=W'127'	SET REQUESTED LENGTH		
	READ	.IXSEQ,DSDBS,FCBUFFER,WW1,KW1 
	BOK	DB110
	XSTAT	DSDBS,NWXSTAT
	MOVE	WW1,=X'1400'	EOF / KEY NOT FOUND
	CALL	MASK,NWXSTAT,WW1	CHECK BITS 
	BNOK	DB200	EOF / KEY NOT FOUND --> READY 
* DISK ERROR FOUND
	PERF	XEERR,=W'6',KW1	DISK ERROR
	B	DB900
* 
* COPY THE RECORD TO UWB: UOP. THE OPERATOR RECORD LENGTH IS IN NWRECLNG
* 
DB110 
	CALL	QEMOVE,ODOPRRNR,FCBUFFER,NWRECLNG 
	MOVE	IDNR1,ODOPRRNR
	DIV	IDNR1,KDSHIFT	TO GET OPERATOR NUMBER 
	CBL	IDNR1,=D'10001',DB100	TRY NEXT RECORD
	CBG	IDNR1,=D'19999',DB200	READY
* 
* NUMBER IS IN THE RANGE [10001,19999], 
* SO AN OPERATOR RECORD HAS BEEN FOUND, 
* SAVE LOGICAL RECORD NUMBER, UPDATE STATUS AND REWRITE RECORD
* 
	MOVE	ODSTATUS,=D'0'			
	PERF	ZDRWRD,ODOPRRNR,NDLRN1			
	TBT	SBCANCEL,DB900			
* 
*    TO CONTINUE READ IXSEQ FIRST A READ IXDIR
*    MUST BE DONE 
* 
	READ	.IXDIR,DSDBS,FCBUFFER,NWRECLNG,KW1
	B	DB100
* READ THE NEXT OPERATOR RECORD*
* BECAUSE IRWRITE RESETS THE CURRENT RECORD NUMBER OF THE 
* INDEX-FILE TO ZERO, (AT LEAST IN RELEASE 3.2) 
* THE RECORD JUST REWRITTEN MUST BE READ AGAIN
	PERF	ZCRDD,ODOPRRNR,NDLRN1,KW1 
	TBT	SBCANCEL,DB900 
	B	DB100
* *
* UPDATE OPERATOR RECORDS DONE*
* *
DB200					
	MOVE	IDNR1,=X'FF'
	PERF	XBFMT,=W'16'	GET OPERATOR NUMBER		
	TBT	SBCANCEL,DB900			
**
* CHECKS HAVE BEEN PERFORMED AS FOLLOWS:*
*   IDNR1 CAN ONLY BE ZERO IF YDSTATUS = 1 (EXIT FROM OPERATOR INIT). 
*   IF IDNR1 IS NOT ZERO THEN IDNR1 IS IN RANGE [10001,19999] 
*      AND THE OPERATOR RECORD HAS BEEN READ OR A NEW OPERATOR
*      RECORD HAS BEEN INITIALISED IN THE UWB 
**
	CBE	IDNR1,=D'0',DB999	EXIT FROM OPERATOR INIT
DB300					
* 
* DISPLAY OPERATOR SPECIFICATION*
* 
	MOVE	IDNR1,=D'0'	INIT ZEROISE ACCUM. FIELD 
	PERF	XBFMT,=W'17'	OPERATOR SPECIFICATION		
	TBT	SBCANCEL,DB900			
	CBE	IDNR1,=D'1',DB400	ZEROISE ACCUMULATORS		
**
* DISPLAY OPERATOR ACCUMULATORS*
**
	PERF	XBFMT,=W'18'	OPERATOR ACCUMULATORS		
	TBT	SBCANCEL,DB900			
	B	DB500			
**
* ZEROISE ACCUMULATORS*
**
DB400					
	PERF	EBZACC			
DB500					
	MOVE	ODSTATUS,=D'1'	OPERATOR INITIALISED		
	PERF	ZHWRID,ODOPRRNR,NDLRN1	WRITE OPERATOR RECORD
	CBE	YDSTATUS,=D'1',DB200	NEXT OPERATOR IF SYSTEM START 
DB900					
DB999					
	RET				
	PEND				
************************************************************************
**
* CHECK OPERATOR IDENTIFICATION IN OPERATOR UPDATE*
**
************************************************************************
SPAP06	PROC	XWRET 
	PBIN	XWRET 
S06000					 
	MUL	IDNR1,=D'1'	REPRESENT ZERO UNIQUELY
	CBNE	IDNR1,=D'0',S06050
	CBE	YDSTATUS,=D'1',S06990	SYSTEM START EXIT
S06050
	CBL	IDNR1,=D'10001',S06400	RANGE ERROR		 
	CBG	IDNR1,=D'19999',S06400	RANGE ERROR		 
**
* OPERATOR IDENTIFICATION IS IN THE RIGHT RANGE*
**
	MOVE	ODOPRRNR,IDNR1	SAVE OPERATOR NUMBER 
	MUL	ODOPRRNR,KDSHIFT	SHIFT TO GET RECORDNUMBER

Full view