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

⟦29f4ed10b⟧ 

    Length: 11124 (0x2b74)
    Notes: pts_type(SC)
    Names: »DAUCCY.SC«

Derivation

└─⟦35fda6e03⟧ Bits:30009701 Philips computer tape "BARCLAY"
    └─⟦this⟧ »DEMO6800/DAUCCY.SC« 
└─⟦e276fd206⟧ Bits:30009696 Philips computer tape "600413"
    └─⟦this⟧ »DEMO6800/DAUCCY.SC« 
└─⟦f350e1b7a⟧ Bits:30009678 Philips computer tape "600219"
    └─⟦this⟧ »PTSDEMO/DAUCCY.SC«

PTS(SC)

         IDENT    DAUCCY                CURRENCY UPDATE 
	DDUM	DEMODD
	PDIV 
	EXPROC	ECICCY
         EXPROC   PAJRN 
	EXPROC	XBFMT 
 EXPROC ZCRDD 
	EXPROC	ZHWRID
	ENTRY	DAUCCY 
	ENTRY	EPPCCY 
         ENTRY    SPAP21
         ENTRY    SPAP23
         ENTRY    SPAP24
         ENTRY    SPAP25
	ENTRY	SPAP28 
	ENTRY	SPAP29 
************************************************************************
* 
* UPDATE CURRENCY 
* 
************************************************************************
DAUCCY	PROC 
DA000 
	CBNE	YDSTATUS,=D'1',DA100
	MOVE	SWCCY,=W'1' 
DA050 
 MOVE CDCCYRNR,SWCCY
 ADD CDCCYRNR,=D'10'
 MUL CDCCYRNR,KDSHIFT	SHIFT NUMBER
 PERF ZCRDD,CDCCYRNR,NDLRN1,KW1	READ CURRENCY RECORD
	TBT	SBCANCEL,DA999 
	TBT	SBRECAVB,DA100	CONTINUE
* 
* INITIALISE A NEW CURRENCY RECORD
* 
	PERF	ECICCY
DA100 
         CBE      YDSTATUS,=D'1',DA150
	SET	SBUCCY 
         PERF     PAJRN,=W'1' 
DA150 
 PERF XBFMT,=W'15'	INITIALISE CURRENCY
	TBT	SBCANCEL,DA999 
 MOVE YCCCY(SWCCY),CCCCYCDE	MOVE CURRENCY CODE TO CWB 
	PERF	ZHWRID,CDCCYRNR,NDLRN1	WRITE CURRENCY RECORD
	CBNE	YDSTATUS,=D'1',DA200
	ADD	SWCCY,=W'1'
	CBL	SWCCY,=W'4',DA050
	B	DA999
DA200 
* 
*  LOG UPDATES ON JOURNAL ROLL
* 
	PERF	EPPCCY
	ADD	YDLASSEQ,=D'1' 
	MOVE	TDTRSSEQ,YDLASSEQ 
DA999 
	CLEAR	SBUCCY 
         RET
 PEND 
**********************************************************************
* 
*  PRINT CURRENCY LINE TYPES (UPDATE AND INQUIRY) 
* 
**********************************************************************
EPPCCY	PROC		PRINT CURRENCY 
* 
*  LINE 5 
* 
         MOVE  ICTEXT2,CCCCYNME 
         PERF  PAJRN,=W'5'
* 
*  LINE 6: BUYING RATES 
* 
         MOVE  IDAMT1,CDBUY1
         MOVE  IDAMT2,CDBUY2
         PERF  PAJRN,=W'6'
* 
*  LINE 6: SELLING RATES
* 
         MOVE  IDAMT1,CDSEL1
         MOVE  IDAMT2,CDSEL2
         PERF  PAJRN,=W'6'
* 
*  LINE 4: CURRENCY CODE AND RELATION 
* 
         MOVE  ICTEXT3,YCCCY(SWCCY)  CURRENCY CODE
         MOVE  TDAMOUNT,CDRELAT 
         MUL   TDAMOUNT,KDSHIFT 
         PERF  PAJRN,=W'4'
* 
*  LINE 4: SYSTEM CURRENCY AND LIMIT RATE 
* 
         MOVE  ICTEXT3,YCCCY(KW4)      SYSTEM CURRENCY
         MOVE  TDAMOUNT,CDLIMIT        LIMIT RATE 
         PERF  PAJRN,=W'4'
         RET
 PEND 
************************************************************************
* 
*  VALUE  BETWEEN 1 AND 10000 
* 
********************************************************************* 
SPAP21	PROC	XWRET 
	PBIN	XWRET 
S21000
         CBL      CDRELAT,=D'1',S21500
         CBG      CDRELAT,=D'10000',S21500
         MOVE     XWRET,=W'0' 
         B        S21999
S21500
         MOVE     XWRET,=W'1' 
         MOVE     SPBINW4,=W'1'         'RANGE ERROR' 
S21999
         RET
         PEND 
********************************************************************* 
* 
*   IF VALUE 2 NOT ZERO, IT MUST BE GREATER THEN VALUE 1
* 
********************************************************************* 
SPAP23	PROC	XWRET 
	PBIN	XWRET 
S23000
         CBE      CDBUY2,=D'0',S23200 
         CBL      CDBUY1,CDBUY2,S23200
         MOVE     XWRET,=W'1' 
         MOVE     SPBINW4,=W'20'        'INVALID COMPARISION' 
         B        S23999
S23200
	CBG	CDBUY2,=D'0',S23500
	CBG	CDSEL2,=D'0',S23500
* 
*  BOTH RATES ARE ZERO, SET LIMIT RATE-2 TO ZERO
* 
	MOVE	CDLIMIT,=D'0' 
	B	S24800 
* 
*  AT LEAST ONE RATE IS UNEQUAL TO ZERO 
*  IF CDLIMIT = 0, ACTIVATE THE ME-OPTION FOR THIS
*  FIELD BY CLEARING CDLIMIT
* 
S23500
	CBG	CDLIMIT,=D'0',S23900 
	MOVE	CDLIMIT,=X'0F'	ACTIVATE THE ME0OPTION 
* 
*  REDISPLAY LIMIT RATE, IF SCREEN CONTAINS ENOUGH LINES
* 
S23800
	CBL	RDSCRLNS,=D'5',S23900
	ERASE	0,KW5,KW5
	DISPLAY	4,KW5,KW5
S23900
         MOVE     XWRET,=W'0' 
S23999
         RET
         PEND 
********************************************************************* 
* 
*  VALUE 2 MAY BE ZERO, OTHERWISE IT  MUST BE LESS THEN VALUE 1 
* 
********************************************************************* 
SPAP24	PROC	XWRET 
	PBIN	XWRET 
S24000
	CBE	CDSEL2,=D'0',S24200
         CBG      CDSEL1,CDSEL2,S24200
         MOVE     XWRET,=W'1' 
         MOVE     SPBINW4,=W'20'        'INVALID COMPARISION' 
         B        S24999
S24200
	CBG	CDBUY2,=D'0',S24500
	CBG	CDSEL2,=D'0',S24500
* 
*  BOTH RATES ARE ZERO, SET LIMIT RATE-2 TO ZERO
* 
	MOVE	CDLIMIT,=D'0' 
	B	S24800	REDISPLAY LIMIT 
* 
* AT LEAST ONE RATE IS UNEQUAL TO ZERO
* IF CDLIMIT = 0, ACTIVATE TH ME-OPTION FOR THIS
*  FIELD BY CLEARING CDLIMIT
* 
S24500
	CBG	CDLIMIT,=D'0',S24900 
	MOVE	CDLIMIT,=X'0F'	ACTIVATE ME-OPTION 
* 
*  REDISPLAY LIMIT RATE, IF SCREEN CONTAINS ENOUGH LINES
* 
S24800
	CBL	RDSCRLNS,=D'5',S24900
	ERASE	0,KW5,KW5
	DISPLAY	4,KW5,KW5
S24900
         MOVE     XWRET,=W'0' 
S24999
         RET
         PEND 
********************************************************************* 
* 
*  CHECK LIMIT RATE IF BOTH CDSEL2 AND CDBUY2 ARE EQUAL TO ZERO , 
*   CDLIMIT MUST CONTAIN ZERO , ELSE IT MUST CONTAIN ANY VALUE
*     GREATER THEN ZERO 
* 
********************************************************************* 
SPAP25	PROC	XWRET 
	PBIN	XWRET 
S25000
         CBE      CDBUY2,=D'0',S25100 
         B        S25200
S25100
         CBE      CDSEL2,=D'0',S25500 
* 
*  CDBUY2 OR CDSEL2 IS NOT EQUAL TO ZERO
* 
S25200
         CBG      CDLIMIT,=D'0',S25900
         MOVE     XWRET,=W'1' 
         MOVE     SPBINW4,=W'1'         'VALUE NOT IN RANGE'
         B        S25999
S25500
* 
*  BOTH CDBUY2 AND CDSEL2 ARE EQUAL TO ZERO 
* 
         CBE      CDLIMIT,=D'0',S25900
         MOVE     XWRET,=W'1' 
         MOVE     SPBINW4,=W'9' 
         B        S25999
S25900
         MOVE     XWRET,=W'0' 
S25999
         RET
         PEND 
************************************************************* 
*                                                           * 
*  CDBUY1 MUST BE GREATER THEN ZERO                         * 
*   IF A NEW VALUE IS ENTERED, ACTIVATE ME-OPTION FOR 
*   CDBUY2 AND REDISPLAY THE WHOLE LINE.                    * 
*                                                           * 
************************************************************* 
SPAP28	PROC	XWRET 
	PBIN	XWRET 
S28000
	CBG	CDBUY1,=D'0',S28200
	MOVE	SPBINW4,=W'1'	'VALUE NOT IN RANGE'
	MOVE	XWRET,=W'1' 
	B	S28999 
S28200
	MOVE	CDBUY2,=X'0F'	ACTIVATE ME-OPTION
	CBL	RDSCRLNS,=D'3',S28900
	ERASE	0,KW3,KW3
	DISPLAY	4,KW3,KW3
S28900
	MOVE	XWRET,=W'0' 
S28999
	RET
	PEND 
*********************************************************** 
*                                                         * 
* CDSEL1 MUST BE GREATER THEN ZERO                        * 
*  IF A NEW VALUE IS ENTERED, ACTIVATE ME-OPTION FOR     *
*  CDSEL2 AND REDISPLAY THE WHOLE LINE                    * 
*                                                         * 
*********************************************************** 
SPAP29	PROC	XWRET 
	PBIN	XWRET 
S29000
	CBG	CDSEL1,=D'0',S29200
	MOVE	SPBINW4,=W'1'	'VALUE NOT IN RANGE'
	MOVE	XWRET,=W'1' 
	B	S29999 
S29200
	MOVE	CDSEL2,=X'0F'	ACTIVATE ME-OPTION
	CBL	RDSCRLNS,=D'4',S29900
	ERASE	0,KW4,KW4
	DISPLAY	4,KW4,KW4
S29900
	MOVE	XWRET,=W'0' 
S29999
	RET
	PEND 
********************************************************************* 
	END

Full view