|
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: 10962 (0x2ad2)
Notes: pts_type(SC)
Names: »ZMRDF.SC«
└─⟦f350e1b7a⟧ Bits:30009678 Philips computer tape "600219"
└─⟦this⟧ »PTSDEMO/ZMRDF.SC«
IDENT ZMRDF SCREEN I/O DDUM DEMODD PDIV ENTRY ZMRDF EXPROC MASK ************************************************************************ ** * PROCEDURE-NAME :* * ZMRDF* * FUNCTIONAL DESCRIPTION :* * THE PROCEDURE READS A FORMAT FROM THE FORMAT-FILE* * THERE ARE MESSAGE-FORMATS ( MAXIMUM LENGTH 397 BYTES)* * AND NORMAL FORMATS ( MAXIMUM LENGTH 794 BYTES )* * A MESSAGE-FORMAT MUST BE PLACED IN FCBUFFER , WHILE* * FCFMTBUF AND FCFORMAT MAY NOT BE USED* * A NORMAL FORMAT MUST BE PLACED IN FCFORMAT* * AS A RECORD OF THE FORMAT-FILE IS ONLY 400 BYTES IN* * LENGTH , FOR A NORMAL FORMAT IT COULD BE NECESSARY TO* * READ TWO RECORDS OF THE FORMAT-FILE* ** * FIRST THE PROCEDURE TRIES TO READ A RECORD IN THE* * DESIRED LANGUAGE , IF NOT OK THE PROCEDURE TRIES* * TO READ A RECORD IN THE FIRST LANGUAGE ( LANGUGE-* * NUMBER = 0 ) , IF NOT OK AN ERROR-MESSAGE WILL BE* * DISPLAYED AND ABEND OCCURS* * IF READING OF THE SECOND RECORD OF A FORMAT IS NOT OK* * AN ERROR-MESSAGE WILL BE DISPLAYED AND ABEND OCCURS* * PARAMETERS :* * XWFMTNR : RELATIVE FORMAT NUMBER (INPUT )* * XWMSG : MESSAGE-FLAG ( INPUT )* * 0 = NORMAL FORMAT , 1 = MESSAGE-FORMAT* * USE OF VARIABLES :* * NONE* * WORKVARIABLES :* * WWCOUNT : RELATIVE RECORD NUMBER* * WW2 : AMOUNT OF BYTES TO BE MOVED ,* * POINTER IN XCOPY-STATEMENTS* ************************************************************************ ZMRDF PROC XWFMTNR,XWMSG PBIN XWFMTNR,XWMSG ZM000 MOVE WWCOUNT,NDTRMLGG CBL WWCOUNT,KW4,ZM050 MOVE WWCOUNT,KW0 ZM050 MUL WWCOUNT,KWNRFMT ) COMPUTE RELATIVE-RECORD-NR ADD WWCOUNT,XWFMTNR ) MOVE WWINDEX2,=X'8800' * USED IN CALL MASK - INSTRUCTIONS, TEST FOR 'NO DATA' CBE XWMSG,KW1,ZM500 MESSAGE FORMAT ZM100 MOVE WW2,KWFMTLNG * READ FORMAT-RECORD IN DESIRED LANGUAGE MOVE WDEC1,WWCOUNT RECNR TO BCD READ .DIR,DSFMTFLE,FCFMTBUF,WW2,WDEC1 BE ZM200 XSTAT DSFMTFLE,WWINDEX1 CALL MASK,WWINDEX1,WWINDEX2 BOK ZM200 MOVE WDEC1,XWFMTNR MOVE WW2,KWFMTLNG * READ DEFAULT FORMAT-RECORD (LANGUAGE-NR = 0 ) READ .DIR,DSFMTFLE,FCFMTBUF,WW2,WDEC1 XSTAT DSFMTFLE,WWINDEX1 CALL MASK,WWINDEX1,WWINDEX2 BNOK ZM900 ZM200 MOVE WW2,KWFMTLNG SUB WW2,KW2 XCOPY FCFORMAT,KW0,WW2,FCFMTBUF,KW0 CBE WWCOUNT,KW1,ZM999 * ( FIRST FORMAT-RECORD CONTAINS FIRST FREE OVERFLOWRECORDNUMBER ) XCOPY WWCOUNT,KW0,KW2,FCFMTBUF,WW2 CBE WWCOUNT,KW0,ZM999 CHECK IF FORMAT IS CONTAINED * IN A SINGLE RECORD* MOVE WW2,KWFMTLNG MOVE WDEC1,WWCOUNT RECNR TO BCD READ .DIR,DSFMTFLE,FCFMTBUF,WW2,WDEC1 XSTAT DSFMTFLE,WWINDEX1 CALL MASK,WWINDEX1,WWINDEX2 BNOK ZM900 MOVE WW2,KWFMTLNG SUB WW2,KW2 XCOPY FCFORMAT,WW2,WW2,FCFMTBUF,KW0 XCOPY WWCOUNT,KW0,KW2,FCFMTBUF,WW2 CBE WWCOUNT,KW0,ZM999 MOVE WW2,KWFMTLNG MOVE WDEC1,WWCOUNT RECNR TO BCD READ .DIR,DSFMTFLE,FCFMTBUF,WW2,WDEC1 XSTAT DSFMTFLE,WWINDEX1 CALL MASK,WWINDEX1,WWINDEX2 BNOK ZM900 MOVE WW2,KWFMTLNG SUB WW2,KW2 MOVE SPBINW1,WW2 ADD SPBINW1,WW2 XCOPY FCFORMAT,SPBINW1,WW2,FCFMTBUF,KW0 B ZM999 ZM500 * READ MESSAGE-FORMAT* MOVE WW2,KWFMTLNG MOVE WDEC1,WWCOUNT RECNR TO BCD READ .DIR,DSFMTFLE,FCBUFFER,WW2,WDEC1 XSTAT DSFMTFLE,WWINDEX1 CALL MASK,WWINDEX1,WWINDEX2 BOK ZM600 MOVE WDEC1,XWFMTNR MOVE WW2,KWFMTLNG READ .DIR,DSFMTFLE,FCBUFFER,WW2,WDEC1 XSTAT DSFMTFLE,WWINDEX1 CALL MASK,WWINDEX1,WWINDEX2 BNOK ZM900 ZM600 MOVE WW2,KWFMTLNG SUB WW2,KW2 XCOPY WWCOUNT,KW0,KW2,FCBUFFER,WW2 * OVERFLOW RECORDNUMBER CBE WWCOUNT,KW0,ZM999 MOVE WW2,KWFMTLNG MOVE WDEC1,WWCOUNT READ .DIR,DSFMTFLE,FCFMTBUF,WW2,WDEC1 BNOK ZM900 MOVE WW2,KWFMTLNG SUB WW2,KW2 MOVE WWCOUNT,=W'146' XCOPY FCBUFFER,WW2,WWCOUNT,FCFMTBUF,KW0 B ZM999 ZM900 EDWRT SPDSSCRN,FMTA WRITE ERROR-MESSAGE SET SBCANCEL ABEND ZM999 RET PEND FMTA FRMT FSL FTEXT 'FAILURE ON FORMAT-FILE-DISK' FNL FTEXT 'FUNCTION ABENDED BY ZMRDF' FMEND END