|
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: 7746 (0x1e42)
Notes: pts_type(SC)
Names: »KTOPR.SC«
└─⟦22f4dea89⟧ Bits:30009702 Philips computer tape "DOS_PTS_4.2_M_FL"
└─⟦this⟧ »NJ-AMT/KTOPR.SC«
└─⟦dab19bdd7⟧ Bits:30009677 Philips computer tape "600218"
└─⟦this⟧ »NJ-AMT/KTOPR.SC«
IDENT KTOPR 02.03.XXX.1 DDUM KMD08 PDIV ENTRY KTOPR ENTRY KTPRT EXT ADMRET EXT KTPLAN EXT RESTMK EXT RAREAD EXT RAWRIT EXT SPCLRA EXT SPCLRN EXT SPERR EXT FRMXTA EXT WTALLY EXT WAITF INCLUDE EQUATE EJECT KTOPR ******************** * * OPRETTELSE/SLETNING I KONTOPLAN * ******************** TBT GTMASTFL,KTCR00A ONLY MASTER B KTCROK1 KTCR00A CMP CTASKNR,CBIN0 ALL MUST BE CLOSED BNE KTCROK1 SET CCONVFLG CLOSE FOR OTHER TASKS MOVE SPKEY,CBIN2 KEY POSITION = 2 KTCR000 SET SPPROMPT SET GTDYFLG ATTFMT KTPFRM01 KTCR010 PERF SPCLRA IB SPBINW2,KTCROK,KTCROK,KTCR100 B KTCR000 KTCR100 CLEAR CSWFLAG LOOK FOR NUMBER PERF KTPLAN,GSWBCD6,GSWBCD3 BNOK KTCR000 ERROR ON KTPLAN CBL GSWBIN5,CBIN0,KTCR110 SET CSWFLAG KTCR110 CLEAR GTDYFLG ATTFMT KTPFRM01 KTCR120 PERF SPCLRN IB SPBINW2,KTCR130,KTCR130,KTCR150 B KTCR120 KTCR130 B KTCR000 KTCR150 TBF CSWFLAG,KTCR500 IF NOT FOUND * FOUND CBE GSWBCD3,=D'0',KTCR200 BRANCH TO DELETE ADD GSWBIN5,CBIN6 XCOPY CKTBUF,GSWBIN5,CBIN2,GSWBCD3,CBIN1 PERF RAWRIT,DK04,=D'4',CKTBUF,GSWBIN4 REWRITE RECORD B KTCR000 * DELETE A RECORD * GSWBIN4 - RECORD NO * GSWBIN5-6 - START OF RECORD KTCR200 KTCR210 DLETE CKTBUF,GSWBIN5,CBIN8 DELETE RECORD CBNE GSWBIN4,CKTLAST,KTCR250 NOW THIS IS LAST USED RECORD XCOPY GSWSTR20,CBIN0,CBIN20,CKTBUF,CBIN0 CBNE GSWSTR20,CBLANKS,KTCR220 PERF RAWRIT,DK04,=D'4',CKTBUF,GSWBIN4 BNOK KTCR000 NOW FIRST NO DELETED SUB CKTLAST,CBIN1 SUB GSWBIN4,CBIN1 CBE GSWBIN4,CBIN0,KTCR215 MOVE GSWBIN5,=W'128' PERF RAREAD,DK04,=D'4',CKTBUF,GSWBIN5,CKTLAST BNOK KTCR000 KTCR215 PERF RESTMK B KTCR000 KTCR220 PERF RAWRIT,DK04,=D'4',CKTBUF,GSWBIN4 REWRITE BNOK KTCR000 PERF RESTMK B KTCR000 KTCR250 ADD GSWBIN4,CBIN1 NOT LAST RECORD MOVE CCYBUF,CBLANKS MOVE GSWBIN5,=W'128' PERF RAREAD,DK04,=D'4',CCYBUF,GSWBIN5,GSWBIN4 BNOK KTCROK MOVE GSWBIN5,=W'120' XCOPY CKTBUF,GSWBIN5,CBIN8,CCYBUF,CBIN0 MOVE GSWBIN5,CBIN0 SUB GSWBIN4,CBIN1 PERF RAWRIT,DK04,=D'4',CKTBUF,GSWBIN4 BNOK KTCROK PERF RESTMK MOVE CKTBUF,CCYBUF MOVE GSWBIN5,CBIN0 ADD GSWBIN4,CBIN1 B KTCR200 KTCR500 NOT FOUND CMP GSWBCD3,=D'1' BL KTCR000 DELETE NON-EXISTING * CREATE NEW MOVE CKTBUF,CBLANKS MOVE GSWBIN5,=W'128' PERF RAREAD,DK04,=D'4',CKTBUF,GSWBIN5,GSWBIN4 BNOK KTCR000 MOVE GSWSTR20,CBLANKS MOVE GSWBIN5,CBIN0 KTCR520 MOVE GSWBCD7,=D'1' XCOPY GSWSTR20,CBIN0,CBIN6,CKTBUF,GSWBIN5 XCOPY GSWBCD7,CBIN1,CBIN6,CKTBUF,GSWBIN5 CBE GSWSTR20,CBLANKS,KTCR550 POSITION FOUND (BLANK) CBG GSWBCD7,GSWBCD6,KTCR550 POSITION FOUND ADD GSWBIN5,CBIN8 CBE GSWBIN5,=W'128',KTCR530 POSITION FOUND B KTCR520 * IN NEXT RECORD KTCR530 ADD GSWBIN4,CBIN1 CBL GSWBIN4,=W'22',KTCR540 * SET UP ERROR 10 KTCR535 MOVE SPBINW4,CBIN21 MOVE GTWBCD2,=D'04' MOVE GTWBCD1,=D'10' MOVE GSWSTR9,=C'DISCFEJL ' PERF SPERR B KTCR000 KTCR540 MOVE GSWBIN5,=W'128' MOVE CKTBUF,CBLANKS PERF RAREAD,DK04,=D'4',CKTBUF,GSWBIN5,GSWBIN4 BNOK KTCR000 MOVE GSWBIN5,CBIN0 KTCR550 XCOPY GSWSTR20,CBIN0,CBIN6,GSWBCD6,CBIN1 XCOPY GSWSTR20,CBIN6,CBIN2,GSWBCD3,CBIN1 KTCR560 MOVE GSWBIN3,=W'120' XCOPY GSWSTR20,CBIN8,CBIN8,CKTBUF,GSWBIN3 SAVE LAST INSRT CKTBUF,GSWBIN5,CBIN8,GSWSTR20,CBIN0 BOFL KTCR600 MOVE CKTLAST,GSWBIN4 SET LAST PERF RAWRIT,DK04,=D'4',CKTBUF,GSWBIN4 BNOK KTCROK PERF RESTMK B KTCR000 KTCR600 CBNE GSWBIN4,CKTLAST,KTCR610 CBE CKTLAST,=W'21',KTCR535 ADD CKTLAST,CBIN1 KTCR610 PERF RAWRIT,DK04,=D'4',CKTBUF,GSWBIN4 BNOK KTCROK PERF RESTMK ADD GSWBIN4,CBIN1 MOVE CKTBUF,CBLANKS MOVE GSWBIN5,=W'128' PERF RAREAD,DK04,=D'4',CKTBUF,GSWBIN5,GSWBIN4 BNOK KTCROK MOVE GSWBIN5,CBIN0 COPY GSWSTR20,CBIN0,CBIN8,GSWSTR20,CBIN8 B KTCR560 KTCROK CLEAR CCONVFLG KTCROK1 B ADMRET EJECT KTPRT PROC ******************** * * LISTING OF KONTOPLAN ON TALLY ROLL * ******************** TBF GTMASTFL,KTPRTOK ONLY MASTER CBNE CTASKNR,CBIN0,KTPRTOK WAIT KTALLY EDWRT KTALLY,KTPF100 WRITE HEADING * LOOP THROUGH FILE MOVE GSWBIN4,CBIN0 KTPRT15 ADD GSWBIN4,CBIN1 CBG GSWBIN4,CKTLAST,KTPRT90 NO MORE RECORDS IN FILE PERF WAITF,CKFLAG MOVE GSWBIN5,=W'128' MOVE CKTBUF,CBLANKS PERF RAREAD,DK04,=D'4',CKTBUF,GSWBIN5,GSWBIN4 BNOK KTPRT45 * LOOP THROUGH BUFFER MOVE GSWBIN5,CBIN0 KTPRT35 MOVE GSWBCD6,=D'1' MOVE GSWBCD3,=D'1' MOVE GSWSTR20,CBLANKS XCOPY GSWSTR20,CBIN0,CBIN8,CKTBUF,GSWBIN5 XCOPY GSWBCD6,CBIN1,CBIN6,CKTBUF,GSWBIN5 ADD GSWBIN5,CBIN6 XCOPY GSWBCD3,CBIN1,CBIN2,CKTBUF,GSWBIN5 ADD GSWBIN5,CBIN2 CBE GSWSTR20,CBLANKS,KTPRT80 WAIT KTALLY EDWRT KTALLY,KTPF200 PRINT LINE CBL GSWBIN5,=W'128',KTPRT35 * PERF FRMXTA,CBIN1 PERF WTALLY KTPRT45 CLEAR CKFLAG B KTPRT15 * KTPRT80 CLEAR CKFLAG KTPRT90 PERF FRMXTA,CBIN7 SKIP LINES PERF WTALLY KTPRTOK RET PEND EJECT * * * FORMATS * KTPFRM01 FRMT FLINK KTPF100 FBF GTDYFLG,KTPF010 FKI 1,ME,MINL=10,MAXL=10,REWRT,SCHK=1 KTPF010 FMEL '99999999E-99',GSWBCD6 FBT GTDYFLG,KTPF020 FKI 13,ME,MINL=1,MAXL=1,APPL=106 FMEL '9',GSWBCD3 KTPF020 FMEND * KTPF100 FRMT FSL FCOPY =C'ADM ' FNL FCOPY =C'DATAS[T' FILLR ' ',1 FCOPY =C'REGKONTONR' FILLR ' ',2 FNL FCOPY =C'KONTONR' FILLR ' ',5 FCOPY =C'BFO' FILLR ' ',2 FNL FNL FMEND * KTPF200 FRMT FILLR '1',2 FMEL '99999999E-99',GSWBCD6 KT NO FMEL 'BBZ9',GSWBCD3 TYPE FILLR ' ',2 FMEND * END