TITLE RPGMAN Version 1 SUBTTL Object Time Mainline ; ; Mainline Coding for RPGLIB ; ; Bob Currier ; Laboriously entered: 22 August 1975 01:47:19 ; ; Herein find those divers routines that are called by ; the mainline UUO's. It is in this section that the ; real object time functions are carried out. ; ; ; Copyright (C) 1975, 1976 Bob Currier and Cerritos College ; TWOSEG RELOC 400000 SEARCH RPGSWI, MACTEN, UUOSYM ; LOAD THE UNIVERSALS ENTRY A.00 ; 1P ENTRY ENTRY A.01 ; DETAIL OUTPUT ENTRY A.03 ; H1-H9 CHECK ENTRY D.00 ; TOTAL OUTPUT ENTRY SKIND ; SKIP IF INDICATOR ON ENTRY SKIND2 ; SKIP IF INDICATOR ON (JSP) ENTRY SINDT ; SET INDICATOR TRUE ENTRY SINDF ; SET INDICATOR FALSE ENTRY SETPNT ; SET UP BYTE POINTER ENTRY INDC. ; INDICATOR CHECK UUO ENTRY SETOF. ; SETOF UUO ENTRY SETON. ; SETON UUO ENTRY DATAV. ; Make data available ENTRY RIIGET ; Identify a Record SALL SEARCH INTERM, RPGPRM LIBSW%==:LIBSW% DEBUG==:DEBUG STATS==:STATS ;DEFINE THOSE NEFARIOUS LITTLE MONSTERS KNOWN AS AC's SW==0 ; GENERAL FLAGS AC1==1 ; USED BY OBJECT PROGRAM AC2==2 ; USED BY OBJECT PROGRAM AC3==3 ; USED BY OBJECT PROGRAM TA==4 ; TEMP TB==5 ; TEMP TC==6 ; TEMP TD==7 ; TEMP TE==10 ; TEMP TF==11 ; TEMP TG==12 ; TEMP CH==13 ; I/O CHARACTER CH2==14 ; I/O CHARACTER TH==15 ; SPECIAL TEMP PA==16 ; OP POINTER PP==17 ; PUSHDOWN POINTER ;DEFINE AS EXTERNAL SOME USEFUL LITTLE GOODIES FROM RPGIO EXTERN CHN,BLK,CUR,PNT,KEY,BSZ,BUF,BCN,EOF EXTERN UPD,LIN,IPC,SEQ,RII EXTERN CHNSIZ ;Entry point for 1P output ; ;NORMALLY, THE ONLY ROUTINE THAT ENTERS HERE IS RESET., ALL OTHERS ;ENTER AT A.01 ; ; A.00: SETZM FSTTIM ; FIRST TIME FOR EVERYTHING SETOM BRKCNT ; BREAKS TOO MOVEI TC,211 ; GET L0 PUSHJ PP,SINDT ; L0 IS ALWAYS ON MOVE TB,[IOWD 20,RIIPDL+1] ; make stack pointer for RII PDL SETZB TC,BINRED## ; [136] get an end-of-stack flag/clear flag PUSH TB,TC ; save it on the RII stack MOVEM TB,RIIPDL## ; and save the stack pointer MOVE TB,[IOWD 11,DOVPDL+1] ; [174] get ptr to overflow pdl SETZB TC,INDET## ; [174] clear flags PUSH TB,TC ; [174] mark end of stack MOVEM TB,DOVPDL## ; [174] storw pdl pointer IFN STATS,< MSTIME TA, SUB TA,%TIME1## ADDM TA,%TIMER## SETZ TA, RUNTIM TA, SUB TA,%RTIM1## ADDM TA,%RTIMR## > A.00B: MOVEI TC,212 ; get 1P PUSHJ PP,SINDT ; turn it on SETOM AITCH ; turn on "H" PUSHJ PP,OUTPT ; do some output SETZM AITCH ; turn off header SETOM DEE ; turn on detail PUSHJ PP,OUTPT ; do some more output SETZM DEE ; turn off detail MOVEI TC,212 ; get 1P again PUSHJ PP,SINDF ; and turn it off MOVE TB,TABKEY## ; get the repeat flag JUMPE TB,A.01 ; leap if not set PUSHJ PP,%%H.1P## ; otherwise do 1P halt SKIPE PAGE## ; come here on continue SOS PAGE ; reset any PAGE reserved words that SKIPE PAGE1## ; have been used by 1P output SOS PAGE1 ; 1P should not increment PAGE SKIPE PAGE2## ; so we do things the hard way SOS PAGE2 ; like this JRST A.00B ; and go do more output ;A.01 Normal reentry point from user program ; ; ; A.01: IFN STATS,< MSTIME TA, MOVEM TA,%TIME1 SETZ TA, RUNTIM TA, MOVEM TA,%RTIM1 > SETOM INDET ; [174] mark as being in detail section SETZB SW,OVTIM ; [115] dump residue from user program SETOM AITCH ; turn on header flag PUSHJ PP,OUTPT ; do some output SETZM AITCH ; and turn off the flag again A.01A: SETOM DEE ; TURN ON DETAIL AGAIN PUSHJ PP,OUTPT ; AND DO SOME MORE OUTPUT SETZM DEE ; TURN OFF DETAIL SKIPE OVTIM ; OVERFLOW? SWON FDOV; ; SWITCH ON DETAIL OVERFLOW FLAG SETZM INDET ; [174] no longer in detail section A.02: MOVSI TB,377 ; [174] get mask for overflow inds ANDCAM TB,INDBAS+3 ; [174] clear all overflows MOVE TB,DOVPDL ; [174] get push down list ptr POP TB,TC ; [174] get an indicator JUMPE TC,.+3 ; [174] zero marks end PUSHJ PP,SINDT ; [174] else turn indicator on JRST .-3 ; [174] and loop for more PUSH TB,TC ; [174] re-mark end of list MOVEM TB,DOVPDL ; [174] [177] and store pointer A.03: MOVE TC,INDBAS+2 ; GET PROPER WORD TRNN TC,777 ; SEE IF H1-H9 ON JRST A.03C ; NO - ANDI TC,777 ; get only the indicators SETZ TB, ; start with H1 MOVEI TD,400 ; get mask for H1 A.03B0: TDZE TC,TD ; is this it? (shut off ind in process) JRST A.03B ; yes - ROT TD,-1 ; no - shift mask AOJA TB,A.03B0 ; add to index and loop A.03B: PUSHJ PP,@HLTAB(TB) ; go off to appropriate routine JRST A.03 ; in case of continue A.03C: MOVE TC,CURRII ; TURN OFF LAST RII JUMPE TC,.+2 ; IF THIS IS FIRST TIME THRU, RII = 0 PUSHJ PP,SINDF ; JUST LIKE SO MOVE TB,RIIPDL ; get the RII stack pointer POP TB,TC ; pop off an RII JUMPE TC,.+3 ; leap if empty PUSHJ PP,SINDF ; else turn it off JRST .-3 ; and try some more PUSH TB,TC ; stash zero back onto stack MOVEM TB,RIIPDL ; and save the pointer MOVSI TC,777000 ; GET A MASK ANDCAM TC,INDBAS+3 ; CLEAR L1-L9 MOVEI TC,000777 ; GET ANOTHER MASK ANDCAM TC,INDBAS+2 ; CLEAR H1-H9 A.04: MOVEI TC,166 ; LR PUSHJ PP,SKIND ; IS IT ON? JRST B.00 ; NO - JRST C.08 ; YES - GO WAAAAY DOWN HLTAB: EXP %%H.H1## EXP %%H.H2## EXP %%H.H3## EXP %%H.H4## EXP %%H.H5## EXP %%H.H6## EXP %%H.H7## EXP %%H.H8## EXP %%H.H9## B.00: SKIPE FSTTIM ; FIRST TIME? JRST B.00C ; NO - MOVE TA,OTFBAS ; YES - READ ONE REC FROM ALL FILES SETZM NUMINP ; ZAP INPUT COUNTER MOVEI TG,1 ; SKIP OVER PRIMARY ENTRY B.00A: MOVEM TA,CUROTF ; STORE FOR POSTERIOR LDB TC,OT.DES ; GET DESCRIPTION OF THE SUSPECT CAILE TC,1 ; PRIMARY OR SECONDARY? JRST B.00B ; NO - BOOB LDB TB,OT.TYP ; YES - GET TYPE JUMPE TB,.+4 ; INPUT? CAIL TB,2 ; UPDATE? CAILE TB,3 ; COMBINED? JRST B.00B ; NO - LDB TF,OT.CHN ; YES - GET CHANNEL IMULI TF,CHNSIZ ; MULT BY ENTRY SIZE ADD TF,CHNBAS ; ADD IN BASE SKIPE TC ; PRIMARY? JRST .+3 ; NO - MOVEM TA,SAVINP ; YES - JRST .+3 ; SKIP OVER SOME JUNK MOVEM TA,SAVINP(TG) ; STASH IN INPUT TABLE ADDI TG,1 ; bump the index PUSH PP,TG ; save it 'cause INPT messes it PUSHJ PP,INPT ; READ A RECORD JRST %%H.1F## ; invalid key PUSHJ PP,LOKAHD ; [136] move look-ahead fields AOS NUMINP ; BUMP FILE COUNT MOVE TA,CUROTF ; GET POINTER BACK PUSHJ PP,B.01F ; IDENTIFY RECORD AND SEQUENCE POP PP,TG ; [111] restore the SAVINP pointer B.00B: MOVE TA,CUROTF ; GET POINTER LDB TB,OT.LAS ; THIS LAST ONE? JUMPN TB,C.00 ; YES - ADDI TA,OTFSIZ ; NO - BUMP POINTER JRST B.00A ; LOOP - B.00C: MOVE TA,SELFIL ; GET SELECTED FILE LDB TF,OT.CHN ; GET CHANNEL IMULI TF,CHNSIZ ; MAKE INTO POINTER ADD TF,CHNBAS ; MOVEM TA,CUROTF ; SAVE POINTER MOVE TB,BINRED ; [136] file already been read? JUMPN TB,.+3 ; [136] jump if yes PUSHJ PP,INPT ; READ FILE JRST %%H.1F ; invalid key SETZM BINRED ; [136] zap the flag SKIPN EOF(TF) ; DID WE HIT EOF? JRST B.01 ; NO - B.00D: MOVE TA,OTFBAS ; YES - CHECK FOR EOJ CONDITIONS MOVEM TA,CUROTF ; GET A FILE ENTRY LDB TB,OT.IPC ; is this an input file of some sorts? JUMPE TB,B.00E ; NO - TRY ANOTHER LDB TB,OT.EOF ; MUST THIS BE AT EOF? JUMPE TB,B.00E ; NO - LDB TF,OT.CHN ; YES - GET CHANNEL IMULI TF,CHNSIZ ; MAKE POINTER ADD TF,CHNBAS ; SKIPN EOF(TF) ; FILE AT EOF? JRST C.00 ; NO - SKIP OUT OF CHECK B.00E: LDB TB,OT.LAS ; YES - WAS THIS LAST FILE? JUMPN TB,C.08 ; YES - AT EOJ! ADDI TA,OTFSIZ ; NO - GET ANOTHER FILE JRST B.00D+1 ; AND LOOP B.01B: SETZM SAVINP(TG) ; MARK END OF TABLE B.01: MOVE TA,SELFIL ; GET SELECTED FILE MOVEM TA,CUROTF ; STASH B.01F: LDB TF,OT.CHN ; GET CHANNEL IMULI TF,CHNSIZ ; MAKE INTO POINTER ADD TF,CHNBAS ; PUSHJ PP,RIIGET ; IDENTIFY RECORD JUMPE TD,B.01A ; COULDN'T MOVEM TD,RII(TF) ; STASH AWAY RII FOR LATER ; [136] PUSHJ PP,LOKAHD ; handle possible look ahead fields PUSHJ PP,.MCHK ; [114] set up match stuff MOVE TA,CURICH ; reget pointer LDB TB,IC.STS## ; get stacker select MOVEM TB,MFINST## ; save for later LDB TB,IC.SEQ ; MUST WE CHECK SEQUENCE? JUMPE TB,B.01C ; NO - GOOD HLRZ TB,SEQ(TF) ; YES - GET OLD SEQUENCE CAMGE TG,TB ; IN SEQUENCE? JRST B.01D ; NO - OOPS! LDB TC,IC.NPS ; YES - HOW MANY IS OK? CAIN TC,1 ; ONLY ONE/TYPE? CAME TB,TG ; YES - SEQ =? JRST .+2 ; NO - JRST B.01D ; YES - ERROR? AOS TG ; BUMP OLD SEQ CAMN TG,TB ; WAS TG = TB-1? JRST B.01C ; YES - B.01E: MOVE TA,IPC(TF) ; NO - CHECK FOR RECORD TYPE REQUIRED LDB TA,IC.NXR ; GET NEXT RECORD JUMPE TA,B.01C ; FRESH OUT LDB TB,IC.RII ; GET INDTAB POINTER LDB TC,[POINT 6,(TB),35] ; GET SEQUENCE CAMN TC,TG ; HIT END? JRST B.01C ; YES - LDB TB,IC.RTR ; NO - RECORD TYPE REQUIRED JUMPE TB,B.01E+1 ; NO - LOOP JRST B.01D ; YES - ERROR B.01A: PUSHJ PP,%%H.U1## ; unable to identify record JRST A.02 ; in case of continue B.01C: MOVE TB,CURICH ; GET CURRECT RECORD MOVEM TB,IPC(TF) ; STORE FOR OTHERS HRLM TG,SEQ(TF) ; STORE SEQUENCE ENTRY TOO SKIPN FSTTIM ; DID WE PUSHJ INTO HERE?? POPJ PP, ; YES - WELL POPJ OUT! JRST C.00 ; SOUNDS LIKE A XDS MONITOR B.01D: CAIN TG,1 ; SEQUENCE = 1? JRST B.01E ; OH - PUSHJ PP,%%H.J1## ; record out of sequence JRST A.02 ; ALWAYS THE PARDON ;C.00 Select a file record for procesing ; ; ; C.00: MOVE TB,NUMINP ; GET NUMBER OF INPUT FILES CAIG TB,1 ; MORE THAN 1? JRST C.02 ; NO - SKIPE FRCFIL ; YES - FORCED FILE? JRST C.01 ; YES - SETZ TG, ; NO - SCAN FOR RECORD WITH NO MATCH FIELDS C.00A: MOVE TA,SAVINP(TG) ; GET AN INPUT FILE AOS TG ; BUMP INDEX JUMPE TA,C.05 ; ALL DONE NO RECS WITH NO MATCH FIELDS LDB TF,OT.CHN ; GET FILE CHANNEL IMULI TF,CHNSIZ ; MAKE INTO CHNTAB POINTER ADD TF,CHNBAS ; SKIPE EOF(TF) ; FILE AT EOF? JRST C.00A ; YES - GET ANOTHER MOVE TA,IPC(TF) ; NO - GET RECORD POINTER C.00B: LDB TB,IC.MAT ; MATCH FIELD? JUMPN TB,C.00A ; YES - TOO BAD LDB TA,IC.NXF ; NO - GET NEXT FIELD JUMPE TA,C.00C ; IF AT END, WE FOUND REC WITH NO MATCH FIELDS JRST C.00B ; LOOP ON AROUND C.00C: MOVE TB,SAVINP-1(TG) ; GET FILE WITH RECORD MOVEM TB,SELFIL ; SELECT IT JRST C.03 ; GO CHECK SEQUENCE C.01: MOVE TB,FRCFIL ; GET FORCED FILE MOVEM TB,SELFIL ; SELECT IT SETZM FRCFIL ; make sure we don't do this again JRST C.03 ; GO CHECK SEQUENCE C.02: MOVE TA,SAVINP ; ONLY ONE FILE, GET POINTER MOVEM TA,SELFIL ; SELECT IT LDB TF,OT.CHN ; GET CHANNEL IMULI TF,CHNSIZ ; MAKE INTO POINTER ADD TF,CHNBAS ; MOVE TA,IPC(TF) ; GET INPUT RECORD C.02A: LDB TB,IC.MAT ; GET MATCH FIELD JUMPN TB,C.03 ; IF WE GOT ONE, CHECK SEQ LDB TA,IC.NXF ; OTHER WISE GET NEXT FIELD JUMPE TA,C.04 ; BUT IF WE CAN'T FIND ONE, GO TURN ON RII JRST C.02A ; ELSE LOOP ;CHECK MATCHING FIELD SEQUENCE C.03: SETZ TG, ; ZAP INDEX C.03A: MOVE TA,SAVINP(TG) ; GET A FILE ENTRY AOS TG ; BUMP INDEX JUMPE TA,C.04 ; IF AT END, GO TURN ON RII LDB TF,OT.CHN ; GET CHANNEL IMULI TF,CHNSIZ ; AND MAKE INTO POINTER ADD TF,CHNBAS ; SKIPE EOF(TF) ; ARE WE AT EOF? JRST C.03A ; YES - GET ANOTHER FILE MOVE TA,IPC(TF) ; NO - GET FIELD ENTRY C.03B: LDB TB,IC.MAT ; GET MATCHING FIELD ENTRY JUMPN TB,C.03C ; GOT ONE C.03H: LDB TA,IC.NXF ; GET NEXT FIELD JUMPE TA,C.03A ; AINT GOT ONE JRST C.03B ; LOOP ON BACK ;CHECK MATCH RECORDS FOR SEQUENCE C.03C: MOVEM TA,CURICH ; SAVE MOVE TA,SAVINP-1(TG) ; GET FILE ENTRY LDB TH,OT.SEQ ; GET ASCENDING/DESCENDING SEQ CHECK ENTRY MOVE TA,CURICH ; get back field pointer JUMPE TH,C.03H ; [076] don't check if no seq check specified on F card LDB TB,IC.ARP ; GET ARRAY POINTER JUMPN TB,C.03F ; ITEM IS ARRAY, GO PROCESS LDB TE,IC.DES ; GET DESTINATION POINTER C.03D: LDB TD,IC.SIZ ; GET SIZE OF FIELD LDB TB,IC.SRC ; GET SOURCE POINTER PUSHJ PP,SETPNT ; GO SET UP POINTER C.03E: ILDB CH,TB ; GET CHAR FROM RECORD ILDB TC,TE ; GET CHAR FROM CORE CAILE TH,1 ; ASCENDING? JRST C.03J ; NO - CAMGE CH,TC ; IN ASCENDING SEQUENCE? JRST C.03I ; NO - CAME CH,TC ; ascending? JRST C.03H ; yes - all done then SOJN TD,C.03E ; LOOP IF NOT DONE MOVE TA,CURICH ; RESTORE JRST C.03H ; THIS FIELD IN SEQUENCE C.03J: CAMLE CH,TC ; CHECK FOR DESCENDING SEQ JRST C.03I ; DIDN'T FIND IT CAME CH,TC ; in real descending sequence? JRST C.03H ; yes - check no further SOJN TD,C.03E ; LOOP IF NOT DONE MOVE TA,CURICH ; RESTORE JRST C.03H ; DONE - ALL OK C.03F: LDB TC,IC.IMD ; SEE IF LITERAL SUBSCRIPT PUSH PP,TA ; SAVE POINTER PUSH PP,TH ; AND ASCENDING/DESCENDING FLAG JUMPN TC,C.03G ; IT IS, WE GOT IT EASY LDB TC,IC.ARP ; GET POINTER TO ARRAY LDB TB,IC.INP ; GET INDEX POINTER PUSHJ PP,SUBSC.## ; GO SUBSCRIPT POP PP,TH ; RESTORE FLAG POP PP,TA ; RESTORE ITEM POINTER LDB TD,IC.SIZ ; GET SIZE FOR CHECK JRST C.03E ; AND GO CHECK SEQUENCE C.03G: LDB TB,IC.INP ; GET SUBSSRIPT LDB TA,IC.ARP ; GET POINTER TO ARRAY PUSHJ PP,SUBS## ; GO SUBSCRIPT POP PP,TH ; RESTORE FLAG POP PP,TA ; RESTORE POINTER LDB TD,IC.SIZ ; GET SIZE OF ITEM JRST C.03E ; CO CHECK SEQ C.03I: PUSHJ PP,%%H.L1## ; matching record out of sequence JRST A.02 ; BUT LET HIM CHICKEN OUT ;TURN ON APPROPRIATE RECORD IDENTIFYING INDICATOR C.04: MOVE TA,SELFIL ; get whatever file is selected LDB TF,OT.CHN ; get the psuedo-channel IMULI TF,CHNSIZ ; times the entry size ADD TF,CHNBAS ; plus the table offset MOVE TC,RII(TF) ; GET RII MOVEM TC,CURRII ; PUT RII JUMPE TC,C.06 ; IF NO RII, IGNORE IT PUSHJ PP,SINDT ; TURN ME ON HONEY JRST C.06 ; AND LEAP OUTWARDS ;C.05 Select a record on basis of matching field content ; ; ; C.05: MOVEI TB,[ POINT 6,.CM1 POINT 6,.CM2 POINT 6,.CM3 POINT 6,.CM4 POINT 6,.CM5 POINT 6,.CM6 POINT 6,.CM7 POINT 6,.CM8 POINT 6,.CM9 ] MOVEM TB,.MATTB ; store data pointer PUSHJ PP,C.05H ; do the real work elsewhere MOVEM TB,SELFIL ; store selected file JRST C.03 ; go elsewhere ;C.05H Check for matching records and return selected file ; ; ; C.05H: SETZ TG, ; initialize SAVINP index C.05A: ADDI TG,1 ; increment index MOVE TA,SAVINP(TG) ; get input file pointer JUMPE TA,C.05G ; exit upon end of table SETZM MATCNT ; initialize MATCNT SETZM .MATEQ ; say matching fields not equal HRLZ TB,.MATTB ; get data source pointers HRRI TB,.MPTAB ; get place to put it BLT TB,.MPTAB+^D8 ; put it into pointer table MOVE TB,[XWD .MFTAB,.MFTAB+1]; get pointer to flag table SETZM .MFTAB ; clear the first word BLT TB,.MFTAB+^D8 ; clear the rest LDB TF,OT.CHN ; get channel of input file IMULI TF,CHNSIZ ; times size of entry ADD TF,CHNBAS ; plus base address SKIPE EOF(TF) ; file at EOF? JRST C.05A ; yes - get another MOVE TA,IPC(TF) ; no - get ICHTAB pointer for record in core C.05B: LDB TB,IC.MAT ; get matching indicator JUMPN TB,C.05C ; jump if we get one C.05E: LDB TA,IC.NXF ; get next field pointer JUMPN TA,C.05B ; try the next one if there is one SKIPN MATCNT ; else - did we select the file? JRST C.05A ; no - try another MOVE TB,SAVINP(TG) ; yes - get OTF address POPJ PP, ; and exit ;C.05H (cont'd) ; ; ; C.05C: MOVEI TD,-176(TB) ; get relative matching indicator SKIPE .MFTAB-1(TD) ; need we check further? JRST C.05E ; no - MOVE TE,.MPTAB-1(TD) ; get pointer into either .CM or .OM LDB TB,IC.SRC ; get pointer to input PUSHJ PP,SETPNT ; set it up LDB TC,IC.SIZ ; get size of field C.05D: ILDB CH,TB ; get a new character ILDB CH2,TE ; get a previous character CAMLE CH,CH2 ; new .GT. old? JRST C.05A ; yes - forget this file CAME CH,CH2 ; no - new .LT. old? JRST C.05F ; yes - no need to check further SOJG TC,C.05D ; loop until done MOVEM TE,.MPTAB-1(TD) ; replace pointer SETOM .MATEQ ; this field was equal JRST C.05E ; try another field C.05F: SETOM MATCNT ; we may have a match SETOM .MFTAB(TD) ; don't check this indicator any more SETZM .MATEQ ; this field not equal JRST C.05E ; try another field C.05G: SETZ TG, ; [120] start at the beginning MOVE TA,SAVINP(TG) ; [120] get a file entry JUMPE TA,CPOPJ ; [120] exit at end of table LDB TB,OT.DES ; [120] get description CAILE TB,1 ; [120] primary or secondary? AOJA TG,C.05G+1 ; [120] no - try next file LDB TF,OT.CHN ; [120] yes - get channel IMULI TF,CHNSIZ ; [120] times entry-size ADD TF,CHNBAS ; [120] plus the base address SKIPE EOF(TF) ; [120] file at EOF? AOJA TG,C.05G+1 ; [120] yes - try another MOVE TB,TA ; [120] no - select this one CPOPJ:: POPJ PP, ; [120] exit ;CHECK FOR CONTROL BREAK (IN CURRENT RECORD) C.06: MOVE TA,SELFIL ; GET SELECTED FILE LDB TF,OT.CHN ; GET CHANNEL IMULI TF,CHNSIZ ; MAKE POINTER ADD TF,CHNBAS MOVE TA,IPC(TF) ; GET SELECTED RECORD SETZM HICLI ; ZAP C.06A: LDB TB,IC.FRR ; GET FIELD RECORD RELATION JUMPE TB,.+3 ; IF NONE OK - CAME TB,CURRII ; IS THIS A REAL RECORD? JRST C.06C ; NO - LOOP LDB TH,IC.CLI ; GET CONTROL LEVEL INDICATOR JUMPE TH,C.06C ; GET OUT IF NONE LDB TB,IC.ARP ; GET ARRAY POINTER JUMPN TB,C.06D ; AN ARRAY! LDB TE,IC.DES ; GET DESITINATION C.06B: LDB TD,IC.SIZ ; GET SIZE (CHARACTERS) LDB TB,IC.SRC ; GET SOURCE ADDRESS PUSHJ PP,SETPNT ; SET UP BYTE POINTER C.06B2: ILDB CH,TB ; GET ONE CHAR ILDB TC,TE ; GET ANOTHER CAME TC,CH ; ARE THEY EQUAL? JRST C.06F ; NO - CONTROL BREAK! SOJN TD,C.06B2 ; LOOP IF NOT DONE C.06C: LDB TA,IC.NXF ; GET NEXT FIELD JUMPE TA,C.06G ; GO THERE IF DONE THIS REC JRST C.06A ; ELSE LOOP AROUND C.06D: LDB TC,IC.IMD ; IMMEDIATE ON THE ARRAY? JUMPN TC,C.06E ; YES - EASY WAY OUT PUSH PP,TA ; NO - SAVE AN AC LDB TC,IC.ARP ; GET ARRAY POINTER LDB TB,IC.INP ; GET ARRAY INDEX POINTER PUSHJ PP,SUBSC. ; AND SUBSCRIPT POP PP,TA ; RESTORE THE AC LDB TD,IC.SIZ ; GET SIZE JRST C.06B2 ; AND BACK C.06E: PUSH PP,TA ; SAVE POINTER LDB TB,IC.INP ; GET INDEX LDB TA,IC.ARP ; GET ARRAY POINTER PUSHJ PP,SUBS ; SUBSCRIPT POP PP,TA ; RESTORE POINTER LDB TD,IC.SIZ ; GET SIZE JRST C.06B2 ; EXIT C.06F: CAMLE TH,HICLI ; THIS THE HIGHEST CLI SO FAR? MOVEM TH,HICLI ; NO - REPLACE JRST C.06C ; YES - IGNORE C.06G: SKIPN HICLI ; ANY CONTROL BREAK? JRST C.07 ; NO - AOS BRKCNT ; INCREMENT CONTROL BREAK COUNT MOVE TC,HICLI ; GET HIGHEST BREAK PUSHJ PP,SINDT ; SET INDICATOR MOVE TD,HICLI ; GET INDICATOR BACK SOJ TD, ; DECREMENT ONCE C.06H: CAIG TD,154 ; ALL SET YET? JRST C.07 ; YES - ADD TC,[XWD 10000,0] ; [125] no - decrement byte pointer DPB TE,TC ; SET ANOTHER SOJA TD,C.06H ; DECREMENT AND LOOP AGAIN ;Determine whether or not to do total calculations ; ; ; C.07: SKIPG BRKCNT ; FIRST CONTROL BREAK? SKIPE FSTTIM ; FIRST TIME THRU? POPJ PP, ; NO - EXIT FROM UUO CALL POP PP,TA ; BOFFO THE RETURN MOVE TB,%F.PTR## ; get pointer to data PUSH PP,TB ; stash as new return address for POPJ JRST D.01 ; YES - SKIP OVER TOTALS C.08: MOVEI TC,155 ; GET L1 PUSHJ PP,SINDT ; SET IT ON MOVEI TG,12 ; turn on L2-L9 (156-165) IDPB TE,TC ; [113] set on indicator SOJN TG,.-1 ; LOOP IF NOT TWELVE TIMES MOVEI TC,166 ; get LR PUSHJ PP,SINDT ; turn it on IFN STATS,< MSTIME TA, SUB TA,%TIME1 ADDM TA,%TIMER SETZ TA, RUNTIM TA, SUB TA,%RTIM1 ADDM TA,%RTIMR > POPJ PP, ; EXIT FROM UUO ;HANDLE TOTAL OUTPUT D.00: IFN STATS,< MSTIME TA, MOVEM TA,%TIME1 SETZ TA, RUNTIM TA, MOVEM TA,%RTIM1 > SETZM OVTIM ; CLEAR FLAG SWON LONLY ; CONTROL LEVEL OUTPUT ONLY SETOM TEE ; AND TURN ON TOTAL PUSHJ PP,OUTPT ; AND DO MORE OUTPUT SETZM TEE ; AND NOW TURN OFF TOTAL SWOFF LONLY ; TURN OFF CL ONLY D.01: MOVEI TC,166 ; LR PUSHJ PP,SKIND ; IS IT ON? JRST .+2 ; NO - JRST H.99 ; YES - CLOSE UP SHOP MOVE TB,INDBAS+3 ; [141] get word with overflow indicators TLNN TB,000377 ; [141] any set on? JRST D.02 ; [141] no - don't do any output TLNN TB,777000 ; [174] any control level on? JRST D.02 ; [174] no - ;[200] SWON OVONLY ; SET UP FOR OVERFLOW OUTPUT SETOM AITCH ; START WITH HEADER PUSHJ PP,OUTPT ; DO IT ;[200] SETZM AITCH ; TURN OFF HEADER SWOFF OVONLY ; TURN OFF D.02: SETZM OVTIM ; TURN OFF FLAG MOVE TB,NUMINP ; get number of input files CAIG TB,1 ; multi-file? JRST D.03 ; no - no MR possible SKIPE .MATEQ ; matching records equal? JRST D.02B ; yes - turn on MR SKIPE .OMVAL ; no - is .OM data still valid? JRST D.02A ; no MOVEI TB,[ POINT 6,.OM1 POINT 6,.OM2 POINT 6,.OM3 POINT 6,.OM4 POINT 6,.OM5 POINT 6,.OM6 POINT 6,.OM7 POINT 6,.OM8 POINT 6,.OM9 ] MOVEM TB,.MATTB## ; store table address SETZ TG, ; initialize index PUSHJ PP,C.05A ; and check for match on old data SKIPE .MATEQ## ; is there one? JRST D.02B ; yes - turn on MR SETOM .OMVAL## ; .OM no longer valid D.02A: MOVEI TC,210 ; get MR PUSHJ PP,SINDF ; turn it off JRST D.03 ; go do the rest D.02B: MOVEI TC,210 ; get MR PUSHJ PP,SINDT ; turn it on ;D.03 Make data available ; ; ; D.03: MOVE TA,SELFIL ; get selected file PUSHJ PP,DATAV. ; make data available SETOM FSTTIM ; not first time any more MOVE TA,SELFIL ; [136] get selected input file LDB TA,OT.IPC ; [136] get input chain pointer D.03A: LDB TB,IC.LHI ; [136] get look-ahead pointer JUMPN TB,D.03B ; [136] jump when we get one LDB TA,IC.NXR ; [136] else get next record JUMPN TA,D.03A ; [136] loop if there is one JRST D.03D ; [136] else exit D.03B: SKIPE EOF(TF) ; [136] is file at EOF? JRST D.03C ; [136] yes - treat special MOVE TA,SELFIL ; [136] else get selected file MOVEM TA,CUROTF ; [136] store the pointer PUSHJ PP,INPT ; [136] and get the next record JRST %%H.1F ; [136] ....invalid key PUSHJ PP,LOKAHD ; [136] move those fields on out SETOM BINRED ; [136] flag that we read the file already JRST D.03D ; [136] and exit D.03C: MOVE TA,TB ; [136] get the proper AC loaded LDB TB,IC.SIZ ; [136] get the size of the field JUMPE TB,D.03E ; [136] ignore if zero LDB TC,IC.DES ; [136] get destination byte pointer MOVEI CH,'9' ; [136] get our EOF flag character IDPB CH,TC ; [136] store it SOJG TB,.-1 ; [136] loop until field is full D.03E: LDB TB,IC.NXF ; [136] get pointer to next field JUMPN TB,D.03C ; [136] loop if there is one D.03D: SETOM INDET ; [174] mark as being in detail calcs IFN STATS,< MSTIME TA, SUB TA,%TIME1 ADDM TA,%TIMER SETZ TA, RUNTIM TA, SUB TA,%RTIM1 ADDM TA,%RTIMR > POPJ PP, ; exit from the UUO ; ; COMMON SUBROUTINES ; ; THESE ARE SUBROUTINES USED ALL OVER THE PLACE, THEY SHOULD ; BE DEFINED AS ENTRY POINTS SO THAT ALL MAY AVAIL THEMSELVES ; OF THESE FANTASTIC GEMS OF PROGRAMMING EXPERTISE (CHOKE!) ; ; ;IDENTIFY A RECORD IN CORE ; ;ENTER WITH OTFTAB POINTER IN TA ;EXIT WITH RII IN TA ; RIIGET: LDB TA,OT.IPC ; GET INPUT CHAIN POINTER RIIG05: MOVEM TA,CURICH ; SAVE FOR OTHERS LDB TA,IC.RII ; GET RII CHAIN JUMPE TA,RIIG06 ; DON'T CHECK IF NO RII'S LDB TG,ID.SEQ ; GET SEQUENCE ENTRY RIIG04: LDB TD,ID.RII ; GET RII FROM INDTAB RIIG01: LDB TB,ID.POS ; GET POSITION JUMPE TB,RIIG06+2 ; IF NO CHAR HERE, IS CODELESS RII PUSHJ PP,GTFCHR ; GET A CHARACTER LDB TC,ID.IND ; GET INDICATOR CAME TB,TC ; IS THIS THE ONE? JRST RIIG02 ; NO - LDB TB,ID.NOT ; YES - WAS IT A NOT ENTRY? JUMPN TB,RIIG02+2 ; YES - DIDN'T MAKE IT THEN RIIG07: LDB TB,ID.END ; NO - WAS IT THE END? JUMPE TB,.+2 ; NO - POPJ PP, ; YES - LDB TB,ID.OR ; OR LINE? ADDI TA,1 ; bump the INDTAB pointer JUMPE TB,RIIG01 ; no - POPJ PP, ; yes - RIIG02: LDB TB,ID.NOT ; IS IT A NOT ENTRY? JUMPN TB,RIIG07 ; YES - ALL IS OK THEN SETZ TD, ; ZAP LDB TB,ID.END ; WAS THIS THE END? JUMPN TB,RIIG03 ; YES - END OF THIS INDTAB CHAIN LDB TB,ID.OR ; OR LINE? ADDI TA,1 ; GET NEXT ENTRY JUMPN TB,RIIG04 ; NO - GO ON BACK TO MAINLINE JRST RIIG02+1 ; YES - SMALL LOOP RIIG03: MOVE TA,CURICH ; GET ICH POINTER LDB TA,IC.NXR ; GET NEXT RECORD JUMPN TA,RIIG05 ; GOT ONE - POPJ PP, ; NO GOT ONE - RIIG06: SETZ TD, ; ZAP IT AOS (PP) ; SKIP POPJ PP, ; EXIT ;DATAV. Routine to make data available ; ;Call with OTFTAB pointer in TA ; ; DATAV.: LDB TF,OT.CHN ; get the psuedo-channel IMULI TF,CHNSIZ ; make into pointer ADD TF,CHNBAS ; add to bas address MOVE TA,IPC(TF) ; get the input chain LDB TC,IC.SIZ ; get the size of the record JUMPE TC,RET.1## ; none - exit DATV.1: SWOFF DMINUS!DZERO; ; reset some flags LDB TC,IC.FRR ; get field/record relation indicator JUMPE TC,.+3 ; all is ok if there is none PUSHJ PP,SKIND ; else check to see if it is on JRST DATV.7 ; it isn't - get the next field LDB TB,IC.ARP ; all is cool - get array flagger JUMPN TB,DATV.8 ; handle any arrays elsewhere LDB TE,IC.DES ; get destination pointer DATV.2: LDB TD,IC.SIZ ; get the size count LDB TB,IC.SRC ; get the source pointer PUSHJ PP,SETPNT ; set it up ILDB CH,TB ; [165] get a character LDB TC,IC.FLD ; get field type CAIN TC,2 ; binary? JRST DATV10 ; yes - CAIN CH,'-' ; unary minus? SWON DMINUS; ; yes - flag it DATV.4: MOVEI TH,'0' ; make a guess at numeric SKIPN TC ; is it? MOVEI TH,' ' ; no - check against spaces CAME CH,TH ; [161] is it blanks or zeroes? SWON DZERO; ; no - flag as not zero DATV.5: IDPB CH,TE ; stash the character SOJE TD,DATV.6 ; exit when done ILDB CH,TB ; get another character JRST DATV.4 ; and loop DATV.6: LDB TC,IC.FPL ; [161] get plus indicator SKIPE TC ; [161] skip if none PUSHJ PP,SINDF ; [161] turn it off LDB TC,IC.FMN ; [161] get minus indicator SKIPE TC ; [161] skip if none PUSHJ PP,SINDF ; [161] turn it off LDB TC,IC.FBZ ; [161] blank/zeroes indicator JUMPE TC,DATV6C ; [161] none TSWT DZERO; ; [161] was field all zeroes/spaces? JRST DATV6E ; [161] yes - go turn indicator on PUSHJ PP,SINDF ; [161] else turn it off DATV6C: TSWT DMINUS; ; [161] was field minus? JRST DATV6D ; [161] no - continue LDB TC,IC.FMN ; [161] get minus indicator JUMPE TC,DATV.7 ; [161] ain't none JRST DATV6E ; [161] turn it on DATV6D: LDB TC,IC.FPL ; [161] must be positive field JUMPE TC,DATV.7 ; [161] no indicator there DATV6E: PUSHJ PP,SINDT ; [161] turn it on DATV.7: LDB TA,IC.NXF ; get pointer to next field JUMPN TA,DATV.1 ; loop if we have one POPJ PP, ; else exit ;DATAV. (cont'd) ; ; ; DATV.8: LDB TC,IC.IMD ; get the immediate flag JUMPN TC,DATV.9 ; is immediate - makes it easier PUSH PP,TA ; save an AC PUSH PP,TF ; [165] and another LDB TC,IC.ARP ; get pointer to array LDB TB,IC.INP ; get pointer to index PUSHJ PP,SUBSC. ; and generate pointer POP PP,TF ; [165] restore channel pointer POP PP,TA ; restore the AC MOVE TE,TB ; [165] get array item pointer into TE JRST DATV.2 ; [165] and go move the array item DATV.9: PUSH PP,TA ; save an AC PUSH PP,TF ; [165] and another LDB TB,IC.INP ; get index LDB TA,IC.ARP ; [165] get array pointer PUSHJ PP,SUBS ; generate a byte pointer POP PP,TF ; [165] bring back channel pointer POP PP,TA ; pop off the AC MOVE TE,TB ; [165] get array item pointer into TE JRST DATV.2 ; [165] and go move it DATV10: TRNE CH,4 ; binary minus? (i.e. bit 0 set?) SWON DMINUS; ; yes - DATV11: SKIPE CH ; field zero? SWON DZERO; ; no - say so IDPB CH,TE ; stash the character SOJE TD,DATV.6 ; exit if all done ILDB CH,TB ; get another character JRST DATV11 ; loop ;GTFCHR Get a character from a buffer ; ; ; GTFCHR: SUBI TB,1 ; GET CHAR NUM INTO LINE IDIVI TB,6 ; SIX CHARS/WORD ADD TB,PNTAB1(TC) ; GET BYTE POINTER ADD TB,BUF(TF) ; ADD IN BASE OF BUFFER LDB CH,TB ; GET THE CHARACTER MOVEI TB,40(CH) ; GET INTO PROPER AC AS ASCII POPJ PP, ; EXIT POINT 6,0 ; USED TO MAKE ILDB POINTERS PNTAB1: POINT 6,0,5 POINT 6,0,11 POINT 6,0,17 POINT 6,0,23 POINT 6,0,29 POINT 6,0,35 ;LOKAHD Routine to make available look-ahead data ; ; ; LOKAHD: MOVE TA,CUROTF ; get OTFTAB pointer LDB TA,OT.IPC ; get pointer to ICHTAB chain LOKA.1: LDB TB,IC.LHI## ; get look-ahead item flag JUMPN TB,LOKA.2 ; jump if we found one LDB TA,IC.NXR ; else get next record JUMPN TA,LOKA.1 ; loop if we have one POPJ PP, ; else exit LOKA.2: LDB TC,IC.SIZ ; get record size JUMPE TC,RET.1 ; exit if zero PJRST DATV.1 ; else go make data available ;.MCHK Store matching field data from primary file ; ; ; .MCHK: MOVE TA,CUROTF ; get current file CAME TA,SAVINP ; is it primary file? POPJ PP, ; no - exit MOVE TB,[XWD .CM1,.OM1] ; set up to save .CM in .OM BLT TB,.OM9+^D9 ; do it MOVE TB,[XWD .CM1,.CM1+1] ; get pointer to current SETZM .CM1 ; clear first word BLT TB,.CM9+^D9 ; clear the rest MOVE TB,[XWD [ POINT 6,.CM1 POINT 6,.CM2 POINT 6,.CM3 POINT 6,.CM4 POINT 6,.CM5 POINT 6,.CM6 POINT 6,.CM7 POINT 6,.CM8 POINT 6,.CM9 ], .MPTAB ] BLT TB,.MPTAB+^D8 ; set up pointer table SETZM .OMVAL ; OM data is now valid MOVE TA,CURICH ; get current record pointer .MCHK1: LDB TB,IC.MAT ; get matching flag JUMPN TB,.MCHK2 ; jump when we find one .MCHK4: LDB TA,IC.NXF ; get next field pointer JUMPN TA,.MCHK1 ; loop if we find one POPJ PP, ; else exit .MCHK2: MOVEI TD,-176(TB) ; get relative matching indicator MOVE TE,.MPTAB-1(TD) ; get pointer to storage LDB TB,IC.SRC ; get source pointer PUSHJ PP,SETPNT ; set up pointer LDB TC,IC.SIZ ; get size of field .MCHK3: ILDB CH,TB ; get a source character IDPB CH,TE ; stash it into .CM storage SOJG TC,.MCHK3 ; keep going until exhausted MOVEM TE,.MPTAB-1(TD) ; restore pointer JRST .MCHK4 ; get next field ;SETPNT Routine to setup byte pointer ; ;SET UP ILDB TYPE BYTE POINTER TO CHARACTER IN TB, ;EXPECTS TF TO BE SET UP AS USUAL ; ; SETPNT: SUBI TB,1 ; ADJUST FOR THE REAL WORLD IDIVI TB,6 ; ACTUALLY THIS IS ALL THE SAME AS GTFCHR ADD TB,PNTAB1-1(TC) ; EXCEPT FOR THIS MINOR DIFFERANCE ADD TB,BUF(TF) ; ADD IN BUFFER BASE POPJ PP, ; EXIT ;SKIND Skip if indicator is on ; ;Enter with indicator in TC ; ; SKIND: SUBI TC,1 ; MAKE ORGIN ZERO IDIVI TC,^D36 ; THE HELL WITH COMMENTS! MOVE TC,INDBAS(TC) ; GET WORD TDNE TC,PNTAB3(TD) ; SKIP IF NOT ON AOS (PP) POPJ PP, PNTAB2: POINT 1,INDBAS,0 POINT 1,INDBAS,1 POINT 1,INDBAS,2 POINT 1,INDBAS,3 POINT 1,INDBAS,4 POINT 1,INDBAS,5 POINT 1,INDBAS,6 POINT 1,INDBAS,7 POINT 1,INDBAS,8 POINT 1,INDBAS,9 POINT 1,INDBAS,10 POINT 1,INDBAS,11 POINT 1,INDBAS,12 POINT 1,INDBAS,13 POINT 1,INDBAS,14 POINT 1,INDBAS,15 POINT 1,INDBAS,16 POINT 1,INDBAS,17 POINT 1,INDBAS,18 POINT 1,INDBAS,19 POINT 1,INDBAS,20 POINT 1,INDBAS,21 POINT 1,INDBAS,22 POINT 1,INDBAS,23 POINT 1,INDBAS,24 POINT 1,INDBAS,25 POINT 1,INDBAS,26 POINT 1,INDBAS,27 POINT 1,INDBAS,28 POINT 1,INDBAS,29 POINT 1,INDBAS,30 POINT 1,INDBAS,31 POINT 1,INDBAS,32 POINT 1,INDBAS,33 POINT 1,INDBAS,34 POINT 1,INDBAS,35 ;SKIND2 SAME BASIC IDEA AS SKIND BUT ENTER WITH A JSP JAC, ; ; ; SKIND2: CAIL TF,167 ; [176] is it an overflow indicator? CAILE TF,176 ; [176] ? JRST SKND2A ; [176] no - SKIPN .OA##-167(TF) ; [176] yes - is secondary indicator on? JRST (JAC) ; [176] no - return SKND2A: SUBI TF,1 ; DECREMENT IDIVI TF,^D36 ; DO ANYTHING TO GET RID OF THIS MOVE TF,INDBAS(TF) ; GET WORD TDNE TF,PNTAB3(TG) ; SKIP IF NOT ON JRST 1(JAC) ; IS ON JRST (JAC) ; NOT ON PNTAB3: EXP 1B0 EXP 1B1 EXP 1B2 EXP 1B3 EXP 1B4 EXP 1B5 EXP 1B6 EXP 1B7 EXP 1B8 EXP 1B9 EXP 1B10 EXP 1B11 EXP 1B12 EXP 1B13 EXP 1B14 EXP 1B15 EXP 1B16 EXP 1B17 EXP 1B18 EXP 1B19 EXP 1B20 EXP 1B21 EXP 1B22 EXP 1B23 EXP 1B24 EXP 1B25 EXP 1B26 EXP 1B27 EXP 1B28 EXP 1B29 EXP 1B30 EXP 1B31 EXP 1B32 EXP 1B33 EXP 1B34 EXP 1B35 ;SINDT & SINDF Set indicator either true or false ; ;Enter with indicator in TC ; ; ; SINDF: SETZ TE, SIND: CAIL TC,167 ; [176] overflow? CAILE TC,176 ; [176] ? TRNA ; [176] no - MOVEM TE,.OA##-167(TC) ; [176] yes - set secondary indicator JUMPE TC,SINDER ; ZERO IS MOST INVALID SUBI TC,1 ; SAVE .18 MICRO'S BY USING SUBI INSTEAD OF SOS ; LIKE WE USED TO. IDIVI TC,^D36 ADD TC,PNTAB2(TD) DPB TE,TC POPJ PP, SINDT: MOVEI TE,1 ; [174] mark as true SKIPN INDET ; [174] are we in detail area? JRST SIND ; [174] no - CAIGE TC,167 ; [174] overflow? JRST SIND ; [174] no - CAILE TC,176 ; [174] maybe - JRST SIND ; [174] no - PUSH PP,TB ; [201] save off TB MOVE TE,DOVPDL ; [201] get the PDL ptr SINDT1: POP TE,TB ; [201] get something off stack JUMPE TB,SINDT2 ; [201] if zero, not on stack CAME TB,TC ; [201] do we have a match? JRST SINDT1 ; [201] no - loop for more POP PP,TB ; [201] yes - restore TB MOVEI TE,1 ; [201] restore TE JRST SIND ; [201] go turn indicator on SINDT2: POP PP,TB ; [201] restore TB MOVEI TE,1 ; [201] and TE EXCH TB,DOVPDL ; [174] yes - get pdl pointer PUSH TB,TC ; [174] stack the indicator EXCH TB,DOVPDL ; [174] and replace pointers JRST SIND ; [174] and go do the rest SINDER: OUTSTR [ASCIZ /?Indicator of zero passed to SIND /] JRST DEATH## ; RIBBET ;INDC. CHECK FOR INDICATOR STATUS, POINTER TO INDTAB IN PA ; ; ; INDC.: IFN STATS,< SETZ 7, RUNTIM 7, MOVEM 7,%RTIM2## AOS %INDC## > HRRZ TD,PA ; TRANSFER LDB TE,[POINT 12,(TD),21] ; ID.POS = SECRET FLAG CAIE TE,7777 ; IS IT? JRST INDC.1 ; NOPE - LDB TF,[POINT 8,(TD),9] ; YES - GET INDICATOR JSP JAC,SKIND2 ; IS IT ON? JRST INDC.7 ; NO - FAILS TEST ADDI TD,1 ; YES - GET NEXT WORD LDB TF,[POINT 8,(TD),9] ; GET INDICATOR JUMPE TF,INDC.6 ; IF ZERO, WE'RE ALL DONE INDC.1: LDB TF,[POINT 8,(TD),9] ; GET INDICATOR MOVE TE,(TD) ; GET THE INDTAB WORD JSP JAC,SKIND2 ; IS IT ON? JRST INDC.2 ; NO - CHECK FOR NOT TLNE TE,(1B1) ; ID.NOT ON? JRST INDC.4 ; YES - BAD INDC.3: TRNE TE,1B22 ; ID.END ON? JRST INDC.6 ; YES - ALL DONE JUMPL TE,INDC.6 ; JUMP IF ID.OR (BIT0) SET AOJA TD,INDC.1 ; MUST BE AND, LOOP INDC.2: TLNE TE,(1B1) ; NOT ENTRY SET? JRST INDC.3 ; YES - ALL IS OK INDC.4: TRNE TE,1B22 ; END FLAG ON? JRST INDC.7 ; YES - MOVE TF,TE ; get into temp AC ADDI TD,1 ; BUMP POINTER MOVE TE,(TD) ; GET ENTRY JUMPGE TF,INDC.4 ; LOOP IF ID.OR (BIT0) NOT SET JRST INDC.1 ; ELSE USE NEXT INDICATOR CHAIN INDC.6: AOS (PP) ; SKIP IFN STATS,< AOS %INDCT## ; BUMP SUCESSFUL COUNTER > INDC.7: IFN STATS,< SETZ 7, RUNTIM 7, SUB 7,%RTIM2 ADDM 7,%RTIMI## > POPJ PP, ; EXIT ;SETON. ROUTINE TO TURN ON UP TO THREE INDICATORS ; ; ; SETON.: MOVE TA,(PA) ; GET THAT WORD LDB TC,SETAB ; GET INDICATOR JUMPE TC,.+2 ; ZERO? PUSHJ PP,SINDT ; NO - SET IT LDB TC,SETAB+1 JUMPE TC,.+2 PUSHJ PP,SINDT LDB TC,SETAB+2 JUMPE TC,.+2 PUSHJ PP,SINDT POPJ PP, SETAB: POINT 8,TA,7 POINT 8,TA,15 POINT 8,TA,23 ;SETOF. ROUTINE TO TURN OFF UP TO THREE INDICATORS ; ; ; SETOF.: MOVE TA,(PA) LDB TC,SETAB JUMPE TC,.+2 PUSHJ PP,SINDF LDB TC,SETAB+1 JUMPE TC,.+2 PUSHJ PP,SINDF LDB TC,SETAB+2 JUMPE TC,.+2 PUSHJ PP,SINDF POPJ PP, ;DEFINE EXTERNALS AND SUCH ROT EXTERNAL AITCH,DEE,TEE,ECKS,OUTPT,OVTIM,HLTOPT,CURRII EXTERNAL OTFBAS,CHNSIZ,CHNBAS,SAVINP,OTFSIZ,SELFIL,NUMINP EXTERNAL FRCFIL,MATFIL,WEIRD,MATCNT,HICLI,INDBAS,CURICH EXTERNAL INPT,MINUS,NZERO,OVIND EXTERNAL DEATH,IC.OCC EXTERNAL FSTTIM,BRKCNT,CUROTF,H.99 EXTERNAL ID.OR,ID.NOT,ID.IND,ID.POS,ID.END,ID.RII,ID.SEQ EXTERNAL OT.NAM,OT.TYP,OT.DES,OT.PRO,OT.ORG,OT.RAF,OT.DEV,OT.EOF EXTERNAL OT.KYP,OT.BLK,OT.SEQ,OT.BUF,OT.AST,OT.REW,OT.EXT,OT.ADD EXTERNAL OT.OVI,OT.OVL,OT.LPP,OT.EXI,OT.COR,OT.CRS,OT.ADP,OT.CHN EXTERNAL OT.BFP,OT.BSZ,OT.BSC,OT.OPC,OT.IPC,OT.LAS,OT.CHI,OT.KYL EXTERNAL OC.FLD,OC.SIZ,OC.DEC,OC.PRI,OC.PRO,OC.STR,OC.STP,OC.ORT EXTERNAL OC.ADD,OC.FOV,OC.SKB,OC.SKA,OC.SPB,OC.SPA,OC.END,OC.IDX EXTERNAL OC.OCC,OC.SRC,OC.NXR,OC.NXF,OC.IND,OC.STS,OC.EDT EXTERNAL IC.DES,IC.RII,IC.NXF,IC.NXR,IC.ARP,IC.INP,IC.INP,IC.NPS EXTERNAL IC.FMN,IC.FBZ,IC.FPL,IC.CLI,IC.FRR,IC.MAT,IC.RTR,IC.LHI EXTERNAL IC.STS,IC.FLD,IC.SIZ,IC.SEQ,IC.SRC,IC.IMD EXTERNAL .CM1,.CM2,.CM3,.CM4,.CM5,.CM6,.CM7,.CM8,.CM9 EXTERNAL .OM1,.OM2,.OM3,.OM4,.OM5,.OM6,.OM7,.OM8,.OM9 EXTERNAL .MPTAB,.MFTAB,.OMVAL END