Trailing-Edge
-
PDP-10 Archives
-
decuslib20-06
-
decus/20-153/rpgman.mac
There is 1 other file named rpgman.mac in the archive. Click here to see a list.
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