|
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: 20622 (0x508e)
Notes: pts_type(SC)
Names: »KMD08.SC«
└─⟦9ad21746d⟧ Bits:30009682 Philips computer tape "600304"
└─⟦this⟧ »NJ-AMT/KMD08.SC«
IDENT KMD08 02.01.XXX.1 * * ******************************************************** * * THIS IS THE MAIN MODULE FOR KMDAPLICATION * CONTAINING THE CWB'S, TWB'S AND INITIAL * START POINTS * * * ************************************************* DDIV OPTNS LINES=45 **************************************************** * * TRANSACTION TASK TC * **************************************************** TERM TC * CWB CB1 CWB CB2 CWB CB3 CWB CB4 CWB CB6 DWB CD3(CB3) DWB CD4(CB4) TWB GB1 TWB GB2 TWB GB3 TWB GB4 TWB TB1 UWB TB2 DWB TD2(TB2) * FD01 DSET FC=F8 VOL 999001 FD02 DSET FC=F9 VOL 999002 KVOUCH DSET FC=31,DEV=TV,BUFL=100 KJTAPE DSET FC=30,DEV=TJ,BUFL=70,BUFDS=KVOUCH KTALLY DSET FC=32,DEV=TR,BUFL=30,BUFDS=KVOUCH SCREEN DSET FC=50,BUFL=56 KEYB DSET FC=20 DK01 DSET FC=C1 FD999001 CONFDATA DK02 DSET FC=C2 FD999002 REGSET DK03 DSET FC=C3 FD999003 CYCLE SET DK04 DSET FC=C4 FD999004 KT PLAN DSSOPI DSET FC=10 DSSOPO DSET FC=11 DCOMM DSET FC=61 KCASS DSET FC=12 DK05 DSET FC=C5 DK06 DSET FC=C6 DK07 DSET FC=C7 DK08 DSET FC=C8 FD03 DSET FC=FA VOL 999003 FD04 DSET FC=FB VOL 999004 FMTCTL INDS=KEYB,OUTDS=SCREEN * * * * * START REGGO STACK 160 EJECT ************************************************************************ * * D A T D I V : DATA DIVISION FOR IBM-3270 EMULATION PACKAGE. * THIS MODULE ALSO CONTAINS THE CREDIT CODED * START-UP ROUTINES. * ******************************************************************** EJECT * * * * DATA DIVISION * * * * KB/VDU TERMINAL * TERM KA * CWB CB9 TWB TB9 * START KBVGO * DSDC DSET FC=61 DSICR DSET FC=E0,DEV=II COPCMD=1 DSICW DSET FC=E1,DEV=IO DSVDU DSET FC=50,DEV=DY,BUFL=162 DSKBAN DSET FC=20,DEV=KA,BUFL=2 DSKBSD DSET FC=40,DEV=KI,BUFL=2 EJECT * * * GTP TERMINAL * * TERM GA * CWB CB9 TWB TB9 * START GTPGO * DSDC DSET FC=61 DSICR DSET FC=E0,DEV=II DSICW DSET FC=E1,DEV=IO COPCMD=1 DSGTP DSET FC=30,DEV=GP,BUFL=162 EJECT * * * DCTASK * * TERM D0 * CWB CB9 START DC1GO DSDC DSET FC=60 * EJECT * * * WORK AREA FOR KEYBOARD AND DISPLAY TASKS * * TB9 BLK * TCT01 BIN 4X'0' TID AND STACKBASE PRINTER STRG 4X'0' KEYBARD/VDU/PRINTER BVDU STRG 3840X'0' VDU SCREEN BUFF PCURS STRG 4X'0' CURSOR ADDR. BINARY ATTRIB STRG 4X'0' LAST ATTRIBUTE CHARACTER CURATT STRG 4X'0' CURSOR ATTRIBUTE WCC STRG 4X'0' WCC/CCC CHARACTER KBINH STRG 4X'0' KEYBOARD INHIBIT INDIC. LINCNT STRG 4X'0' DCLENG STRG 4X'0' DC READ EFFECTIVE LENGTH ICWORK STRG 4X'0' INTATT STRG 4X'0' INTENSITY ATTRIBUTE OFFFLG STRG 4X'0' OFFLINE FLAG COPNO BIN TID FOR HARDCOPY MISCAR STRG 44X'0' CCC,MAIN, MODE,KEYS,ECBDCC,ECBBLK, STRG2 STRG 4X'0' DK EJECT ************** * * COMMON WORK BLOCK FOR ALL TASKS * ***************************************** CB9 BLK * CNFIGD BOOL CNFBSY BOOL * * CONFIGURATION DATA * NBRKBV BIN NUMBER OF KB/VDUS NBRGTP BIN NUMBER OF GTPS * MF1KBV STRG 32X'40C1C2C3C4C5C6C7' DV ADDRESSES KB/VDU MF1GTP STRG 32X'C8C94A4B4C4D4E4F' DV ADDRESSES GTP * THE LENGTH OR PLACE OF THE CONFIG DATA ABOVE SHOULD NOT BE CHANGED * MF1CU STRG X'6040' CU-ADDRESS MF # 1 * CNFHC BINI (16),'1','2','3','4','5','6','7','8' HARDCOPY PRINTER FOR KB-VDU 1-16 * BINWK1 BIN * OFF STRGI (12)2C'TC','TD','TE','TF','TG','TH', C 'TI','TJ','TK','TL','TM','TN' EJECT * CWB 1 COMMON * * CB1 BLK CBKOFLG BOOL FALSE T=ALL BKO-CODES ALLOWED CKTFLAG BOOL FALSE F=NO SALDO AT ALL IN KORT CCLKTFLG BOOL FALSE T=KONTOKORT I KASSELUK CTESTFLG BOOL FALSE T=CONVERSION, TEST MODE CTRVALG BOOL FALSE T: SKOVBO. F: VIBORG CFLT46 BOOL FALSE T=SPECIAL FIELD 46,TR=8 CFLT48 BOOL FALSE T=SPECIAL FIELD 48,TR=3 CKTAUTO BOOL TRUE T=ASK KORT AFTER TR 4 CDCFLAG BOOL FALSE T=INCLUDES DATATRANSMISSION CCYWRTF BOOL FALSE T=DO NOT USE CYCLE SET CADM22F BOOL FALSE T=ALLOWED FUNCTION (ADM 22) C5MDISK BOOL FALSE T=5M DISK CKASFLG BOOL TRUE T=BACKUP ON CASSETTE CSLDFLG BOOL TRUE T=GL.SALDO PRESENT(CKTFLAG=T) CGLREGFL BOOL FALSE T=GL REGSET PRESENT CCONVERT BOOL FALSE T=CONVERSION MODE CBIN0 BIN '0' CBIN1 BIN '1' CBIN2 BIN '2' CBIN3 BIN '3' CBIN4 BIN '4' CBIN5 BIN '5' CBIN6 BIN '6' CBIN7 BIN '7' CBIN8 BIN '8' CBIN9 BIN '9' CBIN10 BIN '10' CBIN11 BIN '11' WEIGTH BCDI (13),'2','7','6','5','4','3','2','7','6','5','4','3','2' WEIGTH1 BCDI (13),'7','6','5','4','3','2','7','6','5','4','3','2','1' * EJECT CB2 BLK * CPFLG BOOL FALSE T: DISK OCCUPIED CSPLITFL BOOL FALSE T: SPLIT RECORD CWFLAG BOOL FALSE F=COLD START CREMITFL BOOL FALSE F=NO REMIT CSKIFTFL BOOL FALSE T=FD CHANGING CEORFLG BOOL FALSE T=END OF A RECORD CCOLDFLG BOOL FALSE T=VERY FIRST COLD START CERRORFL BOOL FALSE T=ERROR IN COLD START CCONVFLG BOOL FALSE T=CONVERSION GOING ON CSWFLAG BOOL FALSE SCRATCH FLAG CSKIFTWN BOOL FALSE T=WARNING ABOUT FD CHANGE CKFLAG BOOL FALSE T=EXCL ACCESS, KNT. PLAN * * * CBIN12 BIN '12' CBIN13 BIN '13' CBIN14 BIN '14' CBIN15 BIN '15' CBIN16 BIN '16' CBIN17 BIN '17' CBIN18 BIN '18' CBIN19 BIN '19' CBIN20 BIN '20' CBIN21 BIN '21' CBIN22 BIN '22' CBINMAX BIN '26' EJECT *********************************************************** * * TABLE GIVING INDEXES FOR TRANSACTIONFIELDS * FIELD NR GIVES DISPLACEMENT IN TABLE * ************************************************************ CFLTDEX BINI (90), C '26','26','26','26','1','2','3','4','5','6', 1-10 C '7','8','9','4','11','12','10','11','12','13', 11-20 C '10','11','12','13','14','15','16','1','8','9', 21-30 C '10','5','12','13','14','5','18','19','7','7', 31-40 C '18','14','20','21','22','17','12','15','10','1', 41-50 C '2','3','4','2','3','4','5','6','7','8', 51-60 C '9','10','11','12','13','6','26','26','26','26', 61-70 C '26','26','26','26','26','26','26','26','26','26', 71-80 C '19','26','26','26','26','26','26','26','26','26' 81-90 CCNTDEX BINI (11), C '1','2','3','4','5','1','5','6','6','5','0' EJECT CB3 BLK * * * * * CTWBIN1 BIN CTWBIN2 BIN CVOUTOP BIN W'56' CMAXLIN BIN W'54' CMINLIN BIN W'2' CCONBUF0 STRG 398X'FF' CCONBUF1 STRG 398X'FF' CCONBUF2 STRG 398X'FF' CCONBUF3 STRG 398X'FF' CCONBUF4 STRG 398X'FF' CCONBUF5 STRG 398X'FF' CCONBUF6 STRG 398X'FF' CCONBUF7 STRG 398X'FF' CCONBUF8 STRG 398X'FF' CTRANBUF STRG 698 CTID STRGI (12),2C'TC','TD','TE','TF','TG','TH', C 'TI','TJ','TK','TL','TM','TN' * EJECT CB4 BLK * * * * * CMAXTASK BIN NO OF TASKS CTASKNR BIN NO. OF 0PEN TASKS CRECLGD BIN W'128' CRECNR BIN PHYSICAL RECORD NR. CCONBUF9 STRG 398X'FF' CRECBCD BCD 6D LOGICAL RECORD NR. CEDATNR BCD 4 DATASET NR. SOPINP STRG 4 ASVOL STRG 6 ASFNAME STRG 8 CKMDNAM STRG 6'OD-KOM' CVERSNR BCD 10D'01014610' VERSION NUMBER CBLANKS STRG X'2020' CPCKBUF STRG 128 PACKBUFFER * TEXT FOR BKO * ONLY RELEVANT IF EITHER * CBKOFLG=F (CHECK BKO) OR * CKTFLAG=F (NOT SALDO IN KT.) CTTXT07 STRG 13'00008 C 99 0' CREGTAB BCDI (25,2),'01','-01', C '02','-01', C '03','-01', C '04','-01', C '05','-01', C '06','-01', C '07','-01', C '08','-01', C '09','-01', C '10','-01', C '12','-01', C '40','-01', C '41','-01', C '42','-01', C '45','-01', C '46','-01', C '47','-01', C '48','-01', C '49','-01', C '50','-01', C '51','-01', C '52','-01', C '53','-01', C '54','-01', C '-01','-01' * EJECT * CB6 BLK * CCYPFLG BOOL FALSE CYSET OCCUPIED ? * * * * CCYSIZE BIN '30' MAX SIZE OF CYCLE PAGE CKTLAST BIN '0' LAST RECORD USED, KTPLAN CMAXREC BIN W'1400' GIVES WARNING OF FULL REGSET CGLRECNR BIN '0' LAST RECNR, GL REGSET CKTINDX BCDI (7),14D KNT.PLAN MASTER INDEX CCYBUF STRG 128 CYSET BUFFER CKTBUF STRG 128 KTPLAN BUFFER CKTTOP BCD 4D'5' FIRST LINE KORT (DEFAULT) ON STRGI (12)2C'KA','KB','KC','KD','KE','KF','KG', C 'KH','KI','KJ','KK','KL' EJECT * TB1 BLK * * * * TTCY1FLG BOOL FALSE IN CYCLE? TTCY2FLG BOOL FALSE IN STABEL? TTLSTFLG BOOL FALSE TTPSEFLG BOOL FALSE PAUSE STATE TTSUMFLG BOOL FALSE SUM ON SCREEN ? TTTSTFLG BOOL FALSE FIRST ENTRY IN CYKLE ? TTINVFLG BOOL FALSE INDICATE MODPOST TTJTEND BOOL FALSE END OF JOURNAL TTEORFLG BOOL FALSE *-- END OF RECORD TTSUPFLG BOOL FALSE SUPPLEMENT POST TTSMALL BOOL FALSE *-- SMALL GIRO KVIT? TTR11FLG BOOL FALSE T: KASSE CLOSE TREMFLG BOOL FALSE T= REMOTE TERMINAL TTKORTFL BOOL FALSE T: IN KONTOKORT MODE TTASKAT BOOL FALSE T=BKO 51 * * TTDKDEX BIN TTSTYRDX BIN '1' HBOG/DEBP/REM TTTROLD BIN NO OF OLD TRANS TTASKNR BIN TTDKBCD BCD 2 D/K VALUE TTARKSAV BCD 12 SAVED ARK KT NR TTCYKTOT BCD 14 SAVED CYKLE TOTAL TTCYKPOS BCD 4 SAVED CYKLE LINE NR TTLINNR BCD 4 LINE NR ON VOUCHER TTCNTNR BCD 4 COUNTER TAELLER NR TTEJEDB BCD 14 TOTAL OF EJ EDB GTMSK BCD 6D'999' GTDATO BCD 8X'FFFFFFFF' TSWBCD2 BCD 2 *-- TTCYM STRG 1 CYKLE MARK ON JOURNAL GTREGF BCDI (26),16X'F' TRANSACTION FIELDS * EJECT * GB1 BLK * * * * * GTEXFLAG BOOL FALSE GTADUPFL BOOL FALSE GTAUTODP BOOL FALSE GTREGFLG BOOL FALSE GTCYFLG BOOL FALSE GTTFLG BOOL FALSE CLOSE ? GTCLRN BOOL FALSE *-- SPCLRN OR SPCLRA GTTYPE2 BOOL FALSE *-- GTTYPE3 BOOL FALSE *-- GTKASSE BOOL FALSE *-- TRUE- IN KASSE FUNCTIONS GTSLUTFL BOOL TRUE FALSE: SLUT KEY IS SIMULATED GTDIVTR BOOL FALSE T: DIVERSE TRANS GTTRSEL BOOL FALSE T: TRANSACTION SELECTED GTMASTFL BOOL FALSE T=MASTER TERMINAL GTASUMFL BOOL FALSE T=AUTO SUM GTSUBFLG BOOL FALSE T=SUBTOTAL * GSWBIN1 BIN GSWBIN2 BIN GSWBIN3 BIN GSWBIN4 BIN GSWBIN5 BIN GSWBIN6 BIN GSWBCD1 BCD 14 GSWBCD2 BCD 14 GSWBCD3 BCD 6 GSWBCD4 BCD 6D GSWBCD5 BCD 6 GSWBCD6 BCD 14 GSWBCD7 BCD 14 GTWBCD1 BCD 14 GTWBCD2 BCD 14 GTSTRFMT STRG 7 STRING FOR FORMATS EJECT GB2 BLK * SPPROMPT BOOL FALSE SPCHANGE BOOL FALSE SPDUPL BOOL FALSE TRUE: FIELD HAS BEEN DUPPED SPME BOOL FALSE FALSE: NO CHECK FOR ME FIELDS SPKEYFLG BOOL TRUE FALSE NO KOR-KEY IN SPERR SPWARNFL BOOL FALSE T: WARNING TTKEY1 BOOL FALSE T=KEY 1 ON TTKEY2 BOOL FALSE T=KEY 2 ON TTKEY3 BOOL FALSE T=KEY 3 ON TTKEY4 BOOL FALSE T=KEY 4 ON * * * SPBINW1 BIN SPBINW2 BIN SPBINW3 BIN SPBINW4 BIN SPBINW5 BIN SPKEY BIN '1' SPERASE BIN '0' 0:ERASE; 4:NO ERASE SPLINTOP BIN SPLINLOW BIN GTCLASS BIN '1' TERMINAL CLASS GTREGDEX BIN '0' TRANSTYPE INDEX GTDFLIN BIN '27' DEFAULT LINE NUMBER GSSWITCH BINI (26) GTUSED BINI (26) * EJECT GB3 BLK * PSIGNFLG BOOL FALSE BCPR BOOL FALSE T=CPR F=CIR BLEV BOOL FALSE T=LEV., F=CPR GTDYFLG BOOL FALSE T=DISPLAY GTSPGFLG BOOL FALSE GTKORTFL BOOL FALSE T=KONTO FOUND IN KONTOPLAN GTTESTFL BOOL FALSE T=IN TEST MODE GTSWFLAG BOOL FALSE SCRATCH FLAG GTSUMKEY BOOL FALSE SUM INDIKATOR GTNWFLG BOOL FALSE T= USE .NW GTADMFLG BOOL FALSE T= IN ADM FUNCTIONS GTLOKSPG BOOL FALSE T=LOKAL INQUIRIES GTSLDFLG BOOL FALSE T=SALDO PRESENT. F=NOT PRESENT GTGLSPG BOOL FALSE T=INQUIRIES ON GL REGSET * * GTPPOIN BIN GTPAGE BIN GTRETUR BIN GTSUM BCD 14 GTANTAL BCD 4 GTCYSUM BCD 14 GTREGNR BCD 3 TRANSTYPE GTDBKRS BCD 2 SIGN FOR AMOUNT GTSUMST BCD 6 1. NUMBER FOR SUM FUNCTION GTSUMCNT BCD 14 COUNTER FOR SUMFUNCTION GTL8TXT STRG 8 TEXT FOR LINE 8 SPINPUT STRG 20 GSWSTR1 STRG 1 GSWSTR2 STRG 2 GSWSTR9 STRG 9 GSWSTR20 STRG 20 * EJECT * GB4 BLK GTCYWRTF BOOL FALSE T=NO WRITE ON CYSET GTCYTRPF BOOL FALSE T=TRANSPORT IN CYCLE * * * * GTPSELIN BIN '0' LINE NO. WHEN PAUSE GTCYIN BIN NEXT USED, CYCSET GTCYOUT BIN NEXT FREE, CYCSET GTRECNR BIN SPG. RECORD NO. GTLBNR BCD 6D SPG. EKSP.LB.NO. GTLBNRIN BCD 6D EKSP.LB.NR ASKED FOR GTKTTYP BCD 4D KTPLAN TYPE * * * * * EJECT TB2 BLK * * * * GTDBKRC STRG 4 DEB/KRE TEXT GTTESTMK STRG 1 TTSUPMRK STRG 1 SUPPLEMENT MARK TTSUMMRK STRG 1 SUM MARK GTTEXT STRG 6 TTSPARE3 STRG 1C'.' TCONBUF STRG 398X'FF' TTCYKST BCD 4 1. LINE CYCLE/STABEL TTKTSLD BCD 14 KONTOKORT, SALDO TTKTLIN BCD 4 KONTOKORT, LINIE NR TTKTCHK BCD 2 KONTOKORT, CHECKCIFFER TTDBKRM STRG 1C'K' DEB/KRE MARK ON JOURNAL TT16TXT STRG 3 RENTE/GEBYR/RATE TT07TXT STRG 5 BKO TEXTS GTDUPF BCDI (26),16X'F' DUP FIELDS * * EJECT CD3 DBLK * * * * * DUMCD3 STRG 10 CMASK BCDI (12),4D CBACC BCDI (60,3),14D BEHOLDNINGER CTR12NR BCDI (60),12D EJ-EDB ACCOUNT NOS. CRELDAY BCD 4X'FFFF' CCONFREC BCD 6 C12ACC BCDI (60,2),14D EJ-EDB COUNTERS * * * EJECT CD4 DBLK * * * * * DUMCD4 BINI (4) CBEH BINI (12,2) FIRST AND SIZE OF BEHLDN. CTR12 BINI (12,2) FIRST AND SIZE OF TR 12 CFNAME STRGI (8),8 CVOLNO BCD 6 VOLUME NUMBER CKMDNR BCD 6D KOMMUNE NR CMASKDAT BCD 8X'FFFFFFFF' CVOL STRGI (4),6 * EJECT TD2 DBLK * * * * * TTINF1 STRG 14 TTRECOPN BCD 6 REC. NO. FOR OPEN OR CLOSE TTRECCHN BCD 6 REC. NO. FOR FD CHANGE TTSTLBNR BCD 6D FIRST EKSP. LBNR TTSTCASH BCD 14D PRIMO CASH AMOUNT TTCASHAC BCD 12D CASH ACC. NR TVERSUR BCD 12D VERSUR ACC NR TTCASH BCD 14D CURRENT CASH AMOUNT TTLBNR BCD 6D CURRENT EKSP.LBNR TTACC BCDI (8,2),16D'0' EDB COUNTERS TTGLREC BCD 6 SAVE RECORD NO, GL REGSET * * * * PDIV ENTRY REGGO ENTRY KBVGO ENTRY GTPGO ENTRY DC1GO * EXT T1GO EXT DCTASK EXT VDUKB EXT PRINT EXT SWITCH EXT GETTID GET TASK IDENTITY ENTRY OFFLNE OFFLINE START ADDRESS ENTRY ONLINE EJECT DSC0 DSDC,2 DUMMY REFERENCE T:IO EJECT **************************************** * * START OF REGISTRATION * **************************************** REGGO B T1GO EJECT **************************************** * * START ADDRESS FOR KEYBOARD TASK **************************************** KBVGO ADD NBRKBV,='1' CALL GETTID,TCT01 SUB TCT01,=X'4B40' * PERF CONF READ & CONVERT CONFIG DATA MOVE COPNO,CNFHC(TCT01) CBL COPNO,='1',KB050 ADD COPNO,=X'4740' MOVE STRG2,OFF(TCT01) GET OFFLINE TASK ID CBE STRG2,=C' ',KB050 ANY ? PAUSE YES, WAIT FOR RESTART KB050 CALL VDUKB,TCT01 PERF OFFLNE BRANCH TO CREDIT CODE B KB050 RETURN TO IBM-3270 EMULATION EJECT ********************************************* * * START ADDRESS FOR GENERAL PRINTER TASK * ********************************************* GTPGO ADD NBRGTP,='1' CALL GETTID,TCT01 SUB TCT01,=X'4740' MOVE PRINTER,=X'0001' * PERF CONF CALL PRINT,TCT01 EJECT *********************************************** * * START ADDRESS FOR DC-TASK * ********************************* DC1GO CALL DCTASK,MF1CU * EJECT ***************************** * * RESTART OFF LINE TASK * **************************** OFFLNE PROC MOVE STRG2,OFF(TCT01) GET OFF LINE TASK NAME CBE STRG2,=C' ',RETOFF ANY OFFLINE ? RSTRT STRG2 YES PAUSE RETOFF RET PEND * EJECT ************************** * * RESTART ON LINE TASK * ****************************** ONLINE PROC MOVE GSWSTR2,ON(TTASKNR) GET ONLINE TASK NAME CBE GSWSTR2,CBLANKS,RETON ANY ON LINE ? RSTRT GSWSTR2 YES PAUSE RETON RET PEND * END