|
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: 33360 (0x8250)
Notes: pts_type(SC)
Names: »REMLEV.SC«
└─⟦75255755f⟧ Bits:30009693 Philips computer tape "600410"
└─⟦this⟧ »NJREMIT/REMLEV.SC«
└─⟦b6546aa17⟧ Bits:30009689 Philips computer tape "600325"
└─⟦this⟧ »REMIT2/REMLEV.SC«
IDENT REMLEV 03.01.XXX.1 DDUM KMD08 PDIV ENTRY LEVOPR ENTRY LEVRD ENTRY VARRD ENTRY VARWRT ENTRY GETNXT ENTRY IDXGET ENTRY LEVDEL ENTRY SETIDX ENTRY LEVSPG ENTRY LEVPRT ENTRY CHDATO ENTRY LEVIN ENTRY XCOP 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 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 A LEVERAND R. * ALL DISKFILES CONCERNED ARE UPDATED, * AS WELL AS THE MASTERINDEX IN CORE. * ***************************************** OPR000 MOVE SPKEY,CBIN2 MOVE GTLEVDAT,CMASKDAT SET CURRENT DATE 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 MOVE GSWBIN1,GTLEVBFO IB GSWBIN1, C OPR040,OPR035,OPR035,OPR040,OPR040, C OPR040,OPR035,OPR035,OPR040 B OPR040 OPR035 CBG GTLEVGI,=D'1',OPR040 OK MOVE SPBINW4,CBIN5 PERF SPERR NOK B OPR015 OPR040 PERF IDXGET,GTLEVNR,GSWBIN4,GSWBIN5 BERR OPROK 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 BNOK OPR070 B OPR000 NEW LEV INSERTED 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 ? OK, MAY BE DELETED PERF LEVRD READ STAMOPL PERF VARRD READ VARIABLE INFO TO CHECK IF DELETION ALLOWED SET GTSWFLAG CBG GTTRKEY,CBIN0,DEL020 ANY TRANS REFERENCE ? CLEAR GTSWFLAG NO B DEL030 DEL020 CBNE GTREGF(CBIN16),=D'0',DEL030 PERF BDTDEL ALLOWED WHEN ZERO-AMOUNT 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 F=NO 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 WAITF,CLEVFLG PERF IDXGET,GTLEVNR,GSWBIN4,GSWBIN5 GSWBIN5 - LEV INDX GSWBIN4 - INDEX BERR LEVRNOK DISK ERROR BNOK LEVRNOK NOT FOUND FOUND READ LEV MOVE GSWBIN4,=W'128' RECORD SIZE MOVE CLEVBUF,CBLANKS PERF RAREAD,DK08,=D'8',CLEVBUF,GSWBIN4,GSWBIN5 BNOK LEVRNOK * UNPACK LEV INFO MOVE GSWBCD7,GTLEVNR STORE LEVNR PERF XCOP,GTLEVNR,=W'0',=W'6',CLEVBUF,=W'0' CBE GTLEVNR,GSWBCD7,LEVR030 MOVE GTLEVNR,GSWBCD7 NOT CORRECT RECORD B LEVRNOK LEVR030 PERF XCOP,GTLEVNVN,=W'0',=W'30',CLEVBUF,=W'6' PERF XCOP,GTLEVADR,=W'0',=W'32',CLEVBUF,=W'36' PERF XCOP,GTLEVBY,=W'0',=W'20',CLEVBUF,=W'68' PERF XCOP,GTLEVPNR,=W'0',=W'3',CLEVBUF,=W'88' PERF XCOP,GTLEVPDI,=W'0',=W'13',CLEVBUF,=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',CLEVBUF,=W'104' PERF XCOP,GTLEVGI,=W'0',=W'4',CLEVBUF,=W'105' PERF XCOP,GTLEVALT,=W'0',=W'6',CLEVBUF,=W'109' MOVE GTLEVDAT,=D'1' SET SIGN PERF XCOP,GTLEVDAT,=W'1',=W'3',CLEVBUF,=W'115' * CLEAR CLEVFLG RELEASE BUFFER CMP CBIN0,CBIN0 OK RET * LEVRNOK CLEAR CLEVFLG RELEASE BUFFER CMP CBIN1,CBIN0 NOK RET PEND EJECT * LEVWRT PROC ********** * * PACK AND WRITE LEV INFORMATION FOR * LEVERAND NR GTLEVNR * ********** * PERF WAITF,CLEVFLG * PACK LEV INFO MOVE CLEVBUF,CBLANKS PERF XCOP,CLEVBUF,=W'0',=W'6',GTLEVNR,=W'0' PERF XCOP,CLEVBUF,=W'6',=W'30',GTLEVNVN,=W'0' PERF XCOP,CLEVBUF,=W'36',=W'32',GTLEVADR,=W'0' PERF XCOP,CLEVBUF,=W'68',=W'20',GTLEVBY,=W'0' PERF XCOP,CLEVBUF,=W'88',=W'3',GTLEVPNR,=W'0' PERF XCOP,CLEVBUF,=W'91',=W'13',GTLEVPDI,=W'0' PERF XCOP,CLEVBUF,=W'104',=W'1',GTLEVBFO,=W'0' PERF XCOP,CLEVBUF,=W'105',=W'4',GTLEVGI,=W'0' PERF XCOP,CLEVBUF,=W'109',=W'6',GTLEVALT,=W'0' MOVE GTLEVDAT,CMASKDAT PERF XCOP,CLEVBUF,=W'115',=W'3',GTLEVDAT,=W'1' * WRITE PERF IDXGET,GTLEVNR,GSWBIN4,GSWBIN5 GSWBIN5 LEV INDX GSWBIN4 INDEX BERR LEVWNOK DISK ERROR BNOK LEVWNOK NOT FOUND FOUND PERF RAWRIT,DK08,=D'8',CLEVBUF,GSWBIN5 BNOK LEVWNOK * CLEAR CLEVFLG RELEASE BUFFER CMP CBIN0,CBIN0 OK RET * LEVWNOK CLEAR CLEVFLG RELEASE BUFFER CMP CBIN1,CBIN0 NOK RET PEND EJECT * LEVINT PROC ********** * * INITIATE STAM INFORMATION FOR * LEVERAND NR GTLEVNR * ********** * MOVE GTLEVNVN,CBLANKS MOVE GTLEVADR,CBLANKS MOVE GTLEVBY,CBLANKS MOVE GTLEVPNR,=D'0' MOVE GTLEVPDI,CBLANKS MOVE GTLEVBFO,=D'0' MOVE GTLEVGI,=D'0' MOVE GTLEVALT,=D'0' MOVE GTLEVDAT,CMASKDAT 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 IDXGET,GTLEVNR,GSWBIN4,GSWBIN5 GSWBIN5 - LEVINDX GSWBIN4 INDEX BERR LSPGNOK DISK ERROR BNOK LSPGNOK NOT FOUND * LEV NR GTLEVNR FOUND 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 B LSPG210 DISPLAY CONTENTS LSPG210 PERF FMTREM,CBIN5 PERF SPCLRN IB SPBINW2,LSPG500,LSPG500,LSPG300 B LSPG210 LSPG300 MOVE GSWBIN8,GTDUPF(CBIN22) CBE GSWBIN8,CBIN0,LSPG500 TRANS' EXHAUSTED ? B LSPG205 NO, GET NEXT 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 PERF SPCLRA CBNE SPBINW2,CBIN3,LPRTRET NOT <SLUT>? CBNE GTLEVNR,=D'1',LPRT015 SET GTZERO LPRT015 CBNL GTPRTFRA,=D'1',LPRT020 MOVE GTPRTFRA,=D'15' FIRST LEV - 1 LPRT020 CBNL GTPRTTIL,GTPRTFRA,LPRT030 MOVE GTPRTTIL,=D'9999999999' 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 MOVE GSWBCD6,GTPRTDAT GTPRTDAT: DDMMYY PERF CHDATO MOVE GTPRTDAT,GSWBCD7 GTPRTDAT: YYMMDD MOVE GTLEVNR,GTPRTFRA SET FIRST NO. TO PRINT LPRT049 PERF GETNXT BNOK LPRTRET LPRT050 CBG GTLEVNR,GTPRTTIL,LPRTRET PERF LEVRD BNOK LPRT110 NOT FOUND MOVE GSWBCD6,GTLEVDAT GTLEVDAT: DDMMYY PERF CHDATO GSWBCD7: YYMMDD CBL GSWBCD7,GTPRTDAT,LPRT100 TBF GTDYFLG,LPRT080 PERF VARRD BNOK LPRT110 LPRT080 * FLIP FLOP FOR LINEFEEDS TBT GTSWFLAG,LPRT085 SET GTSWFLAG B LPRT090 LPRT085 CLEAR GTSWFLAG LPRT090 TBT GTLPFLG,LPRT095 EDWRT DSHCGP,FLEVPRT GTP B LPRT100 LPRT095 EDWRT DSHCLP,FLEVPRT LP 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 BOK LPRTRET MAK KEY B LPRT049 LPRTRET RET PEND EJECT * VARRD PROC ********** * * READ AND UNPACK VARIABLE INFORMATION * FOR LEVERAND NR GTLEVNR * ********** * PERF WAITF,CVARFLG PERF IDXGET,GTLEVNR,GSWBIN4,GSWBIN5 GSWBIN5 LEV INDEX GSWBIN4 INDEX BERR VARRNOK DISK ERROR BNOK VARRNOK NOT FOUND FOUND MOVE GSWBIN4,=W'49' RECORD SIZE MOVE CVARBUF,CBLANKS PERF RAREAD,DK09,=D'9',CVARBUF,GSWBIN4,GSWBIN5 BNOK VARRNOK * UNPACK VAR INFO MOVE GSWBCD7,GTLEVNR STORE LEVNR PERF XCOP,GTLEVNR,=W'0',=W'6',CVARBUF,=W'0' CBE GTLEVNR,GSWBCD7,VARR030 MOVE GTLEVNR,GSWBCD7 NOT CORRECT RECORD B VARRNOK VARR030 MOVE GSWBCD7,=D'1' INITIATE RECEIVING FIELD PERF XCOP,GSWBCD7,=W'4',=W'3',CVARBUF,=W'6' MOVE GTREGF(CBIN10),GSWBCD7 UDB DATO PERF XCOP,GSWBCD7,=W'0',=W'7',CVARBUF,=W'9' MOVE GTREGF(CBIN11),GSWBCD7 UDB BELOB PERF XCOP,GSWBCD7,=W'0',=W'7',CVARBUF,=W'16' MOVE GTREGF(CBIN12),GSWBCD7 UDB ]TD PERF XCOP,GSWBCD7,=W'0',=W'7',CVARBUF,=W'23' MOVE GTREGF(CBIN14),GSWBCD7 VENT DEBET PERF XCOP,GSWBCD7,=W'0',=W'7',CVARBUF,=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',CVARBUF,=W'37' MOVE GTREGF(CBIN13),GSWBCD7 VAL DATO PERF XCOP,GTTRKEY,=W'0',=W'2',CVARBUF,=W'47' CLEAR CVARFLG RELEASE BUFFER CMP CBIN0,CBIN0 OK RET * VARRNOK CLEAR CVARFLG RELEASE BUFFER CMP CBIN1,CBIN0 NOK RET PEND EJECT * VARWRT PROC ********** * * PACK AND WRITE VARIABLE INFORMATION FOR * LEVERAND NO GTLEVNR * ********** * PERF WAITF,CVARFLG * PACK VARIABLE INFORMATION MOVE CVARBUF,CBLANKS PERF XCOP,CVARBUF,=W'0',=W'6',GTLEVNR,=W'0' MOVE GSWBCD7,GTREGF(CBIN10) UDB DATO PERF XCOP,CVARBUF,=W'6',=W'3',GSWBCD7,=W'4' MOVE GSWBCD7,GTREGF(CBIN11) UDB BELOB PERF XCOP,CVARBUF,=W'9',=W'7',GSWBCD7,=W'0' MOVE GSWBCD7,GTREGF(CBIN12) UDB ]TD PERF XCOP,CVARBUF,=W'16',=W'7',GSWBCD7,=W'0' MOVE GSWBCD7,GTREGF(CBIN14) VENT DEBET PERF XCOP,CVARBUF,=W'23',=W'7',GSWBCD7,=W'0' MOVE GSWBCD7,GTREGF(CBIN15) VENT KREDIT PERF XCOP,CVARBUF,=W'30',=W'7',GSWBCD7,=W'0' MOVE GSWBCD7,GTREGF(CBIN13) VAL DATO PERF XCOP,CVARBUF,=W'37',=W'3',GSWBCD7,=W'4' PERF XCOP,CVARBUF,=W'47',=W'2',GTTRKEY,=W'0' * WRITE PERF IDXGET,GTLEVNR,GSWBIN4,GSWBIN5 GSWBIN5 LEV INDEX GSWBIN4 INDEX BERR VARWNOK DISK ERROR BNOK VARWNOK NOT FOUND FOUND PERF RAWRIT,DK09,=D'9',CVARBUF,GSWBIN5 BNOK VARWNOK * CLEAR CVARFLG RELEASE BUFFER CMP CBIN0,CBIN0 OK RET * VARWNOK CLEAR CVARFLG RELEASE BUFFER 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(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. * * IF FOUND - CONDITION REGISTER IS SET TO OK * INDX INDEX IN INDEXFILE * LEVDEX INDEX LEV * * 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 * ******************************************** MOVE GSWBIN5,CBIN0 GROUP MOVE GSWBIN4,CBIN0 RECORD IGET010 ADD GSWBIN4,=W'48' ADD GSWBIN5,CBIN1 ASEARCH FOR GROUP CBG GSWBIN4,CIXLAST,IGET020 RETURN NOT FOUND CBL CIXINDX(GSWBIN5),=D'1',IGET020 RETURN, NOT FOUND CBL CIXINDX(GSWBIN5),LEVNR,IGET010 KNTNO < MASTER ? 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' PERF WAITF,CIDXFLG * FIND INDEX, USING BINARY SEARCH IGET100 INITIATE BINARY SEARCH 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 CIXBUF,CBLANKS PERF RAREAD,DK07,=D'7',CIXBUF,GSWBIN5,GSWBIN4 BNOK IGET300 MOVE GSWBCD7,=D'1' SET SIGN MOVE GSWBIN5,CBIN0 XCOPY GSWBCD7,CBIN2,CBIN5,CIXBUF,GSWBIN5 CBNE GSWBCD7,=D'2020202020',IGET115 FNISHED? MOVE GSWBCD7,=D'9999999999' SET HIGHVALUE IGET115 SUB GSWBIN4,GTSCHMID GSWBIN4= START OF SECTOR CMP GSWBCD7,LEVNR BE IGET200 FOUND BL IGET130 LOOK DOWN BG IGET120 LOOK UP IGET120 MOVE GTSCHHGH,GTSCHMID MOVE MIDPOINT TO UPPER 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 MOVE GSWBIN1,CBIN5 XCOPY GSWBIN5,CBIN0,CBIN2,CIXBUF,GSWBIN1 MOVE LEVDEX,GSWBIN5 SET LEV INDX CLEAR CIDXFLG RELEASE BUFFER CMP CBIN0,CBIN0 RETURN OK RET IGETNOK1 ADD GSWBIN4,GTSCHLOW RECORD NUMBER FOR INSERT MOVE LEVDEX,CBIN0 MOVE INDX,GSWBIN4 PLACE TO INSERT CLEAR CIDXFLG RELEASE BUFFER CMP CBIN1,CBIN0 NOK RET IGET300 SET COND = ERR MOVE LEVDEX,CBIN0 MOVE INDX,CBIN0 CLEAR CIDXFLG RELEASE BUFFER CMP CBIN0,CBIN1 RET PEND EJECT IDXINS PROC ********** * * INSERT GTLEVNR IN INDEXFILE * ********** PERF IDXGET,GTLEVNR,GSWBIN4,GSWBIN5 GSWBIN5 LEV INDEX GSWBIN4 INDEX BERR XINSNOK DISK ERROR BOK XINSNOK ALREADY PRESENT * NOT FOUND, INSERT PERF WAITF,CIDXFLG CBG CIXFREE,CIXLAST,XINSNOK NO ROOM MOVE GSWBIN8,GSWBIN4 PLACE FOR INSERTION MOVE GSWBIN1,CBIN7 PERF RAREAD,DK07,=D'7',CIXBUF,GSWBIN1,CIXFREE PERF XCOP,GSWBIN7,=W'0',=W'2',CIXBUF,=W'5' MOVE GSWBIN4,CIXFREE START OF LOOP ADD CIXFREE,CBIN1 NEW FIRST FREE * XINS100 SUB GSWBIN4,CBIN1 RECORD TO BE MOVED CBL GSWBIN4,GSWBIN8,XINS200 ALL MOVED? NO. MOVE GSWBIN1,CBIN7 PERF RAREAD,DK07,=D'7',CIXBUF,GSWBIN1,GSWBIN4 BNOK XINSNOK ADD GSWBIN4,CBIN1 PERF RAWRIT,DK07,=D'7',CIXBUF,GSWBIN4 BNOK XINSNOK PERF RESTIX RESET MASTER INDEX SUB GSWBIN4,CBIN1 B XINS100 * XINS200 * ALL MOVED, INSERT LEVNR+INDEX PERF XCOP,CIXBUF,=W'0',=W'5',GTLEVNR,=W'1' PERF XCOP,CIXBUF,=W'5',=W'2',GSWBIN7,=W'0' PERF RAWRIT,DK07,=D'7',CIXBUF,GSWBIN8 MOVE GSWBIN4,GSWBIN8 PLACE FOR INSERTION PERF RESTIX CLEAR CIDXFLG RELEASE BUFFER CMP CBIN0,CBIN0 OK RET XINSNOK CLEAR CIDXFLG RELEASE BUFFER 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 CIXBUF,CBLANKS PERF RAREAD,DK07,=D'7',CIXBUF,GSWBIN5,GSWBIN4 CBE GTWBCD1,=D'4',SIDX005 NO DATA ? MOVE GSWBIN5,CBIN0 MATCH CIXBUF,GSWBIN5,CBIN2,CBLANKS,CBIN0,CBIN2 1.LEV=BLANK BE SIDX005 MOVE GSWBIN5,CBIN0 MOVE GSWBCD7,=D'1' > 0 XCOPY GSWBCD7,CBIN2,CBIN5,CIXBUF,GSWBIN5 GET 1. LEV CBNE GSWBCD7,=D'1',SIDX005 IF NOT LEVNR 1 B SIDX100 SIDX005 INITIATE INDEX FILE * INITIATE INDEX FILE WITH BLANK ENTRIES MOVE GSWBIN4,CBIN0 SIDX050 MOVE GTWBCD2,GSWBIN4 PERF SPLIN8,CBIN10,CBIN3 ADD GSWBIN4,CBIN1 MOVE CIXBUF,CBLANKS CLEAR BUFFER MOVE GSWBIN5,CBIN0 XCOPY CIXBUF,CBIN5,CBIN2,GSWBIN4,GSWBIN5 SET INDEX PERF RAWRIT,DK07,=D'7',CIXBUF,GSWBIN4 BOK SIDX050 * OK, FIRST LEV = 0000000000 * LOOP THROUGH INDEX FILE TO SET UP * MASTER INDEX IN CORE, AND TO FIND * SIZE OF INDEX FILE SIDX100 MOVE CIXLAST,CBIN0 MOVE CIXFREE,CBIN0 MOVE GSWBIN4,CBIN1 SIDX110 MOVE GTWBCD2,GSWBIN4 PERF SPLIN8,CBIN10,CBIN3 MOVE GSWBIN5,CBIN7 MOVE CIXBUF,CBLANKS PERF RAREAD,DK07,=D'7',CIXBUF,GSWBIN5,GSWBIN4 READ RECORD CBE GTWBCD1,=D'4',SIDX130 FILE EXPANDED CBE GTWBCD1,=D'10',SIDX130 END OF DEVICE MOVE GSWBIN5,CBIN0 MATCH CIXBUF,GSWBIN5,CBIN2,CBLANKS,CBIN0,CBIN2 BE SIDX130 FIRST FREE PERF RESTIX ADD GSWBIN4,CBIN1 B SIDX110 SIDX130 BLANK OR EOF MOVE CIXFREE,GSWBIN4 FIRST FREE ENTRY SUB GSWBIN4,CBIN1 LAST USED ENTRY CBE GSWBIN4,CBIN0,SIDX140 MOVE GSWBIN5,CBIN7 MOVE CIXBUF,CBLANKS PERF RAREAD,DK07,=D'7',CIXBUF,GSWBIN5,GSWBIN4 SIDX140 PERF RESTIX PERF CLEAR8 PERF INITIX RET PEND EJECT IDXDEL PROC ********** * * DELETE ALL ENTRIES FOR LEV NR. * GTLEVNR, IN * INDEXFILE, STAM, AND VAR FILE * ********** * PERF IDXGET,GTLEVNR,GSWBIN4,GSWBIN5 GSWBIN5 LEV INDX GSWBIN4 INDEX BERR XDELNOK DISK ERROR BNOK XDELNOK NOT FOUND * FOUND PERF WAITF,CIDXFLG PERF RADEL,DK08,GSWBIN5 DELETE STAMRECORD PERF RADEL,DK09,GSWBIN5 DELETE VAR RECORD * 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',CIXBUF,GSWBIN1,GSWBIN4 BNOK XDELNOK SUB GSWBIN4,CBIN1 WHERE TO MOVE PERF RAWRIT,DK07,=D'7',CIXBUF,GSWBIN4 BNOK XDELNOK PERF RESTIX ADD GSWBIN4,CBIN1 B XDEL100 * XDEL200 INSERT NEW FREE SUB CIXFREE,CBIN1 MOVE CIXBUF,CBLANKS PERF XCOP,CIXBUF,=W'5',=W'2',GSWBIN7,=W'0' PERF RAWRIT,DK07,=D'7',CIXBUF,CIXFREE MOVE GSWBIN4,CIXFREE SUB GSWBIN4,CBIN1 MOVE GSWBIN1,CBIN7 PERF RAREAD,DK07,=D'7',CIXBUF,GSWBIN1,GSWBIN4 BNOK XDELNOK * LAST USED HAS BEEN READ PERF RESTIX CLEAR CIDXFLG RELEASE BUFFER CMP CBIN0,CBIN0 OK RET * XDELNOK CLEAR CIDXFLG RELEASE BUFFER CMP CBIN1,CBIN0 NOK RET PEND EJECT RESTIX PROC ********************************************** * * ********************************************** MOVE GSWBIN3,GSWBIN4 FIND GROUP NO ADD GSWBIN3,=W'47' DIV GSWBIN3,=W'48' GSWBIN3 = GROUP NO SUB CIXFREE,CBIN1 LAST USED CBE GSWBIN4,CIXFREE,RIX090 LAST USED ADD CIXFREE,CBIN1 FIRST FREE CBE GSWBIN4,CIXLAST,RIX100 LAST RECORD ? JUMP MOVE GSWBIN5,GSWBIN3 LAST IN GROUP ? MUL GSWBIN5,=W'48' SUB GSWBIN5,GSWBIN4 BNE RIXOK FINISHIF NOT LAST IN GROUP MOVE GSWBIN5,CBIN0 LAST IN GROUP MOVE GSWBCD7,=D'1' SET SIGN = + XCOPY GSWBCD7,CBIN2,CBIN5,CIXBUF,GSWBIN5 GET LAST NO MOVE CIXINDX(GSWBIN3),GSWBCD7 B RIXOK RIX090 ADD CIXFREE,CBIN1 FIRST FREE RIX100 CBE GSWBIN3,CBIN0,RIX120 MOVE GSWBIN5,CBIN0 SET LAST USED NO MOVE GSWBCD7,=D'1' SET SIGN = + XCOPY GSWBCD7,CBIN2,CBIN5,CIXBUF,GSWBIN5 MOVE CIXINDX(GSWBIN3),GSWBCD7 SET MASTER INDEX RIX120 SET REMAINING INDICES CBG CIXLAST,CBIN0,RIX135 RIX125 ADD GSWBIN5,CBIN1 MOVE GSWBIN1,CBIN7 PERF RAREAD,DK07,=D'7',CIXBUF,GSWBIN1,GSWBIN5 CBE GTWBCD1,=D'10',RIX130 END OF DEVICE ? CBE GTWBCD1,=D'4',RIX155 FILE EXPANDED B RIX125 RIX130 SUB GSWBIN5,CBIN1 MOVE CIXLAST,GSWBIN5 LAST ENTRY IN INDEX FILE RIX135 MOVE GSWBIN5,CIXLAST ADD GSWBIN5,=W'47' DIV GSWBIN5,=W'48' LAST GROUP RIX140 ADD GSWBIN3,CBIN1 CBG GSWBIN3,GSWBIN5,RIXOK MOVE CIXINDX(GSWBIN3),=D'0' SET MASTER INDEX B RIX140 RIX150 ADD GSWBIN5,CBIN1 RIX155 MOVE CIXBUF,CBLANKS CLEAR BUFFER MOVE GSWBIN1,CBIN0 XCOPY CIXBUF,CBIN5,CBIN2,GSWBIN5,GSWBIN1 SET INDEX PERF RAWRIT,DK07,=D'7',CIXBUF,GSWBIN5 BOK RIX150 B RIX130 RIXOK 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, * (PRINT LISTS) * **************************************** MOVE GTLEVNR,=D'1' LEV NO. ZERO PERF IDXGET,GTLEVNR,GSWBIN4,GSWBIN5 GSWBIN5 LEV INDEX GSWBIN4 INDEX BERR INITNOK DISK ERROR BNOK INIT100 NOT FOUND, INITIATE B INITOK * INIT100 * INSERT SYSTEM DEFINED ENTRIES CBG GTLEVNR,=D'15',INIT300 PERF IDXINS BNOK INIT200 PERF LEVRD BOK INIT150 FOUND PERF LEVINT PERF LEVWRT PERF VARINT PERF VARWRT BNOK INIT200 INIT150 ADD GTLEVNR,=D'1' B INIT100 * INIT200 PERF IDXDEL B INIT150 * INITNOK CMP CBIN1,CBIN0 NOK RET * INIT300 * INIT TRANSFILE IE LOOP THROUGH FILE * AND SET ALL RECORDS ON FREE LIST INITOK PERF TRINIT BNOK INITNOK CMP CBIN0,CBIN0 OK RET PEND EJECT * GETNXT PROC ********************************* * * GET LEVNR FOR LEV FOLLOWING GTLEVNR * ********************************* PERF IDXGET,GTLEVNR,GSWBIN4,GSWBIN5 BERR GNXTNOK BOK GNXT100 SUB GSWBIN4,CBIN1 NOT FOUND GNXT100 PERF WAITF,CIDXFLG ADD GSWBIN4,CBIN1 CBNL GSWBIN4,CIXFREE,GNXTNOK MOVE GSWBIN1,CBIN7 MOVE CIXBUF,CBLANKS PERF RAREAD,DK07,=D'7',CIXBUF,GSWBIN1,GSWBIN4 BNOK GNXTNOK MOVE GTLEVNR,=D'1' PERF XCOP,GTLEVNR,=W'1',=W'5',CIXBUF,=W'0' CLEAR CIDXFLG CMP CBIN0,CBIN0 RET GNXTNOK CLEAR CIDXFLG CMP CBIN1,CBIN0 RET PEND EJECT CHDATO PROC ********** * * CHANGES GSWBCD6 (DDMMYY) TO * GSWBCD7 (YYMMDD) * ********** MOVE GSWBCD7,=D'1' SET SIGN PERF XCOP,GSWBCD7,=W'6',=W'1',GSWBCD6,=W'4' PERF XCOP,GSWBCD7,=W'5',=W'1',GSWBCD6,=W'5' PERF XCOP,GSWBCD7,=W'4',=W'1',GSWBCD6,=W'6' RET PEND * XCOP PROC TO,$TOPNT,$SIZE,FROM,$FROMPNT PLIT $TOPNT PLIT $SIZE PLIT $FROMPNT * * FUNCTION XCOPY: * THE PROCEDURE COPIES FROM 'FROM' STARTING AT $FROMPNT, * TO 'TO', STARTING AT $TOPNT. THE NUMBER OF BYTES * COPIED IS $SIZE * MOVE GSWBIN1,$TOPNT START OF RECEIVING FIELD MOVE GSWBIN4,$SIZE LENGTH MOVE GSWBIN5,$FROMPNT START OF SENDING FIELD XCOPY TO,GSWBIN1,GSWBIN4,FROM,GSWBIN5 RET PEND EJECT FLEVPRT FRMT PRINT OF LEVERAND. FNL FILLR ' ',8 FMEL '99E-99E-99',CMASKDAT FILLR ' ',2 FMEL '9999999999',GTLEVNR FILLR ' ',14 FMEL '99E-99E-99',GTLEVDAT FNL FILLR ' ',18 FCOPY GTLEVNVN FNL FILLR ' ',18 FCOPY GTLEVADR FNL FILLR ' ',18 FCOPY GTLEVBY FNL FILLR ' ',18 FMEL '9999',GTLEVPNR FILLR ' ',2 FCOPY GTLEVPDI FNL FILLR ' ',18 FMEL '9',GTLEVBFO FILLR ' ',2 FMEL 'XXXXXXX',GTLEVGI FILLR ' ',2 FMEL 'XXXXXXXXXX',GTLEVALT FNL FNL FBF GTDYFLG,FLEV190 FNL FILLR ' ',18 FMEL '99E-99E-99',GTREGF(CBIN10) FMEL 'BZZZVZZZVZZ9E,99-',GTREGF(CBIN11) FNL FILLR ' ',26 FMEL 'BZZZVZZZVZZ9E,99-',GTREGF(CBIN12) FNL FILLR ' ',18 FMEL '99E-99E-99',GTREGF(CBIN13) FILLR ' ',8 FMEL 'BZZZVZZZVZZ9E,99-',GTREGF(CBIN14) FNL FILLR ' ',34 FMEL 'BZZZVZZZVZZ9E,99-',GTREGF(CBIN15) FNL FILLR ' ',34 FMEL 'BZZZVZZZVZZ9E,99-',GTREGF(CBIN16) FNL FNL FNL FNL FB FLEV200 FLEV190 FBT GTSWFLAG,FLEV200 FNL FLEV200 FMEND * * * FFEED FRMT FILLR '1',2 FMEND * * * * END