|
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: 30176 (0x75e0)
Notes: pts_type(SC)
Names: »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 LEVWRT ENTRY VARRD ENTRY IDXINS ENTRY IDXGET ENTRY VARINT ENTRY LEVDEL ENTRY IDXDEL ENTRY INITIX ENTRY SETIDX ENTRY LEVSPG ENTRY LEVPRT EXT FMTREM EXT SPCLRA EXT SPCLRN EXT RAREAD EXT RAWRIT EXT RADEL EXT SETKEY EXT SPERR EXT SPLIN8 EXT ABORT INCLUDE EQUATE 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 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'0',OPR040 OK MOVE SPBINW4,=W'5' 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 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,DEL030 ANY TRANS REFERENCE ? CLEAR GTSWFLAG NO DEL030 CLEAR GTDYFLG SET GTSPGFLG PERF FMTREM,CBIN3 PERF SPCLRN CLEAR GTSPGFLG IB SPBINW2,DEL000,DEL000,DEL050 B DEL030 DEL050 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 * ********** * LEVR000 TBF CLEVFLG,LEVR010 BUFFER FREE? DELAY CBIN2 NO, WAIT B LEVR000 * LEVR010 SET CLEVFLG RESERVE LEV-BUFFER 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' 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' * LEVROK 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 * ********** * LEVW000 TBF CLEVFLG,LEVW010 BUFFER FREE? DELAY CBIN2 NO, WAIT B LEVW000 LEVW010 SET CLEVFLG RESERVE LEV BUFFER * 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 * LEVWOK 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 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 LSPG210 PERF FMTREM,CBIN5 PERF SPCLRN IB SPBINW2,LSPG500,LSPG500,LSPG200 B LSPG210 LSPG500 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 PERF SPCLRA IB SPBINW2,LPRTRET,LPRTRET,LPRT010 LPRT010 * PRINT HEADER CBG GTPRTFRA,=D'0',LPRT020 MOVE GTPRTFRA,=D'19' FIRST LEV 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 LPRT050 CBG GTLEVNR,GTPRTTIL,LPRTRET PERF LEVRD BNOK LPRT100 NOT FOUND MOVE GSWBCD6,GTLEVDAT GTLEVDAT: DDMMYY PERF CHDATO GSWBCD7: YYMMDD CBL GSWBCD7,GTPRTDAT,LPRT100 TBF GTDYFLG,LPRT080 PERF VARRD BNOK LPRT100 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 PERF SPLIN8,CBIN0,CBIN0 TESTIO KEYB BOK LPRT110 OK: KEYBORD INPUT CALL ABORT,KEYB B LPRT150 CONTINUE LPRT110 MAK KEY? WAIT KEYB CBNE SPBINW2,CBIN6,LPRT150 CONTINUE B LPRTRET * LPRT150 PERF GETNXT BNOK LPRTRET FINISH B LPRT050 READ NEXT * LPRTRET RET PEND EJECT * VARRD PROC ********** * * READ AND UNPACK VARIABLE INFORMATION * FOR LEVERAND NR GTLEVNR * ********** * VARR000 TBF CVARFLG,VARR010 BUFFER FREE? DELAY CBIN2 NO WAIT B VARR000 VARR010 SET CVARFLG RESERVE VAR BUFFER 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 * ********** * VARW000 TBF CVARFLG,VARW010 BUFFER FREE? DELAY CBIN2 NO, WAIT B VARW000 VARW010 SET CVARFLG RESERVE BUFFER * 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 * VARWOK 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,=W'0' 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 CBE CIXINDX(GSWBIN5),=D'0',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' IGET100 TBF CIDXFLG,IGET105 BUFFER FREE? DELAY CBIN2 NO, WAIT B IGET100 IGET105 SET CIDXFLG RESERVE BUFFER IGET110 ADD GSWBIN4,CBIN1 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 CBE GSWBCD7,LEVNR,IGET200 FOUND CBG GSWBCD7,LEVNR,IGETNOK1 NOT FOUND B IGET110 LOOK AT NEXT IGET200 FOUND 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 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 XINS000 TBF CIDXFLG,XINS010 BUFFER FREE? DELAY CBIN2 NO , WAIT B XINS000 XINS010 CBG CIXFREE,CIXLAST,XINSNOK NO ROOM SET CIDXFLG 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,=W'7' 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 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 GSWBIN5,=W'7' 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 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 XDEL000 TBF CIDXFLG,XDEL010 BUFFER FREE? DELAY CBIN2 NO, WAIT B XDEL000 XDEL010 SET CIDXFLG RESERVE BUFFER 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 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',INITOK 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 * INITOK * INIT TRANSFILE IE LOOP THROUGH FILE * AND SET ALL RECORDS ON FREE LIST 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 TBF CIDXFLG,GNXT110 DELAY CBIN2 B GNXT100 GNXT110 SET 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 EJECT * 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