|
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: 11200 (0x2bc0)
Notes: pts_type(SC)
Names: »FORMAT.SC«
└─⟦35fda6e03⟧ Bits:30009701 Philips computer tape "BARCLAY"
└─⟦this⟧ »HJFORMAT/FORMAT.SC«
IDENT FORMAT
************************************************************************
* FUNCTIONAL DESCRIPTION : *
* BUILDING 100 FORMATS OF THE FORMAT-FILE IN A *
* LANGUAGE ; EACH FORMAT HAS A LENGTH OF 1 RECORD *
* MINIMAL ( 253 BYTES ) AND 2 RECORDS MAXIMAL *
* A MAXIMUM OF 4 LANGUAGES IS ALLOWED *
* THE 100 FORMATS ARE GROUPED TOGETHER IN A FORMAT- *
* TABEL AND HAVE THE NAMES FMT01 - - - FMT100 *
* IF ANOTHER LANGUAGE IS WANTED , TRANSLATE THE *
* TEXT IN THE FTEXT-STATEMENTS OF THE 100 FORMATS IN*
* THE DESIRED LANGUAGE AND EXECUTE THIS MODULE. *
* AFTER CREATION OF A ( EMPTY ) FORMAT-FILE , THE *
* FIRST LANGUAGE-NUMBER ( AFTER EXECUTING THIS MODULE
* WILL BE O (ZERO) ; THE LANGUAGE NUMBER OF THE OTHER
* 3 HAVE TO BE 1 OR 2 OR 3 IN ANY ORDER *
* THIS FORMAT-FILE WILL BE USED BY PROGRAM 'DEMODD' *
* IF A FORMAT-RECORD CONTAINS MORE BYTES THAN A *
* RECORD , THE REMAINING PART OF THE FORMAT- *
* RECORD IS WRITTEN ON THE FIRST FREE OVERFLOW-*
* RECORD ; THE RELATIVE RECORD-NUMBER OF THE *
* OVERFLOW-RECORD WILL BE WRITTEN IN THE LAST *
* TWO BYTES OF THE CONCERNING FORMAT-RECORD *
* PROCEDURES USED : BALGG (LOOKS FOR A FREE LANGUAGE-NUMBER ) *
* ZKOPNF ( OPENS FORMAT-FILE ) *
* ZLCLSF ( CLOSES FORMAT-FILE ) *
************************************************************************
DDUM DEMODD
PDIV
************************************************************************
* FUNCTIONAL DESCRIPTION *
* MAIN PROCEDURE , RULES THIS MODULE *
* INITIALIZATION *
* ASKS VOLUME-NUMBER OF FORMAT-FILE *
* READS FIRST RECORD OF FORMAT-FILE *
* IF NOT O.K. :-LANGUAGE-NUMBER WILL BE ZERO *
* -FIRST FREE OVERFLOW-RECORD *
* WILL BE TOTAL AMOUNT OF LANG *
* UAGES X TOTAL AMOUNT OF FORMATS*
* +1 ( IN THIS CASE 4X100+1=401 *
* IF O.K. :-LAST TWO BYTES CONTAIN THE
* FIRST FREE OVERFLOW-RECORDNR. *
* -ASKS LANGUAGE-NUMBER *
* WRITES FORMATS ON FORMAT-FILE ; THE RELATIVE *
* RECORDNUMBER OF A FORMAT ON THE FORMAT-FILE *
* WILL BE : LANGUAGE-NUMBER X TOTAL AMOUNT OF *
* FORMATS IN THE FORMAT-TABLE + FORMAT-NUMBER *
* ( IF E.G. LANGUAGE-NUMBER = 3 AND *
* FORMAT-NUMBER = 17 , THE RELATIVE RECORD- *
* NUMBER WILL BE 3X100 + 17 = 317 ) *
************************************************************************
EXPROC ZKOPNF
EXPROC ZLCLSF
EXPROC FMOVE
EXPROC MASK
ENTRY AAMAIN
KTB KTAB X'FF',X'90',X'92'
EJECT
AAMAIN
AA000
DSC0 SPDSDYKB,02 CLEAR BUFFER
EDWRT SPDSSCRN,FMTI
EDWRT SPDSSCRN,FMTF
MOVE KWCONT,=W'6'
KI SPDSDYKB,WCSTRG6,KTB,KWCONT,KWSPCONT
CBNE KWSPCONT,KW3,AA000
CBG YDSTATUS,=D'0',AA000
AA100
MOVE YDSTATUS,=D'1'
MOVE WW2,KDMAXLGG )
MUL WW2,KWNRFMT ) COMPUTE FIRST OVERFLOW-REC
ADD WW2,KW1
AA200
EDWRT SPDSSCRN,FMTI
EDWRT SPDSSCRN,FMTA ASK VOLUME-NAME
DSC0 SPDSDYKB,02
MOVE KWCONT,KW3
NKI SPDSDYKB,VCVOLNR2,KTB,KWCONT,KWSPCONT
CBNE KWCONT,KW3,AA200
USE UBF,KW1 ACCESS USERWORKBLOCK
PERF ZKOPNF
BNOK AA900
MOVE NWTOTBYT,KWFMTLNG
SUB NWTOTBYT,KW2
MOVE KWCONT,KWFMTLNG
READ .DIR,DSFMTFLE,FCFMTBUF,KWCONT,KD1
XSTAT DSFMTFLE,WW1
MOVE WWINDEX1,=X'8800' NO DATA
CALL MASK,WW1,WWINDEX1
BNOK AA400
AA300
COMMIT NWXSTAT
XCOPY WW2,KW0,KW2,FCFMTBUF,NWTOTBYT FIRST FREE OVERFLOW-RECORD
PERF BALGG
AA400
MOVE WWINDEX1,KW0 INITIATE FORMAT-NR
AA500
COMMIT NWXSTAT
ADD WWINDEX2,KW1 GIVES RELATIVE-RECORD-NR
ADD WWINDEX1,KW1 GIVES FORMAT-NR
CBG WWINDEX1,KWNRFMT,AA700 FORMAT-NR > 100 ?
CALL FMOVE,FCFORMAT,FMTTAB(WWINDEX1)
MOVE FCFMTBUF,=D'0'
XCOPY FCFMTBUF,KW0,NWTOTBYT,FCFORMAT,KW0
XCOPY SPBINW3,KW0,KW2,FCFORMAT,NWTOTBYT
MOVE SPBINW4,=X'E9E9'
MOVE WDEC1,WWINDEX2
CBNE SPBINW3,SPBINW4,AA600
WRITE .DIR,DSFMTFLE,FCFMTBUF,WDEC1
XSTAT DSFMTFLE,KWCANCEL
BNERR AA500
B AA910
AA600
* FORMATS ARE LONGER THAN 1 RECORD ; 1 RECORD + 1 OVERFLOW-RECORD
* HAVE TO BE WRITTEN ON THE FORMAT-FILE
XCOPY FCFMTBUF,NWTOTBYT,KW2,WW2,KW0
WRITE .DIR,DSFMTFLE,FCFMTBUF,WDEC1
MOVE FCFMTBUF,=D'0'
XCOPY FCFMTBUF,KW0,NWTOTBYT,FCFORMAT,NWTOTBYT
MOVE WDEC2,WW2
MOVE SPBINW1,NWTOTBYT
ADD SPBINW1,NWTOTBYT
XCOPY SPBINW3,KW0,KW2,FCFORMAT,SPBINW1
CBNE SPBINW3,SPBINW4,AA650
WRITE .DIR,DSFMTFLE,FCFMTBUF,WDEC2
ADD WW2,KW1 NEXT OVERFLOW-RECORDNUMBER
B AA500
AA650
* FORMATS ARE LONGER THAN 1RECORD + 1 OVERFLOW RECORD
ADD WW2,KW1
XCOPY FCFMTBUF,NWTOTBYT,KW2,WW2,KW0
WRITE .DIR,DSFMTFLE,FCFMTBUF,WDEC2
MOVE FCFMTBUF,=D'0'
XCOPY FCFMTBUF,KW0,NWTOTBYT,FCFORMAT,SPBINW1
MOVE WDEC2,WW2
WRITE .DIR,DSFMTFLE,FCFMTBUF,WDEC2
XSTAT DSFMTFLE,NWXSTAT
ADD WW2,KW1
B AA500
AA700
* WRITE FIRST FREE OVERFLOW-RECORDNUMBER
* INTO THE FIRST FORMAT-RECORD
XCOPY FCFMTBUF,NWTOTBYT,KW2,WW2,KW0
DISCARD .DIR,DSFMTFLE,KD1
WRITE .DIR,DSFMTFLE,FCFMTBUF,KD1
XSTAT DSFMTFLE,NWXSTAT
B AA920
AA900
RSTAT DSFMTFLE,NWXSTAT READ STATUS
EDWRT SPDSSCRN,FMTI
EDWRT SPDSSCRN,FMTC OPEN UNSUCCESSFULL
B AA999
AA910
EDWRT SPDSSCRN,FMTI
EDWRT SPDSSCRN,FMTG I/O ERROR
B AA999
AA920
EDWRT SPDSSCRN,FMTI
EDWRT SPDSSCRN,FMTH SUCCESSFULL END
B AA999
AA930
EDWRT SPDSSCRN,FMTI
EDWRT SPDSSCRN,FMTE OVERFLOW
B AA999
AA940
EDWRT SPDSSCRN,FMTI
EDWRT SPDSSCRN,FMTD AMOUNT LANG.NRS > 6
AA999
PERF ZLCLSF
EXIT
EJECT
BALGG PROC
************************************************************************
* FUNCTIONAL DESCRIPTION : *
* LOOKING FOR A FREE LANGUAGE-NUMBER *
* LANGUAGE-NR MUST BE 1 , 2 OR 3 *
* THE PROCEDURE "BALGG" READS THE FIRST FORMAT- *
* RECORD OF THE CONCERNED LANGUAGE,
* THE PROCEDURE "MASK" GIVES A CONDITION-CODE EQUAL
* 1 WHEN THE FORMAT-RECORD CONTAINS NO DATA *
* THE MAXIMUM AMOUNT OF TRY-OUTS WILL BE 6 *
************************************************************************
BA000
MOVE WWCOUNT,KW0 INITIATE AMOUNT OF TRIES
MOVE WW1,KDMAXLGG
BA100
EDWRT SPDSSCRN,FMTI
EDWRT SPDSSCRN,FMTB
DSC0 SPDSDYKB,02
MOVE KWCONT,KW1
NKI SPDSDYKB,VCVOLNR1,KTB,KWCONT,KWSPCONT
CBNE KWCONT,KW1,BA200
MOVE NDTRMLGG,VCVOLNR1
MOVE WWINDEX2,NDTRMLGG
CBE WWINDEX2,KW0,BA200
CBNL WWINDEX2,WW1,BA200
MUL WWINDEX2,KWNRFMT COUNT RELATIVE-RECORD-NUMBER
ADD WWINDEX2,KW1 COUNT RELATIVE-RECORD-NUMBER
MOVE KWCONT,KWFMTLNG
MOVE WDEC1,WW1
READ .DIR,DSFMTFLE,FCFMTBUF,KWCONT,WDEC1
XSTAT DSFMTFLE,WW1
MOVE WWINDEX1,=X'8800' NO DATA
CALL MASK,WW1,WWINDEX1
BNOK BA900
BA200
COMMIT NWXSTAT
ADD WWCOUNT,KW1
CBNG WWCOUNT,=W'6',BA100
* TO PREVENT AN ENDLESS LOOP
B AA940
BA900
COMMIT NWXSTAT
SUB WWINDEX2,KW1
BA999
RET
PEND
EJECT
INCLUDE ENGDEF,LIST FORMAT DEFINITIONS
************************************************************************
*
*
FMTA FRMT
FSL
FTEXT ' VOLUME-NAME ? : DSC'
FMEND
FMTB FRMT
FSL
FTEXT 'LANGUAGE-NUMBER ? (1 OR 2 OR 3 ):'
FMEND
FMTC FRMT
FSL
FTEXT 'OPEN FORMAT-FILE NOT SUCCESSFULL'
FMEND
FMTD FRMT
FSL
FTEXT 'MORE THAN 6 LANGUAGE-NUMBERS TRIED'
FNL
FTEXT 'PERHAPS NO FREE LANGUAGE-NUMBER'
FMEND
FMTE FRMT
FSL
FTEXT 'OVERFLOW OF OVERFLOW-AREA'
FNL
FTEXT '** JOB ABENDED **'
FMEND
FMTF FRMT
FNL
FTEXT 'PRESS CONTINUE'
FMEND
FMTG FRMT
FNL
FTEXT 'I/O ERROR WHILE READING OR '
FSL
FTEXT 'WRITING FORMAT-FILE'
FMEND
FMTH FRMT
FNL
FTEXT 'PGM "FORMAT" SUCCESSFULLY EXECUTED'
FMEND
FMTI FRMT CLEARS SCREEN
FCOPY =X'2031'
FMEND
END