DataMuseum.dk

top - metrics - download

    Length: 4424 (0x1148)
    Notes: pts_type(SC)
    Names: »STROUT.SC«

└─⟦173d42e04⟧ Bits:30009663 Philips computer tape "600105"
    └─⟦this⟧ »SCREEN/STROUT.SC« 

PTS(SC)

	IDENT STROUT	REL=10.0,800314,870138041000
********************************************************************
* 
*    DISPLAY MANAGEMENT IN CREDIT 
* 
*    RUNNING UNDER CREDIT 10.0
*                  TOSS 10.0
* 
********************************************************************
* 
*   STANDARD ROUTINE 'S T R O U T'
* 
*   OUTPUT TO A STRING FROM THE VARIABLE FIELDS OF A COMPLETE OR
*   A PART OF A DISPLAY FORMAT
* 
*   PARAMETERS: 
*   <TYPE>               BINARY ITEM HOLDING FIELD TYPE 0=FKI 1=FINP 2=F
*   <OUTPUT STRING>      THE OUTPUT STRING
*   <OUTPUT START>       BINARY ITEM HOLDING START POSITION IN OUTPUT ST
*                        FIRST POSITION COUNT 0 
*                        AT RETURN <OUTPUT START> POINTS WHERE MOVE WAS 
*   <UNIT SEPARATOR>     STRING THAT HOLDS A CHARACTER WHICH SEPARATES E
*                        FIELD IN THE OUTPUT STRING 
*   <INDEX1>             BINARY ITEM HOLDING THE FIRST VARIABLE FIELD IN
*                        MUST NOT BE 0
*                        AT RETURN <INDEX1> HOLDS THE FIELD INDEX TO
*                        THE LAST MOVED FIELD 
*   <INDEX2>             BINARY ITEM HOLDING THE LAST VARIABLE FIELD IND
*                        MUST NOT BE 0
*   <RETURN CODE>        BINARY ITEM HOLDING RETURN CODE FROM STROUT
*                        0=OK 3=ERROR 
***************************************************************** 
 DDUM SPDDIV
 PDIV 
 ENTRY STROUT OUTPUT FROM FORMAT TO STRING
* 
 EXT STROU1 MOVE TO OUTPUT STRING 
* 
*   DESCRIPTION OF ROUTINE STROU1*
************************************************************
* 
*   ROUTINE FOR TRANSFER OF DATA FROM THE CURRENT FIELD INDICATED IN
*   FCB TO A OUTPUT STRING
* 
*   CALLED FORM CREDIT STANDARD MODULE 'S T R O U T'
* 
*   A CHECK THAT OUTPUT STRING IS LARGE ENOUGH IS PERFORMED FIRST.
*   MOVE ROUTINE T:DUPX USED BY T:DUPL FUNCTION IS USED, NOT NEEDED 
*   BYTES IN OUTPUT STRING ARE FILLED WITH X'00'
*   THE UNIT SEPARATOR IS PLACED IN THE FIRST POSITION AFTER CURRENT
*   FIELD IN OUTPUT STRING. 
* 
*   CALL STROU1,<OUTPUT STRING>,<OUTPUT START>,<UNIT SEPARATOR> 
*   WHERE 
*   <OUTPUT STRING>    STRING TO HOLD OUTPUT
*   <OUTPUT START>     BINARY ITEM WITH START POSITION WITHIN 
*                      <OUTPUT STRING> FIRST POSITION COUNT 0 
*                      AT RETURN OUTPUT START POINTS WHERE MOVE ENDED 
*   <UNIT SEPARATOR>   STRING TO HOLD A CHARACTER THAT SEPARATES
*                      THE FIELDS IN <OUTPUT STRING>
* 
************************************************************
	EJECT
* 
STROUT PROC TYPE,OUTSTR,OUTSTA,OUTUS,INDEX1,INDEX2,RETCOD 
	PBIN	TYPE,OUTSTA,INDEX1,INDEX2,RETCOD
	PSTRG	OUTSTR,OUTUS 
* 
 CBL INDEX2,INDEX1,SOUERR 
SOU010
 IB TYPE,SOU100,SOU200
 GETFLD 0,INDEX1,RETCOD ONLY FKI FIELDS 
 B SOU300 
SOU100
 GETFLD 1,INDEX1,RETCOD ONLY FINP FIELDS
 B SOU300 
SOU200
 GETFLD 2,INDEX1,RETCOD BOTH FKI AND FINP FIELDS
SOU300
 BZ SOU350 FIELD FOUND
 BOFL SOU350 FIELD FOUND BUT EMPTY
			COMPULSORY FIELD EARLIER 
SOUERR
 MOVE RETCOD,=W'3' RETURN ERROR CODE 3
 B SOURET 
 EJECT
* 
*   PERFORM MOVE TO OUTPUT STRING FROM CURRENT VARIABLE FIELD 
* 
SOU350
 CALL STROU1,OUTSTR,OUTSTA,OUTUS
 BNZ SOUERR MOVE NOT OK 
 CBNL INDEX1,INDEX2,SOU400
 ADD INDEX1,=W'1' 
 SWITCH 
 B SOU010 
SOU400
 MOVE RETCOD,=W'0'
SOURET RET
 PEND 
	END