|
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: 33212 (0x81bc)
Notes: pts_type(SC)
Names: »REMLEV.SC«
└─⟦26dca8ec8⟧ Bits:30009711 Philips computer tape "RÅKON-DIVFMT"
└─⟦this⟧ »REMIT2/REMLEV.SC«
IDENT REMLEV 820804 NJ DDUM KMD08 PDIV ENTRY LEVOPR ENTRY LEVRD ENTRY VARRD ENTRY VARWRT ENTRY GETNXT ENTRY IDXGET ENTRY LEVDEL ENTRY SETIDX ENTRY LEVSPG ENTRY LEVPRT ENTRY LEVIN ENTRY RESTIX EXT DIVRUT EXT FMTREM EXT SPCLRA EXT SPCLRN EXT RAREAD EXT RAWRIT EXT RADEL EXT SETKEY EXT SPERR EXT SPLIN8 EXT CLEAR8 EXT TRREAD EXT TXTRD EXT KBTEST EXT TRINIT EXT REPL00 EXT WAITF EXT BDTDEL EXT NEWLIN EXT MEMIX1 EXT MEMIX2 EXT UPDMEM EXT YYMMDD EXT XCOP INCLUDE EQUATE EJECT LEVIN PROC * THE PROCEDURE GETS A LEVERANDOR FROM KBAN LEVIN00 MOVE SPKEY,CBIN2 MOVE GSWSTR9,='STRAKSLEV' MOVE GTLEVNR,GTREGF(CBIN2) CLEAR GTSPGFLG CLEAR GTDYFLG CLEAR GTSWFLAG SET SPPROMPT PERF FMTREM,CBIN3 PERF SPCLRA IB SPBINW2,LEVIN95,LEVIN95,LEVIN10 B LEVIN00 LEVIN10 PERF SETKEY MOVE GSWBIN7,=W'30' PERF REPL00,GTLEVNVN,GSWBIN7 MOVE GSWBIN7,=W'32' PERF REPL00,GTLEVADR,GSWBIN7 PERF REPL00,GTLEVBY,CBIN20 PERF REPL00,GTLEVPDI,CBIN13 CMP CBIN0,CBIN0 B LEVIN99 LEVIN95 PERF SETKEY CMP CBIN0,CBIN1 LEVIN99 RET PEND EJECT LEVOPR PROC **************************************** * * THE PROCEDURE CREATES/CHANGES A LEVERAND R. * ALL DISKFILES CONCERNED ARE UPDATED, * AS WELL AS THE MASTERINDEX IN CORE. * ***************************************** OPR000 MOVE SPKEY,CBIN2 PERF YYMMDD,CMASKDAT MOVE GTLEVDAT,GSWBCD7 MOVE GSWSTR9,=C'VEDLIGEH.' SET SPPROMPT SET GTDYFLG 1. TIME PERF FMTREM,CBIN3 ATTACH FORMAT PERF SPCLRA WRITE ON SCREEN IB SPBINW2,OPROK,OPROK,OPR010 B OPR000 OPR010 LOOK FOR NUMBER PERF IDXGET,GTLEVNR,GSWBIN4,GSWBIN5 GSWBIN5 - LEVINDX GSWBIN4 - INDEX BERR OPRNOK DISKERROR BNOK OPR020 NOT FOUND PERF LEVRD FOUND BNOK OPRNOK OPR015 FOUND, DISPLAY INFO CLEAR GTSWFLAG CLEAR GTDYFLG PERF FMTREM,CBIN3 PERF SPCLRN IB SPBINW2,OPR000,OPR000,OPR030 B OPR015 OPR020 NOT FOUND, DISPLAY BLANKS CBL GTLEVNR,=D'19',OPR000 CLEAR GTSWFLAG CLEAR GTDYFLG PERF FMTREM,CBIN3 PERF SPCLRA IB SPBINW2,OPR000,OPR000,OPR030 B OPR020 OPR030 LEV INFO KEYED IN, INSERT * FIELD CHECK * IF BFO = 2,3,7,8 GIRONR MUST BE PRESENT CBNE GTLEVGI,=D'0',OPR040 MOVE GSWBIN1,GTLEVBFO IB GSWBIN1, C OPR040,OPR035,OPR035,OPR040,OPR040, C OPR040,OPR035,OPR035,OPR040 B OPR040 OPR035 MOVE SPBINW4,CBIN5 'FEJL 5' PERF SPERR NOK B OPR015 OPR040 PERF IDXGET,GTLEVNR,GSWBIN4,GSWBIN5 BERR OPRNOK BNOK OPR050 ALREADY EXISTING PERF LEVWRT WRITE STAM-INFO BNOK OPRNOK B OPR000 OPR050 CREATE NEW PERF IDXINS INSERT NEW INDEX BNOK OPR000 PERF LEVWRT BNOK OPR070 PERF VARINT PERF VARWRT WRITE VAR-LEV-INFORMATION BOK OPR000 OPR070 SOMETHING WRONG PERF IDXDEL DELETE LEV-ENTRY COMPLETELY B OPR000 OPRNOK PERF SETKEY CMP CBIN1,CBIN0 NOT OK RET OPROK PERF SETKEY CMP CBIN0,CBIN0 RET PEND EJECT LEVDEL PROC MOVE SPKEY,CBIN2 DEL000 MOVE GSWSTR9,=C'SLETNING ' SET SPPROMPT SET GTDYFLG 1. TIME PERF FMTREM,CBIN3 ATTACH FORMAT PERF SPCLRA WRITE ON SCREEN IB SPBINW2,DELOK,DELOK,DEL010 B DEL000 DEL010 LOOK FOR NO CBL GTLEVNR,=D'19',DELNOK DONT DELETE SYSTEMLEV'S PERF IDXGET,GTLEVNR,GSWBIN4,GSWBIN5 BERR DELNOK ERROR BNOK DEL000 NOT FOUND FOUND CHECK IF DELETION ALLOWED I.E. REFERENCES TO TRANSFILE ? CBE GSWBIN4,=W'-1',DELNOK FOUND IN SLAVEARRAY ? IF SO, DONT DELETE PERF LEVRD READ STAMOPL BNOK DELNOK PERF VARRD READ VARIABLE INFO TO CHECK BNOK DELNOK IF DELETION ALLOWED SET GTSWFLAG CBNE GTTRKEY,CBIN0,DEL020 ANY TRANS REFERENCE? CLEAR GTSWFLAG NO B DEL030 DEL020 CBNE GTREGF(CBIN16),=D'0',DELNOK PERF BDTDEL ALLOWED WHEN ZERO-AMOUNT BNOK DELNOK CLEAR GTSWFLAG DEL030 CLEAR GTDYFLG SET GTSPGFLG PERF FMTREM,CBIN3 PERF SPCLRN CLEAR GTSPGFLG IB SPBINW2,DEL000,DEL000,DEL050 B DEL030 DEL050 TBT GTSWFLAG,DELOK ANY TRANSACTIONS PERF IDXDEL DELETE LEV B DELOK DELNOK PERF SETKEY CMP CBIN1,CBIN0 RET DELOK PERF SETKEY CMP CBIN0,CBIN0 RET PEND EJECT LEVRD PROC ********** * * READ AND UNPACK LEVERAND INFORMATION * FOR LEVERAND NO GTLEVNR * ********** PERF IDXGET,GTLEVNR,GSWBIN4,GSWBIN5 GSWBIN5 - LEV INDX GSWBIN4 - INDEX BNOK LEVR090 NOT FOUND MOVE GSWBIN4,=W'128' RECORD SIZE MOVE GTREMBUF,=' ' PERF RAREAD,DK08,=D'8',GTREMBUF,GSWBIN4,GSWBIN5 BNOK LEVR080 CBNE GTWBCD1,=D'4',LEVR020 NO DATA? PERF LEVINT B LEVR050 LEVR020 * UNPACK LEV INFO MOVE GSWBCD7,GTLEVNR STORE LEVNR XCOPY GTLEVNR,CBIN0,CBIN6,GTREMBUF,CBIN0 CBE GTLEVNR,GSWBCD7,LEVR030 MOVE GTLEVNR,GSWBCD7 B LEVR080 LEVR030 PERF XCOP,GTLEVNVN,=W'0',=W'30',GTREMBUF,=W'6' PERF XCOP,GTLEVADR,=W'0',=W'32',GTREMBUF,=W'36' PERF XCOP,GTLEVBY,=W'0',=W'20',GTREMBUF,=W'68' PERF XCOP,GTLEVPNR,=W'0',=W'3',GTREMBUF,=W'88' PERF XCOP,GTLEVPDI,=W'0',=W'13',GTREMBUF,=W'91' MOVE GSWBIN7,=W'30' PERF REPL00,GTLEVNVN,GSWBIN7 MOVE GSWBIN7,=W'32' PERF REPL00,GTLEVADR,GSWBIN7 PERF REPL00,GTLEVBY,CBIN20 PERF REPL00,GTLEVPDI,CBIN13 PERF XCOP,GTLEVBFO,=W'0',=W'1',GTREMBUF,=W'104' PERF XCOP,GTLEVGI,=W'0',=W'4',GTREMBUF,=W'105' PERF XCOP,GTLEVALT,=W'0',=W'6',GTREMBUF,=W'109' MOVE GTLEVDAT,=D'1' SET SIGN PERF XCOP,GTLEVDAT,=W'1',=W'3',GTREMBUF,=W'115' PERF YYMMDD,GTLEVDAT MOVE GTLEVDAT,GSWBCD7 LEVR050 CMP CBIN0,CBIN0 OK RET * LEVR080 LEVR090 CMP CBIN1,CBIN0 NOK RET PEND EJECT LEVWRT PROC ********** * PACK AND WRITE LEV INFORMATION FOR * LEVERAND NR GTLEVNR ********** ADD GTLEVNR,=D'0' PERF WAITF,CREMIO PERF IDXGET,GTLEVNR,GSWBIN4,GSWBIN10 BERR LEVW090 DISK ERROR BNOK LEVW090 NOT FOUND MOVE GTREMBUF,=' ' XCOPY GTREMBUF,CBIN0,CBIN6,GTLEVNR,CBIN0 PERF XCOP,GTREMBUF,=W'6',=W'30',GTLEVNVN,=W'0' PERF XCOP,GTREMBUF,=W'36',=W'32',GTLEVADR,=W'0' PERF XCOP,GTREMBUF,=W'68',=W'20',GTLEVBY,=W'0' PERF XCOP,GTREMBUF,=W'88',=W'3',GTLEVPNR,=W'0' PERF XCOP,GTREMBUF,=W'91',=W'13',GTLEVPDI,=W'0' PERF XCOP,GTREMBUF,=W'104',=W'1',GTLEVBFO,=W'0' PERF XCOP,GTREMBUF,=W'105',=W'4',GTLEVGI,=W'0' PERF XCOP,GTREMBUF,=W'109',=W'6',GTLEVALT,=W'0' PERF YYMMDD,CMASKDAT MOVE GTLEVDAT,GSWBCD7 PERF XCOP,GTREMBUF,=W'115',=W'3',GTLEVDAT,=W'1' PERF RAWRIT,DK08,=D'8',GTREMBUF,GSWBIN10 BNOK LEVW080 CLEAR CREMIO CMP CBIN0,CBIN0 OK RET LEVW080 LEVW090 CLEAR CREMIO CMP CBIN1,CBIN0 NOK RET PEND EJECT LEVINT PROC ********** * * INITIATE STAM INFORMATION FOR * LEVERAND NR GTLEVNR * ********** * MOVE GTLEVNVN,=' ' MOVE GTLEVADR,=' ' MOVE GTLEVBY,=' ' MOVE GTLEVPNR,=D'0' MOVE GTLEVPDI,=' ' MOVE GTLEVBFO,=D'0' MOVE GTLEVGI,=D'0' MOVE GTLEVALT,=D'0' PERF YYMMDD,CMASKDAT MOVE GTLEVDAT,GSWBCD7 RET PEND EJECT LEVSPG PROC ******************************************* * * PROCEDURE FOR FORESP RGSEL P] * LEVERAND RER * ******************************************** LSPG000 MOVE GSWSTR9,='FORESPG. ' SET SPPROMPT SET GTSPGFLG 1. TIME SET GTDYFLG FORESPG TBF GTCYFLG,LSPG005 I CYKEL/STABEL ? TBT GTBDTFLG,LSPG003 YES, BUNDT ? TBF GTSTRFLG,LSPG005 STRAKS ? LSPG003 MOVE GTLEVNR,GTDUPF(CBIN2) CYKEL/STABEL,STRAKS/BUNDT B LSPG010 LSPG005 PERF FMTREM,CBIN3 ATTACH FORMAT PERF SPCLRA WRITE ON SCREEN IB SPBINW2,LSPGOK,LSPGOK,LSPG010 B LSPG000 LSPG010 PERF LEVRD READ STAMINFO BNOK LSPGNOK PERF VARRD READ VARIABLE INFO BNOK LSPGNOK LSPG015 CLEAR GTSWFLAG CLEAR GTDYFLG DISPLAY INFO PERF FMTREM,CBIN3 PERF SPCLRN IB SPBINW2,LSPG000,LSPG000,LSPG100 B LSPG015 LSPG100 OK CONTINUE TO VARIABLE INFO TBT GTVDUFLG,LSPG200 PERF FMTREM,CBIN4 VARIABLE INFO PERF SPCLRN IB SPBINW2,LSPG015,LSPG015,LSPG200 B LSPG100 LSPG200 CBE GTTRKEY,CBIN0,LSPG500 NO TRANS * READ TRANS MOVE GSWBIN8,GTTRKEY POINTER TO FIRST TRANS LSPG205 CLEAR GTSWFLAG PERF TRREAD,GSWBIN8 BNOK LSPG500 MOVE GSWBIN8,GTDUPF(CBIN15) MOVE TEXTNR CBE GSWBIN8,CBIN0,LSPG210 PERF TXTRD,GSWBIN8 AND READ IT LSPG210 PERF FMTREM,CBIN5 PERF SPCLRN IB SPBINW2,LSPG500,LSPG500,LSPG300 B LSPG210 LSPG300 MOVE GSWBIN8,GTDUPF(CBIN22) CBNE GSWBIN8,CBIN0,LSPG205 LSPG500 TBF GTCYFLG,LSPG510 TBT GTBDTFLG,LSPGOK TBT GTSTRFLG,LSPGOK LSPG510 PERF GETNXT GET NEXT LEVNR BNOK LSPG000 B LSPG010 LSPGNOK LSPGOK RET PEND EJECT LEVPRT PROC ********** * PRINT LEVERANDS * ********** TBT GTGTPFLG,LPRT000 TBF GTLPFLG,LPRTRET LPRT000 SET SPPROMPT PERF FMTREM,CBIN6 CLEAR GTZERO MOVE GTBSUM1,=D'51' PHYSICAL HEIGTH OF A PAGE PERF SPCLRA CBNE SPBINW2,CBIN3,LPRTRET NOT <SLUT>? CBNE GTLEVNR,=D'1',LPRT015 SET GTZERO LPRT015 CBNL GTPRTFRA,=D'1',LPRT020 MOVE GTPRTFRA,=D'1' LPRT020 CBNL GTPRTTIL,GTPRTFRA,LPRT030 MOVE GTPRTTIL,=D'9999999998' LAST TO PRINT LPRT030 CLEAR GTSWFLAG SET GTDYFLG CBE GTLEVBFO,=D'1',LPRT040 CLEAR GTDYFLG NOT VAR INFO LPRT040 TBF GTLPFLG,LPRT045 EDWRT DSHCLP,FFEED FORM FEED LPRT045 PERF YYMMDD,GTPRTDAT MOVE GTPRTDAT,GSWBCD7 GTPRTDAT: YYMMDD MOVE GTLEVNR,GTPRTFRA SET FIRST NO. TO PRINT SUB GTLEVNR,=D'1' LPRT049 PERF GETNXT BNOK LPRTRET CBG GTLEVNR,GTPRTTIL,LPRTRET PERF LEVRD BNOK LPRT110 NOT FOUND PERF YYMMDD,GTLEVDAT CBL GSWBCD7,GTPRTDAT,LPRT100 TBF GTDYFLG,LPRT080 SUB GTBSUM1,=D'3' 7 LINES PERF VARRD BNOK LPRT110 LPRT080 SUB GTBSUM1,=D'4' 4 LINES TBT GTLPFLG,LPRT095 EDWRT DSHCGP,FLEVPRT GTP CBG GTBSUM1,=D'8',LPRT100 MORE ROOM? MOVE GSWBIN7,GTBSUM1 PERF NEWLIN,GSWBIN7 SKIP REST OF PAGE MOVE GTBSUM1,=D'51' B LPRT100 LPRT095 EDWRT DSHCLP,FLEVPRT LP CBG GTBSUM1,=D'8',LPRT100 EDWRT DSHCLP,FFEED MOVE GTBSUM1,=D'51' LPRT100 TO NEXT TBF GTDYFLG,LPRT110 TBF GTZERO,LPRT110 MOVE GTREGF(CBIN12),=D'0' PERF VARWRT REWRITE WITH SALE YTD = 0 BNOK LPRTRET LPRT110 PERF KBTEST BNOK LPRT049 LPRTRET RET PEND EJECT VARRD PROC ********** * * READ AND UNPACK VARIABLE INFORMATION * FOR LEVERAND NR GTLEVNR * ********** * PERF IDXGET,GTLEVNR,GSWBIN4,GSWBIN5 GSWBIN5 LEV INDEX GSWBIN4 INDEX BERR VARR090 DISK ERROR BNOK VARR090 NOT FOUND FOUND MOVE GSWBIN4,=W'49' RECORD SIZE MOVE GTREMBUF,=' ' PERF RAREAD,DK09,=D'9',GTREMBUF,GSWBIN4,GSWBIN5 BNOK VARR080 CBE GTWBCD1,=D'4',VARR040 * UNPACK VAR INFO MOVE GSWBCD7,GTLEVNR STORE LEVNR XCOPY GTLEVNR,CBIN0,CBIN6,GTREMBUF,CBIN0 CBE GTLEVNR,GSWBCD7,VARR030 MOVE GTLEVNR,GSWBCD7 NOT CORRECT RECORD B VARR080 VARR030 MOVE GSWBCD7,=D'1' INITIATE RECEIVING FIELD XCOPY GSWBCD7,CBIN4,CBIN3,GTREMBUF,CBIN6 MOVE GTREGF(CBIN10),GSWBCD7 UDB DATO XCOPY GSWBCD7,CBIN0,CBIN7,GTREMBUF,CBIN9 MOVE GTREGF(CBIN11),GSWBCD7 UDB BELOB XCOPY GSWBCD7,CBIN0,CBIN7,GTREMBUF,CBIN16 MOVE GTREGF(CBIN12),GSWBCD7 UDB ]TD PERF XCOP,GSWBCD7,=W'0',=W'7',GTREMBUF,=W'23' MOVE GTREGF(CBIN14),GSWBCD7 VENT DEBET PERF XCOP,GSWBCD7,=W'0',=W'7',GTREMBUF,=W'30' MOVE GTREGF(CBIN15),GSWBCD7 VENT KREDIT MOVE GTREGF(CBIN16),GSWBCD7 SKYLDIGT BEL. ADD GTREGF(CBIN16),GTREGF(CBIN14) MOVE GSWBCD7,=D'1' SET SIGN PERF XCOP,GSWBCD7,=W'4',=W'3',GTREMBUF,=W'37' MOVE GTREGF(CBIN13),GSWBCD7 VAL DATO PERF XCOP,GTTRKEY,=W'0',=W'2',GTREMBUF,=W'47' B VARR050 VARR040 PERF VARINT VARR050 CMP CBIN0,CBIN0 OK RET * VARR080 VARR090 CMP CBIN1,CBIN0 NOK RET PEND EJECT VARWRT PROC ********** * PACK AND WRITE VARIABLE INFORMATION FOR * LEVERAND NO GTLEVNR ********** PERF WAITF,CREMIO PERF IDXGET,GTLEVNR,GSWBIN4,GSWBIN10 BNOK VARW090 MOVE GTREMBUF,=' ' ADD GTLEVNR,=D'0' XCOPY GTREMBUF,CBIN0,CBIN6,GTLEVNR,CBIN0 MOVE GSWBCD6,GTREGF(CBIN10) UDB DATO PERF YYMMDD,GSWBCD6 XCOPY GTREMBUF,CBIN6,CBIN3,GSWBCD7,CBIN4 MOVE GSWBCD7,GTREGF(CBIN11) UDB BELOB XCOPY GTREMBUF,CBIN9,CBIN7,GSWBCD7,CBIN0 MOVE GSWBCD7,GTREGF(CBIN12) UDB ]TD XCOPY GTREMBUF,CBIN16,CBIN7,GSWBCD7,CBIN0 MOVE GSWBCD7,GTREGF(CBIN14) VENT DEBET PERF XCOP,GTREMBUF,=W'23',=W'7',GSWBCD7,=W'0' MOVE GSWBCD7,GTREGF(CBIN15) VENT KREDIT PERF XCOP,GTREMBUF,=W'30',=W'7',GSWBCD7,=W'0' MOVE GSWBCD7,GTREGF(CBIN13) VAL DATO PERF XCOP,GTREMBUF,=W'37',=W'3',GSWBCD7,=W'4' PERF XCOP,GTREMBUF,=W'47',=W'2',GTTRKEY,=W'0' PERF RAWRIT,DK09,=D'9',GTREMBUF,GSWBIN10 BNOK VARW090 CLEAR CREMIO CMP CBIN0,CBIN0 OK RET VARW090 CLEAR CREMIO CMP CBIN1,CBIN0 NOK RET PEND EJECT VARINT PROC ********** * * INITIATE VARIABLE INFO FOR * LEVERAND NR GTLEVNR * ********** MOVE GTREGF(CBIN10),=D'0' UDB DATO MOVE GTREGF(CBIN11),=D'0' UDB BELOB MOVE GTREGF(CBIN12),=D'0' UDB ]TD MOVE GTREGF(CBIN14),=D'0' VENT DEBET MOVE GTREGF(CBIN15),=D'0' VENT KREDIT MOVE GTREGF(CBIN16),=D'0' MOVE GTREGF(CBIN13),=D'0' VAL DATO MOVE GTTRKEY,CBIN0 TRANS POINTER RET PEND EJECT IDXGET PROC LEVNR,INDX,LEVDEX ******************************************** * * PROCEDURE FOR SEARCHING IN INDEXFILE FOR * A GIVE LEVNO. * LYNGBY SPECIAL: * THIS KOMMUNE HAS A SPECIAL FORM FOR INDEXFILE, AS THEY HAVE * A SLAVEFILE, CONTAINING THE ADDITIONS SINCE LAST <ADM 46>. * IF A LEVNR IS FOUND IN THIS SLAVEFILE,<INDX> WILL BE * SET TO -1. * * IF FOUND - CONDITION REGISTER IS SET TO OK * INDX RELATIVE RECORD IN INDEXFILE * LEVDEX POINTER INTO STAM/VAR * * IF NOT FOUND - CONDITION REGISTER IS SET TO NOK = 1 * INDX INDEX TO PLACE TO INSERT * LEVDEX 0 * * IF DISKERR - CONDITION REGISTER IS SET TO ERR = 2 * INDEX 0 * LEVDEX =0 * ******************************************** IGET000 TBF C173FLG,IGET008 LYNGBY? PERF MEMIX1,LEVNR,INDX,LEVDEX BOK IGET400 IGET008 MOVE GSWBIN5,CBIN0 GROUP MOVE GSWBIN4,CBIN0 RECORD IGET010 ADD GSWBIN4,=W'48' ADD GSWBIN5,CBIN1 SEARCH FOR GROUP CBG GSWBIN4,CIXLAST,IGET020 RETURN NOT FOUND CBL CIXINDX(GSWBIN5),LEVNR,IGET010 B IGET030 TRY NEXT IGET020 NOT FOUND MOVE INDX,CIXFREE PLACE TO INSERT MOVE LEVDEX,CBIN0 CMP CBIN1,CBIN0 NOK RET IGET030 GROUP FOUND LEVNR WITHIN THIS GROUP GROUP GSWBIN5 SUB GSWBIN4,=W'48' * FIND INDEX, USING BINARY SEARCH INITIATE BINARY SERCH MOVE GTSCHLOW,CBIN1 LOWER LIMIT- GTSCHLOW MOVE GTSCHHGH,=W'48' UPPER LIMIT - GTSCHHGH IGET110 CBL GTSCHHGH,GTSCHLOW,IGETNOK1 UPPER<LOWER, NOT FOUND MOVE GTSCHMID,GTSCHLOW INDEX=LOWER ADD GTSCHMID,GTSCHHGH ADD UPPER DIV GTSCHMID,CBIN2 FIND MIDPOINT * READ LEV INFO, TO GSWBCD7 ADD GSWBIN4,GTSCHMID GSWBIN4=RECORD NUMBER MOVE GSWBIN5,CBIN7 SIZE MOVE GTREMBUF,=' ' PERF RAREAD,DK07,=D'7',GTREMBUF,GSWBIN5,GSWBIN4 BNOK IGET300 MOVE GSWBCD7,=D'1' SET SIGN XCOPY GSWBCD7,CBIN2,CBIN5,GTREMBUF,CBIN0 SUB GSWBIN4,GTSCHMID GSWBIN4= START OF SECTOR CMP GSWBCD7,LEVNR BE IGET200 FOUND BL IGET130 LOOK UP MOVE GTSCHHGH,GTSCHMID MOVE MIDPOINT TO DOWNPER SUB GTSCHHGH,CBIN1 -1 B IGET110 IGET130 MOVE GTSCHLOW,GTSCHMID MOVE MIDPOINT TO LOWER ADD GTSCHLOW,CBIN1 +1 B IGET110 IGET200 FOUND ADD GSWBIN4,GTSCHMID GSWBIN4=RECORD NUMBER MOVE INDX,GSWBIN4 SET INDEX XCOPY GSWBIN5,CBIN0,CBIN2,GTREMBUF,CBIN5 MOVE LEVDEX,GSWBIN5 SET LEV INDX CMP CBIN0,CBIN0 RETURN OK RET IGETNOK1 ADD GSWBIN4,GTSCHLOW RECORD NUMBER FOR INSERT MOVE LEVDEX,CBIN0 MOVE INDX,GSWBIN4 PLACE TO INSERT CMP CBIN1,CBIN0 NOK RET IGET300 SET COND = ERR MOVE LEVDEX,CBIN0 MOVE INDX,CBIN0 CMP CBIN0,CBIN1 IGET400 RET PEND EJECT IDXINS PROC ********** * * INSERT GTLEVNR IN INDEXFILE * ********** CBG CIXFREE,CIXLAST,XINSNOK2 NO ROOM PERF WAITF,CREMIO PERF IDXGET,GTLEVNR,GSWBIN4,GSWBIN5 GSWBIN5 LEV INDEX GSWBIN4 INDEX BERR XINSNOK1 DISK ERROR BOK XINSNOK1 ALREADY PRESENT * NOT FOUND, INSERT TBF C173FLG,XINS000 CBNG GTLEVNR,=D'15',XINS000 PERF UPDMEM UPDATE SLAVEARRAY ON BOK XINSOK DISK AND IN MEMORY B XINSNOK XINS000 MOVE GSWBIN8,GSWBIN4 PLACE FOR INSERTION MOVE GSWBIN1,CBIN7 PERF RAREAD,DK07,=D'7',GTREMBUF,GSWBIN1,CIXFREE BNOK XINSNOK XCOPY GSWBIN7,CBIN0,CBIN2,GTREMBUF,CBIN5 MOVE GSWBIN4,CIXFREE START OF LOOP ADD CIXFREE,CBIN1 NEW FIRST FREE SUB GSWBIN4,CBIN1 * XINS100 CBL GSWBIN4,GSWBIN8,XINS200 ALL MOVED? NO. MOVE GSWBIN1,CBIN7 PERF RAREAD,DK07,=D'7',GTREMBUF,GSWBIN1,GSWBIN4 BNOK XINSNOK ADD GSWBIN4,CBIN1 PERF RAWRIT,DK07,=D'7',GTREMBUF,GSWBIN4 BNOK XINSNOK SUB GSWBIN4,CBIN2 B XINS100 * XINS200 * ALL MOVED, INSERT LEVNR+INDEX ADD GTLEVNR,=D'0' XCOPY GTREMBUF,CBIN0,CBIN5,GTLEVNR,CBIN1 XCOPY GTREMBUF,CBIN5,CBIN2,GSWBIN7,CBIN0 PERF RAWRIT,DK07,=D'7',GTREMBUF,GSWBIN8 MOVE GSWBIN4,GSWBIN8 PLACE FOR INSERTION PERF RESTIX XINSOK CLEAR CREMIO CMP CBIN0,CBIN0 OK RET XINSNOK PERF RESTIX XINSNOK1 CLEAR CREMIO XINSNOK2 CMP CBIN1,CBIN0 NOK RET PEND EJECT SETIDX PROC ************************************* * * INITIATE MASTER INDEX FOR LEV-REGISTER * IF INDEX EMPTY, SET UP ALL ENTRIES AND * INITIATE SPECIAL ENTRIES * * SETS: * CIXLAST - LAST RECORD NO. * CIXFREE - FIRST FREE ENTRY * ************************************** MOVE GSWBIN4,CBIN1 MOVE GSWBIN5,CBIN7 MOVE GTREMBUF,=' ' PERF RAREAD,DK07,=D'7',GTREMBUF,GSWBIN5,GSWBIN4 CBE GTWBCD1,=D'4',SIDX005 NO DATA ? MOVE GSWBCD7,=D'1' > 0 XCOPY GSWBCD7,CBIN2,CBIN5,GTREMBUF,CBIN0 GET 1. LEV CBE GSWBCD7,=D'1',SIDX100 IF NOT LEVNR 1 SIDX005 INITIATE INDEX FILE * INITIATE INDEX FILE WITH BLANK ENTRIES MOVE GSWBIN4,CBIN0 SIDX050 ADD GSWBIN4,CBIN1 MOVE GTWBCD2,GSWBIN4 PERF SPLIN8,CBIN10,CBIN3 MOVE GTREMBUF,=X'99' XCOPY GTREMBUF,CBIN5,CBIN2,GSWBIN4,CBIN0 SET INDEX PERF RAWRIT,DK07,=D'7',GTREMBUF,GSWBIN4 BOK SIDX050 PERF CLEAR8 TBF C173FLG,SIDX100 MOVE GSWBIN4,=W'48' ADD GSWBIN4,CBIN1 MOVE CMEMIX(GSWBIN4),=D'9999999999' MOVE CMEMPT(GSWBIN4),=X'7FFF' MOVE GSWBIN4,=W'48' SIDX060 MOVE GTREMBUF,=X'99' PERF RAWRIT,DK17,=D'17',GTREMBUF,GSWBIN4 SUB GSWBIN4,CBIN1 BP SIDX060 SIDX100 * OK, FIRST LEV = 0000000000 * LOOP THROUGH INDEX FILE TO SET UP * MASTER INDEX IN CORE, AND TO FIND * SIZE OF INDEX FILE MOVE CIXLAST,=X'7FFF' MOVE CIXFREE,CBIN0 MOVE GSWBIN4,CBIN1 SIDX110 MOVE GTWBCD2,GSWBIN4 PERF SPLIN8,CBIN10,CBIN3 MOVE GSWBIN5,CBIN7 MOVE CIXLAST,GSWBIN4 MOVE GTREMBUF,=' ' PERF RAREAD,DK07,=D'7',GTREMBUF,GSWBIN5,GSWBIN4 READ RECORD CBE GTWBCD1,=D'10',SIDX130 END OF DEVICE CBE GTWBCD1,=D'4',SIDX120 NO-DATA ? MOVE GSWSTR9,=' ' XCOPY GSWSTR20,CBIN0,CBIN5,GTREMBUF,CBIN0 MOVE GSWBIN5,CBIN0 REPLACE SPACE WITH 9999999999 MATCH GSWSTR9,GSWBIN5,CBIN5,GSWSTR20,CBIN0,CBIN5 BNE SIDX125 NOT 2020202020 THIS TIME SIDX120 MOVE GSWSTR9,=X'99' FOR NO-DATA AND 2020202020 XCOPY GTREMBUF,CBIN0,CBIN5,GSWSTR9,CBIN0 XCOPY GTREMBUF,CBIN5,CBIN2,GSWBIN4,CBIN0 CREATE INDEX PERF RAWRIT,DK07,=D'7',GTREMBUF,GSWBIN4 REWRITE RECORD B SIDX127 SIDX125 MOVE GSWBIN5,CBIN0 MOVE GSWSTR9,=X'99' MATCH GTREMBUF,GSWBIN5,CBIN5,GSWSTR9,CBIN0,CBIN5 BE SIDX130 FIRST FREE SIDX127 ADD GSWBIN4,CBIN1 B SIDX110 SIDX130 BLANK OR EOF MOVE CIXFREE,GSWBIN4 FIRST FREE ENTRY MOVE GSWBIN8,CBIN1 FIRST ENTRY IN CIXINDX MOVE GSWBIN5,=W'48' CORR. TO THE 48. RECORD SIDX150 MOVE GTWBCD2,GSWBIN5 PERF SPLIN8,CBIN10,CBIN3 MOVE GSWBIN1,CBIN7 LENGTH PERF RAREAD,DK07,=D'7',GTREMBUF,GSWBIN1,GSWBIN5 CBE GTWBCD1,=D'10',SIDX160 EOD? ADD GSWBIN5,=W'48' B SIDX150 SIDX160 SUB GSWBIN5,=W'48' MOVE CIXLAST,GSWBIN5 TBF C173FLG,SIDX162 MOVE GSWBIN1,=W'50' MOVE CMEMPT(GSWBIN1),CIXLAST SORRY AGAIN! PERF MEMIX2 SLAVE ARRAY INTO MEMORY SIDX162 PERF RESTIX MASTER INDEX INTO MEMORY PERF CLEAR8 PERF INITIX COLD START STAM+VAR+TRANS? RET PEND EJECT IDXDEL PROC ********** * * DELETE ALL ENTRIES FOR LEV NR. * GTLEVNR, IN * INDEXFILE, STAM, AND VAR FILE * ********** * PERF WAITF,CREMIO PERF IDXGET,GTLEVNR,GSWBIN4,GSWBIN5 GSWBIN5 LEV INDX GSWBIN4 INDEX BERR XDEL300 DISK ERROR BNOK XDEL300 NOT FOUND * FOUND CBE GSWBIN4,=W'-1',XDEL300 DONT DELETE IF IN SLAVE MOVE GSWBIN7,GSWBIN5 KEEP LEVDEX XDEL100 ADD GSWBIN4,CBIN1 NEXT RECORD TO MOVE CBNL GSWBIN4,CIXFREE,XDEL200 MOVE GSWBIN1,CBIN7 LENGTH PERF RAREAD,DK07,=D'7',GTREMBUF,GSWBIN1,GSWBIN4 BNOK XDELNOK SUB GSWBIN4,CBIN1 WHERE TO MOVE PERF RAWRIT,DK07,=D'7',GTREMBUF,GSWBIN4 BNOK XDELNOK ADD GSWBIN4,CBIN1 B XDEL100 * XDEL200 INSERT NEW FREE SUB CIXFREE,CBIN1 PERF RADEL,DK09,GSWBIN5 DELETE VAR RECORD PERF RADEL,DK08,GSWBIN5 MOVE GTREMBUF,=X'99' XCOPY GTREMBUF,CBIN5,CBIN2,GSWBIN7,CBIN0 PERF RAWRIT,DK07,=D'7',GTREMBUF,CIXFREE BNOK XDELNOK PERF RESTIX CLEAR CREMIO CMP CBIN0,CBIN0 OK RET * XDELNOK PERF RESTIX XDEL300 CLEAR CREMIO CMP CBIN1,CBIN0 NOK RET PEND EJECT RESTIX PROC ********************************************** * * ********************************************** MOVE GSWBIN8,CBIN1 MOVE GSWBIN5,=W'48' RIX010 TBF C173FLG,RIX012 MOVE GSWBIN1,=W'50' CBG GSWBIN5,CMEMPT(GSWBIN1),RIX020 RIX012 MOVE GSWBIN1,CBIN7 PERF RAREAD,DK07,=D'7',GTREMBUF,GSWBIN1,GSWBIN5 CBE GTWBCD1,=D'10',RIX020 MOVE GSWBCD7,=D'1' XCOPY GSWBCD7,CBIN2,CBIN5,GTREMBUF,CBIN0 MOVE CIXINDX(GSWBIN8),GSWBCD7 ADD GSWBIN5,=W'48' ADD GSWBIN8,CBIN1 B RIX010 RIX020 SUB GSWBIN8,CBIN1 RIX055 CBNE CIXINDX(GSWBIN8),=D'0',RIXOK MOVE CIXINDX(GSWBIN8),=D'9999999999' SUB GSWBIN8,CBIN1 BP RIX055 RIXOK CMP CBIN0,CBIN0 RET PEND EJECT INITIX PROC **************************************** * * SET UP INDEXFILE 1. TIME * CHECK IF SYSTEM DEFINED ENTRIES * ARE PRESENT, ELSE INSERT THEM * * NEXT 15 RECORDS, LEV 1-15, POINTS TO * DIFFERENT SYSTEM DEFINED LISTS, * 01 - PRINT LIST CHECK * 02 - PRINT LIST GIRO * 03 - * 04 - * 05 - "HOMELESS" TRANSACTIONS AFTER REORG * 06 - AS 01 * 07 - AS 02 * 08 - AS 03 * 09 - AS 02 * 10 - LIST CONTAINING ALL FREE RECORDS * 11 - PRINT LIST CHECK (CREDITLINES) * 12 - PRINT LIST GIRO (CREDITLINES) * 13 - * 14 - * 15 - NOT USED * **************************************** MOVE GTLEVNR,=D'1' PERF IDXGET,GTLEVNR,GSWBIN4,GSWBIN5 GSWBIN5 LEV INDEX GSWBIN4 INDEX BERR INITNOK DISK ERROR BOK INITOK * INIT100 * INSERT SYSTEMENTRIES (LEVNR 0 -> 15) PERF IDXINS PERF LEVINT PERF LEVWRT PERF VARINT PERF VARWRT INIT150 ADD GTLEVNR,=D'1' CBNG GTLEVNR,=D'15',INIT100 * INIT300 * INIT TRANSFILE IE LOOP THROUGH FILE * AND SET ALL RECORDS ON FREE LIST INITOK PERF TRINIT BNOK INITNOK PERF RESTIX CMP CBIN0,CBIN0 OK RET INITNOK PERF RESTIX CMP CBIN1,CBIN0 NOK RET PEND EJECT GETNXT PROC ********************************* * * GET LEVNR FOR LEV FOLLOWING GTLEVNR * ********************************* TBF C173FLG,GNXT000 PERF DIVRUT,CBIN1 LYNGBYVERSION OF GETNXT RET GNXT000 PERF IDXGET,GTLEVNR,GSWBIN4,GSWBIN5 BERR GNXTNOK BOK GNXT100 SUB GSWBIN4,CBIN1 NOT FOUND GNXT100 ADD GSWBIN4,CBIN1 CBNL GSWBIN4,CIXFREE,GNXT200 MOVE GSWBIN1,CBIN7 MOVE GTREMBUF,=' ' PERF RAREAD,DK07,=D'7',GTREMBUF,GSWBIN1,GSWBIN4 BNOK GNXT200 MOVE GTLEVNR,=D'1' XCOPY GTLEVNR,CBIN1,CBIN5,GTREMBUF,CBIN0 CMP CBIN0,CBIN0 RET GNXT200 GNXTNOK CMP CBIN1,CBIN0 RET PEND EJECT FLEVPRT FRMT PRINT OF LEVERAND. FNL FILLR '*',1 FMEL '9999999999',GTLEVNR FTEXT ' * ' FMEL '99V99V99',CMASKDAT FILLR ' ',2 FMEL '99V99V99',GTLEVDAT FILLR ' ',4 FMEL '9',GTLEVBFO FILLR ' ',2 FMEL 'XXXXXXX',GTLEVGI FILLR ' ',2 FMEL 'XXXXXXXXXX',GTLEVALT FNL FCOPY GTLEVNVN FILLR ' ',2 FCOPY GTLEVADR FILLR ' ',2 FCOPY GTLEVBY FILLR ' ',2 FMEL '9999',GTLEVPNR FILLR ' ',2 FCOPY GTLEVPDI FNL FBF GTDYFLG,FLEV190 FNL FTEXT ']TD:' FILLR ' ',3 FMEL '99V99V99',GTREGF(CBIN10) FMEL 'BZZZVZZZVZZ9E,99-',GTREGF(CBIN11) FMEL 'BZZZVZZZVZZ9E,99-',GTREGF(CBIN12) FNL FCOPY ='REMIT: ' FMEL '99V99V99',GTREGF(CBIN13) FMEL 'BZZZVZZZVZZ9E,99-',GTREGF(CBIN14) FMEL 'BZZZVZZZVZZ9E,99-',GTREGF(CBIN15) FMEL 'BZZZVZZZVZZ9E,99-',GTREGF(CBIN16) FNL FLEV190 FNL FMEND * * * FFEED FRMT FILLR '1',2 FMEND * * * * END