Trailing-Edge
-
PDP-10 Archives
-
BB-Z759A-SM
-
cobol-source/rpwgen.mac
There are 21 other files named rpwgen.mac in the archive. Click here to see a list.
; UPD ID= 1293 on 6/27/83 at 11:38 AM by HOFFMAN
TITLE RPWGEN FOR COBOL V13
SUBTTL GENERATE CODE FOR REPORT-WRITER AL BLACKINGTON/CAM
SEARCH COPYRT
SALL
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
COPYRIGHT (C) 1974, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION
SEARCH P
%%P==:%%P
TWOSEG
.COPYRIGHT ;Put standard copyright statement in REL file
SALL
RELOC 400000
;EDITS
;NAME DATE COMMENTS
;V12B****************
;SMI 12-MAY-83 [1471] Fix page heading not advancing to next page.
;JEH 12-MAY-83 [1470] Make LMASKR external for edit 1451.
;SMI 29-JAN-82 [1451] Fix bad-table link when RPWTAB > 77777 words.
;SMI 22-Nov-82 [1433] Fix 1373 when report has no PAGE HEADING groups
;RJD 15-Jul-82 [1373] Correct page advancing when more than 2 report header lines.
;V12A****************
;JEH 30-DEC-80 [1105] Set LINKAGE SECTION bit for CONTRL, SUM operands.
;CLRH 4-APR-80 [1007] GENERATE 'AOS PAGE-COUNTER' FOR 'LINE NEXT PAGE'.
;V12*****************
;EHM 23-JUN-78 [540] FIX CONTROL HEADING PRINTED PAST LINE
; SPECIFIED AS LAST DETAIL LINE.
;V10*****************
;NAME DATE COMMENTS
; 5-APR-76 [415] FIX COUNT OF CID OF NO FINAL
;ACK 28-MAY-75 COMP-3/EBCDIC CODE.
;********************
;**; EDIT 342 MAKE USER HAVE LINE CLAUSE IN A REPORT GROUP- MAKE LINE NEXT PAGE GO TO RIGHT LINE
;**; EDIT 335 NO CODE GENERATION IF A FATAL ERROR OCCURS.
;**; EDIT 326 MAKE WARNING MESSAGE FOR SUM LINES REFER TO CORRECT SOURCE LINE
;**; EDIT 315 FIX SO THAT CONTROL FOOTING PUTS OUT PREVIOUS VALUE AT BREAK TIME
; ALSO FIX SO THAT SUM ERROR IS IGNORED HERE
;**; EDIT 305 FIX TO HANDLE HEADING IN A PH
;**; EDIT 247 BYPASS MOVE CODE FOR SUBSCRIPTED ITEMS
;**; EDIT 245 FIXES READ INTO AT END GENERATE SO THAT INTO WORKS
;**; EDIT 241 FIXES GROUP INDICATE TO BLANK ALL OF THE ITEM
;**; EDIT 202 FIXES CODE FOR CALL TO CH ROUTINE.
;**; EDIT 200 FIXES PAGE-COUNTING AT RIGHT TIME
ENTRY INITRW ;INITIATE
ENTRY TERMRW ;TERMINATE
ENTRY GENRW ;GENERATE
ENTRY SETRPW ;SET UP CONTROL BREAK TESTS, ETC.
ENTRY RIFTAG ;"REFERENCE IF TAG" ROUTINE
ENTRY SUPPRS ;SUPPRESS PRINTING OF A REPORT GROUP
RPWGEN: INTERNAL RPWGEN
EXTERNAL MOVGEN,RESGEN,ADDTGN
EXTERNAL FATAL,MSX.,MZC1.,MZC2.,MXX.
EXTERNAL SETOPN,SETOPA,GETTAG,PUTTAG,LNKSET
EXTERNAL PUTASY,PUTASN,PUTAS1,STASHP,STASHQ,POOLIT,PLITPC
EXTERNAL IFGNZC
;DEFINE A MACRO TO PICK UP 'RD' ADDRESS
DEFINE GETRD,<
HLRZ TA,CURRPW
ADD TA,RPWLOC
>
SUBTTL GENERATE 'INITIATE'
INITRW: SKIPGE RPWERR ; [335] FATAL ERROR IN REPORT WRITER?
POPJ PP, ; [335] YES- CANNOT DO CODE GENERATION.
MOVEI EACB,INITT## ;PICK UP 'INIT.' OP-CODE
MOVEM W1,OPLINE ;SAVE OPERATOR
MOVE EACA,EOPLOC ;START AT TOP OF EOPTAB
INIT1: CAMN EACA,EOPNXT ;ARE WE DONE?
POPJ PP, ;YES
PUSHJ PP,INIT2 ;NO--GENERATE <INIT. RPWTAB>
MOVE CH,[MOVEI.,,1]
PUSHJ PP,PUTASY ;GENERATE <MOVEI 0,1>
LDB CH,RW.PC ;GENERATE
ANDI CH,LMASKB ; <MOVEM 0,PAGE-COUNTER>
IORI CH,AS.DAT
HRLI CH,MOVEM.
PUSHJ PP,PUTASY
JRST INIT1
INIT2: ADD EACA,[XWD 2,2] ;GET TO 2ND WORD OF NEXT OPERAND
MOVE TA,(EACA) ;GET RPWTAB LINK
ANDI TA,LMASKR## ;[1470][1451] CONVERT TO
ADD TA,RPWLOC ; ADDRESS
LDB CH,RW.RWT ;GET TAG OF RUN-TIME RPWTAB
JUMPE CH,CPOPJ ;IF ZERO, FORGET IT
PUSHJ PP,RIFTAG ;REFERENCE TAG
HRLI CH,(EACB) ;GET OP-CODE
JRST PUTASY ;WRITE IT OUT
SUBTTL GENERATE 'TERMINATE'
TERMRW: SKIPGE RPWERR ; [335] FATAL ERROR IN REPORT WRITER?
POPJ PP, ; [EET] YES- CANNOT DO CODE GENERATION
MOVEI EACB,TERM## ;GET 'TERM.' OP-CODE
MOVEM W1,OPLINE ;SAVE OPERATOR
MOVE EACA,EOPLOC ;START AT TOP OF TABLE
TERM1: CAMN EACA,EOPNXT ;ARE WE DONE?
POPJ PP, ;YES
PUSHJ PP,INIT2 ;NO--GENERATE <TERM. RPWTAB>
LDB CH,RW.FBT ;GENERATE
PUSHJ PP,RIFTAG ;REFERENCE IF TAG BITS ON
HRLI CH,EPJPP ; PUSHJ TO
TRNE CH,-1 ; FINAL BREAK ROUTINE UNLESS
PUSHJ PP,PUTASY ; THERE IS NONE
LDB CH,RW.PFR ;GENERATE CALL TO
PUSHJ PP,RIFTAG
HRLI CH,EPJPP ; PAGE-FOOTING ROUTINE
TRNE CH,-1 ; IF THERE IS ONE
PUSHJ PP,PUTASY
LDB CH,RW.RFR ;GENERATE CALL TO
PUSHJ PP,RIFTAG
HRLI CH,EPJPP ; REPORT-FOOTING ROUTINE
TRNE CH,-1 ; IF THERE IS ONE
PUSHJ PP,PUTASY
LDB CH,RW.LC ;GENERATE
ANDI CH,LMASKB ; <SETOM LINE-COUNTER>
JUMPE CH,TERM1 ;*
IORI CH,AS.DAT ;*
HRLI CH,SETOM. ;*
PUSHJ PP,PUTASY ;*
JRST TERM1
SUBTTL GENERATE 'SUPPRESS'
SUPPRS: SKIPGE RPWERR## ;FATAL ERROR IN REPORT WRITER?
POPJ PP, ;YES, CANNOT DO CODE GENERATION
MOVE CH,[SETOM.+ASINC,,AS.MSC]
PUSHJ PP,PUTASY ;SETOM THE PARAM
HRRZ TA,EOPLOC ;GET ARGUMENT: %PARAM OFFSET
MOVE CH,2(TA)
SUBI CH,1 ;GET OFFSET
ADD CH,RPWPRS
PUSHJ PP,PUTASN ;%PARAM+N
POPJ PP, ;RETURN
SUBTTL GENERATE 'GENERATE'
GENRW: SKIPGE RPWERR## ; [335] FATAL ERROR IN REPORT WRITER?
POPJ PP, ; [EET] YES- CANNOT DO CODE GENERATION
MOVEM W1,OPLINE ;SAVE OPERATOR
MOVE EACA,EOPLOC ;IF THERE
CAMN EACA,EOPNXT ; IS NOTHING IN EOPTAB,
POPJ PP, ; FORGET THE WHOLE THING
MOVE TA,2(EACA) ;GET OPERAND LINK
ANDI TA,LMASKR ;[1451]
MOVSM TA,CURRPW ;SAVE IT
ADD TA,RPWLOC ;CONVERT TO ADDRESS
HRRM TA,CURRPW ; AND SAVE THAT
SKIPL 0(TA) ;IS OPERAND AN 'RD'?
JRST GENRW2 ;YES
LDB TA,RW.RDL ;NO--GET LINK TO 'RD'
ANDI TA,LMASKR ;[1451]
JUMPE TA,CPOPJ ; [335] NO CODE GENERATION IF NO RD LINK
HRLM TA,CURRPW
ADD TA,RPWLOC
GENRW2: LDB TA,RW.COD ;GET LINK TO 'CODE'
SKIPE TA ;IF NON-ZERO,
PUSHJ PP,LNKSET ; CONVERT IT TO ADDRESS
HRRZM TA,CURMNE ;SAVE ZERO OR MNETAB ADDRESS
GETRD
LDB CH,RW.BKT ;GENERATE
PUSHJ PP,RIFTAG
HRLI CH,EPJPP ; PUSHJ TO
PUSHJ PP,PUTASY ; 'BREAK-TEST' ROUTINE
MOVE TA,CURRPW ;GET BACK TO ITEM
SKIPL 0(TA) ;IS IT 'RD'?
JRST GENRW3 ;YES
;GENERATE CODE FOR DETAIL LINE
MOVEI TE,LINE.D
MOVEM TE,RWSAV7
JRST WRIGRP ;GENERATE CODE FOR LINE AND RETURN
;GENERATE LINES FOR 'RD'
GENRW3: MOVE TE,[XWD 1B18,LINE.D]; SET 'I AM RD'
MOVEM TE,RWSAV7
LDB TA,RW.FGP ;GET LINK TO FIRST GROUP ITEM
JUMPE TA,CPOPJ ;IF ZERO LINK (ERROR IN RD), FORGET IT
GENRW4: PUSH PP,TA ;SAVE LINK TO 01-ITEM
PUSHJ PP,LNKSET ;CONVERT TO ADDRESS
LDB TA,DA.RPW ;GET ASSOCIATED RPWTAB LINK
ANDI TA,LMASKR ;[1451]
ADD TA,RPWLOC
HRRM TA,CURRPW ;SAVE RPWTAB ADDRESS
LDB TE,RW.TYP ;IF IT IS
CAIN TE,%RG.DE ; A 'TYPE DETAIL' ITEM,
PUSHJ PP,WRIGRP ; GENERATE SET-UP
POP PP,TA ;GET LINK TO 01-ITEM AGAIN
PUSHJ PP,LNKSET ;RE-COMPUTE ADDRESS
LDB TE,DA.FAL ;IF IT DOESN'T HAVE A BROTHER,
JUMPN TE,CPOPJ ; WE ARE DONE
LDB TA,DA.BRO ;GET BROTHER LINK
JRST GENRW4 ;LOOP TO PROCESS THAT ONE
SUBTTL GENERATE RPWTAB
SETRPW: SKIPGE RPWERR ; [335] FATAL ERROR IN REPORT WRITER?
POPJ PP, ; [335] YES- CANNOT DO CODE GENERATION.
;ALLOCATE %PARAM LOCATIONS NEEDED FOR SUPPRESS.
SKIPN TB,RPWPRS## ;NEED ANY %PARAM LOCS?
JRST SETRP1 ;NO
HRRZ TD,EAS1PC## ;HERE IS STARTING ADDRESS
IORI TD,AS.PAR ;%PARAM LOCATION TYPE
MOVEM TD,RPWPRS## ;SAVE %PARAM OFFSET HERE.
ADDM TB,EAS1PC## ;ALLOCATE THE SPACE.
PUSHJ PP,PUTOC0## ;WRITE ZEROES THERE.
SOJG TB,.-1
SETRP1: MOVE TA,RPWLOC ;IF
CAMN TA,RPWNXT ; NO RPWTAB ENTRIES,
POPJ PP, ; QUIT
MOVEI TA,1(TA) ;SET TA TO FIRST ENTRY
SKIPG (TA) ; [335] IS THIS AN RD TABLE?
JRST [SETOM RPWERR ; [335] NOT AN RD TABLE SET FATAL ERROR
POPJ PP,] ; [335] AND RETURN
SUB TA,RPWLOC
SETR00: HRLM TA,CURRPW ;SAVE ADDRESS OF 'RD'
ADD TA,RPWLOC
PUSHJ PP,GETTAG ;GET TAG FOR
DPB CH,RW.RWT ; RUN-TIME RPWTAB
PUSHJ PP,SETCOD ;SET UP 'CODE'
PUSHJ PP,ROUTS ;GENERATE CODE FOR RH,RF,PH,PF
GETRD
LDB CH,RW.RWT ;DEFINE TAG FOR RPWTAB
PUSHJ PP,PUTTAG
MOVE CH,[XWD AS.XWD,6]
PUSHJ PP,PUTASN
LDB CH,RW.PAG ;PAGE-LIMIT
PUSHJ PP,PUTASN
LDB CH,RW.LC ;ADDRESS OF LINE-COUNTER
ANDI CH,LMASKB
IORI CH,AS.DAT
PUSHJ PP,PUTASY
LDB CH,RW.FDE ;FIRST DETAIL LINE
PUSHJ PP,PUTASN
LDB CH,RW.LDE ;LAST DETAIL LINE
PUSHJ PP,PUTASY
LDB CH,RW.CFL ;LAST CONTROL FOOTING LINE
PUSHJ PP,PUTASN
LDB CH,RW.RHR ;ADDRESS OF RH ROUTINE
PUSHJ PP,PUTASY
LDB CH,RW.PHR ;ADDRESS OF PH ROUTINE
PUSHJ PP,PUTASN
LDB CH,RW.PFR ;ADDRESS OF PF ROUTINE
PUSHJ PP,PUTASY
LDB CH,RW.FIL ;FILE-TABLE ADDRESS
ANDI CH,LMASKS
IORI CH,AS.FIL
PUSHJ PP,PUTASN
LDB CH,RW.PHL ; [305] GET PAGE HEADING
PUSHJ PP,PUTASY
;STOP FOR A SECOND TO CALL "REFTAG" FOR TAGS WE HAVE REFERENCED
LDB CH,RW.RHR ;RH ROUTINE
PUSHJ PP,RIFTAG ;REFERENCE IF A TAG
LDB CH,RW.PFR ;PF ROUTINE
PUSHJ PP,RIFTAG
LDB CH,RW.PHR ;PH ROUTINE
PUSHJ PP,RIFTAG
HRRZ TA,CURMNE ;GET ADDRESS OF 'CODE' MNETAB ENTRY
JUMPN TA,SETR0B ;IF NON-ZERO, THERE IS A CODE
MOVEI CH,0 ;THERE IS NO CODE
PUSHJ PP,PUTASN ;PUT OUT <XWD 0,0>
JRST SETR0C ;WE ARE DONE WITH OBJECT RPWTAB
;ROUTINE TO CALL "REFTAG" IF RH(CH) IS A TAG
;PRESERVES TA, USES TE
RIFTAG: TRC CH,AS.TAG## ;SEE IF ADDRESS IS A TAG
TRCE CH,AS.TAG ;SKIP IF TRUE
POPJ PP, ;NOT, RETURN
PUSH PP,TA ;SAVE TA
HRRZ TA,CH ;GET TAG NUMBER
PUSHJ PP,REFTAG## ;AND REFERENCE IT
POP PP,TA
POPJ PP,
SETR0B: MOVEI CH,2 ;CODE SIZE = 2
PUSHJ PP,PUTASN ;LH OF WORD 6 = CODE SIZE
LDB CH,MN.RCV ;RH OF WORD 6 = LITERAL ADDRESS
MOVS CH,CH
HRRI CH,AS.MSC ;*
SETR0C: PUSHJ PP,PUTASY ;*
SUBTTL GENERATE BREAK COMPARISONS
SETR01: PUSHJ PP,GETTAG ;GET TAG FOR BREAK-TEST START
GETRD
DPB CH,RW.BKT ;SAVE IT
PUSHJ PP,PUTTAG ;GIVE IT TO ASSEMBLER
GETRD
LDB CH,RW.RWT ;GENERATE <MOVEI 16,RPWTAB>
PUSHJ PP,RIFTAG
HRLI CH,MOVEI.+AC16
PUSHJ PP,PUTASY
MOVE CH,[XWD EPJPP,LIN.RH] ;GENERATE <PUSHJ 17,LIN.RH>
PUSHJ PP,PUTASY
LDB TE,RW.CID ;SAVE
JUMPE TE,SETR09 ;IF NONE, NOT MUCH CODE NEEDED
MOVE TB,TE
HRRZM TB,RWSAV2 ;SAVE
ADD TB,RCOLOC## ;GET ABS. ADDRESS
PUSHJ PP,GETTAG ;GET TAG FOR FIRST RESET
HRLM CH,2(TB)
HRLI CH,JRST. ;GENERATE
HRRZ TA,CH
PUSHJ PP,REFTAG ;REFERENCE TAG
PUSHJ PP,PUTASY ; <JRST %TAG>
PUSHJ PP,GETTAG ;GET TAG FOR
MOVEM CH,RWMBRK ; BREAK PRINTING ROUTINE
SETZM RWBRKC ;CLEAR 'PARAM' ADDRESS
MOVE TE,RWSAV2 ; IS THERE A FINAL?
ADD TE,RCOLOC
HLRZ TA,CURRPW
ADD TA,RPWLOC
LDB CH,RW.NCI##
SOSGE CH ; [415] DEDUCT ONE FROM COUNTER
SETZ CH,
HRLI CH,MOVEI. ;GENERATE
PUSHJ PP,PUTASY ; <MOVEI 0,CID-COUNT>
MOVE CH,[XWD MOVEM.,AS.MSC]; GENERATE <MOVEM 0,%PARAM>
PUSHJ PP,PUTASN
MOVE CH,EAS1PC
IORI CH,AS.PAR
MOVEM CH,RWBRKC ;SAVE BREAK COUNT ADDRESS
PUSHJ PP,PUTASY
MOVE CH,[XWD AS.OCT,1]
PUSHJ PP,PUTAS1
MOVEI CH,0
PUSHJ PP,PUTAS1
AOS EAS1PC
;PUT OUT BREAK TESTS
SETR03: PUSHJ PP,BLDPAR ;BUILD 'A' AND 'B' FOR CONDITIONAL TEST
JRST SETR07 ;TROUBLE--FORGET THIS ONE
HRLZ W2,RWMBRK
MOVE W1,OPLINE
TLZ W1,777770
TLO W1,EQTEST
PUSHJ PP,IFGNZC
;THAT BREAK IS SET -- TRY NEXT
SETR07: MOVE TA,RWSAV2 ;GET RCOTAB ENTRY
ADD TA,RCOLOC
LDB TB,RC.BRO## ;GET BROTHER
JUMPE TB,SETR08 ;NO
MOVEM TB,RWSAV2
ADD TB,RCOLOC
SKIPE (TA) ;IF THAT PREVIOUS ONE WAS 'FINAL',
SKIPN RWBRKC ; OR THERE IS NO BREAK COUNT,
JRST SETR03 ; THEN NO 'SOS' NEEDED
MOVE CH,[XWD SOS.,AS.MSC]; GENERATE <SOS %PARAM>
PUSHJ PP,PUTASN
HRRZ CH,RWBRKC
PUSHJ PP,PUTASY
JRST SETR03 ;GO BACK FOR MORE
;ALL BREAK TESTED -- PUT OUT 'POPJ'
SETR08: PUSHJ PP,GENPPJ ;GENERATE <POPJ 17,>
JRST SETR10
;THERE ARE NO CONTROL FIELDS
SETR09: GETRD
LDB CH,RW.GIR ;GET TAG
SKIPN CH ; FOR
PUSHJ PP,GETTAG ; 'GROUP INDICATE'
DPB CH,RW.GIR ; ROUTINE
PUSHJ PP,RIFTAG ;REFERENCE TAG
HRLI CH,JRST. ;GENERATE <JRST GI-CODE>
PUSHJ PP,PUTASY
PUSHJ PP,GENPPJ ;GENERATE <POPJ 17,>
JRST SETR70
GENPPJ: MOVSI CH,POPJ.+AC17 ;GENERATE <POPJ 17,>
JRST PUTASY
SUBTTL GENERATE BREAK PRINTING ROUTINES
SETR10: GETRD
SKIPN RWBRKC ;ANY BREAK COUNT?
JRST SETR15 ;NO
PUSHJ PP,GETTAG ;YES--GET 'FINAL BREAK' TAG
DPB CH,RW.FBT ;SAVE FOR 'TERMINATE'
PUSHJ PP,PUTTAG ;DEFINE IT HERE
MOVE CH,[XWD HRLOI.,AS.CNB]; GENERATE
PUSHJ PP,PUTASN ; <HRLOI 0,377777>
MOVEI CH,377777 ;*
PUSHJ PP,PUTASY ;*
MOVE CH,[XWD MOVEM.,AS.MSC]; GENERATE
PUSHJ PP,PUTASN ; <MOVEM 0,%PARAM>
MOVE CH,RWBRKC ;*
PUSHJ PP,PUTASY ;*
MOVE CH,RWMBRK ;GET TAG OF FIRST BREAK PRINTER
JRST SETR16
SETR15: MOVE CH,RWMBRK ;TAG OF FIRST BREAK PRINTER IS
DPB CH,RW.FBT ; TAG OF FINAL BREAK
SETR16: PUSHJ PP,PUTTAG
LDB TD,RW.FCI## ;GET ADDRESS OF FIRST CONTROL IDENTIFIER
HRRZM TD,RWSAV2 ;SAVE IT
;TD IS REL ADDRESS OF CONTROL IDENTIFIER IN RPWTAB
SETR20: GETRD
ADD TD,RCOLOC
HRRZ TC,1(TD) ;GET ADDRESS OF CF GROUP
ANDI TC,LMASKR ;[1451]
JUMPE TC,SETR22
MOVEM TC,RWSV12## ;SAVE REL LOCATION OF THIS CF GROUP
ADD TC,RPWLOC
HRRM TC,CURRPW
MOVEI TE,LINE.C
MOVEM TE,RWSAV7
PUSHJ PP,WRIGRP ;GENERATE CODE TO WRITE GROUP
PUSHJ PP,SUPPTG ;GEN %TAG: IF NEEDED FOR SUPPRESS
;ALL LINES HAVE BEEN GENERATED FOR CURRENT CF GROUP
SETR22: MOVE TE,RWSAV2
ADD TE,RCOLOC
SKIPE (TE) ;WAS THAT 'FINAL'?
SKIPN RWBRKC ;NO--ANY CONTROL COUNT?
JRST SETR23 ;NO
MOVE CH,[XWD SOSGE.,AS.MSC]; YES--
PUSHJ PP,PUTASN ; GENERATE <SOSGE %PARAM.>
HRRZ CH,RWBRKC
PUSHJ PP,PUTASY
MOVE TD,RWSAV2 ;ANY TAG THERE ALREADY?
ADD TD,RCOLOC
HLRZ CH,2(TD)
JUMPN CH,SETR26 ;IF SO, USE IT
PUSHJ PP,GETTAG ;GENERATE <JRST %RESET>
MOVE TD,RWSAV2
ADD TD,RCOLOC
HRLM CH,2(TD)
SETR26: PUSHJ PP,RIFTAG
HRLI CH,JRST.
PUSHJ PP,PUTASY
SETR23: MOVE TA,RWSAV2
ADD TA,RCOLOC
LDB TD,RC.BR1##
JUMPE TD,SETR25 ;NO
MOVEM TD,RWSAV2 ; ADDRESS
JRST SETR20 ; AND LOOP
;ALL GROUPS HAVE BEEN PUT OUT
SETR25: PUSHJ PP,GENPPJ ;GENERATE <POPJ 17,>
SUBTTL GENERATE 'RESET' CODE
GETRD
LDB TD,RW.CID ;GET ADDRESS OF
ANDI TD,LMASKB ;CONTROL IDENTIFIER PARAMETERS
HRRZM TD,RWSAV2 ;SAVE IT
;TD IS REL ADDR OF NEXT CONTROL IDENTIFIER ENTRY
SETR51: ADD TD,RCOLOC ;MAKE ABS ADDRESS
HLRZ CH,2(TD) ;PUT OUT
SKIPE CH ; ANY %TAG FOR
PUSHJ PP,PUTTAG ; ROUTINE
PUSHJ PP,BLDPAR ;SET UP 'A' AND 'B' FOR SAVING CONTROL
JRST SETR52 ;TROUBLE--FORGET IT
PUSHJ PP,MXX. ; SAVE THE VALUE OF THE CONTROL
SETR52: MOVE TE,RWSAV2 ;PICK UP
ADD TE,RCOLOC
HLRZ TA,1(TE) ; 'CH' GROUP LINK
ANDI TA,LMASKR ;[1451]
JUMPE TA,SETR53
ADD TA,RPWLOC
HRRM TA,CURRPW ;GENERATE
MOVEI TE,LINE.D ;[540] [202] GET CH ADR
MOVEM TE,RWSAV7 ;[202] SAVE FOR PUSHJ
PUSHJ PP,WRIGRP ; 'CH' LINE
PUSHJ PP,SUPPTG ;GEN %TAG: IF NEEDED FOR SUPPRESS
;CLEAR ALL SUMMATION COUNTERS
SETR53: MOVE TE,RWSAV2
ADD TE,RCOLOC
HRRZ TA,1(TE) ;GET 'CF' LINK
SETR54:
ANDI TA,LMASKR ;[1451]
JUMPE TA,SETR60
ADD TA,RPWLOC
HRRM TA,CURRPW
LDB TE,RW.SCD ;PICK UP 'SOURCE-SUM' CODE
CAIE TE,%RG.SM ;IS IT A 'SUM'?
JRST SETR56 ;NO
LDB TE,RW.RSF ;IS THE ITEM
JUMPN TE,SETR56 ; RESET ON 'FINAL'?
LDB TE,RW.RES ;NO--IS THERE A 'RESET ON' CLAUSE?
SKIPN TE ;IF NOT,
PUSHJ PP,SETZER ; GENERATE CODE TO ZERO THE FIELD
SETR56: PUSHJ PP,NXTDAT ;GET NEXT DATA ITEM
JRST SETR60 ;NO MORE--QUIT
LDB TE,DA.LVL ;IF THIS IS
CAIN TE,LVL.01 ; 01-LEVEL,
JRST SETR60 ; QUIT,
LDB TA,DA.RPW ; ELSE GET RPWTAB LINK AND
JRST SETR54 ; LOOP
;ALL SUMMATION COUNTERS ARE CLEARED FOR THIS GROUP.
;FIND ALL 'RESET ON' CLAUSES WHICH REFERENCE THIS CONTROL.
SETR60: MOVE TE,RWSAV2
ADD TE,RCOLOC
HLRZ TE,(TE) ;SAVE
MOVEM TE,RWSAV3 ; LINK TO CONTROL IDENTIFIER
PUSH PP,RWSAV2 ;SAVE POINTER
HLRZ TA,CURRPW
ADD TA,RPWLOC
LDB TA,RW.CID ;GET ADDRESS OF FIRST CONTROL IDENTIFIER
TRNA
SETR61: LDB TA,RC.BRO ;GET BROTHER
JUMPE TA,SETR66 ;NO MORE CONTROL IDENTIFIERS, EXIT
MOVEM TA,RWSAV2 ;SAVE
ADD TA,RCOLOC
LDB TB,RC.CFG##
JUMPE TB,SETR61 ; TRY NEXT ONE
MOVE TA,TB
SETR62:
ANDI TA,LMASKR ;[1451] GET ADDRESS OF
ADD TA,RPWLOC ; RPWTAB ENTRY
HRRM TA,CURRPW ;SAVE IT
LDB TE,RW.SCD ;IF THIS ITEM
CAIE TE,%RG.SM ; IS NOT SUM,
JRST SETR65 ; GO TO NEXT
SKIPE RWSAV3 ;IF WE ARE NOT RESETTING FINAL,
JRST SETR63 ; SEE IF THERE IS 'RESET ON ID'
LDB TE,RW.RSF ;IS ITEM TO BE RESET ON FINAL?
JUMPE TE,SETR65
JRST SETR64 ;YES
SETR63: LDB TE,RW.RES ;GET RESET CONTROL IDENTIFIER
CAMN TE,RWSAV3 ;IF IT IS THIS GROUP
SETR64: PUSHJ PP,SETZER ; GENERATE 'MOVE ZERO'
SETR65: PUSHJ PP,NXTDAT ;GO TO NEXT DATA ITEM
JRST SETR68 ;NO MORE--GO TO NEXT CONTROL
LDB TE,DA.LVL ;IF THIS IS
CAIN TE,LVL.01 ; 01-LEVEL
JRST SETR68 ; GO TO NEXT CONTROL
LDB TA,DA.RPW ;GET ASSOCIATED RPWTAB LINK
JRST SETR62 ;LOOP
SETR66: POP PP,RWSAV2 ;RESTORE TO
MOVE TA,RWSAV2
ADD TA,RCOLOC
LDB TD,RC.BRO
JUMPE TD,SETR70
MOVEM TD,RWSAV2
JRST SETR51
SETR68: MOVE TA,RWSAV2
ADD TA,RCOLOC
JRST SETR61
SUBTTL PUT OUT 'GROUP INDICATE' CODE
SETR70: GETRD
LDB CH,RW.GIR ;IS THERE A TAG FOR
SKIPN CH ; 'GROUP INDICATE' ROUTINE?
PUSHJ PP,GETTAG ;NO--GET ONE
DPB CH,RW.GIR ;SAVE IT
PUSHJ PP,PUTTAG ;DEFINE IT
LDB TA,RW.FGP ;GET LINK TO FIRST GROUP
JUMPE TA,SETR80 ;IF NULL--FORGET IT
SETR71: PUSHJ PP,LNKSET ;GET DATAB ADDRESS
SETR72: LDB TA,DA.RPW ;GET RPWTAB LINK
ANDI TA,LMASKR ;[1451]
JUMPE TA,SETR80
ADD TA,RPWLOC
HRRM TA,CURRPW ;SAVE LINK TO GROUP
LDB TE,RW.TYP ;IS THE GROUP
CAIN TE,%RG.DE ; TYPE DETAIL?
JRST SETR73 ;YES
LDB TA,RW.DAT ;DOES THIS
PUSHJ PP,LNKSET ; 01 DATA-NAME
LDB TE,DA.FAL ; HAVE
JUMPN TE,SETR80 ; A BROTHER?
LDB TA,DA.BRO ;YES--GET LINK
JUMPN TA,SETR71 ;IF NON-ZERO--LOOP
JRST SETR80 ;IF ZERO--QUIT
;GROUP IS TYPE DETAIL
SETR73: LDB TA,RW.DAT ;GET DATAB LINK
PUSHJ PP,LNKSET ;CONVERT TO ADDRESS
SETR75: HRRZM TA,CURDAT ;SAVE IT
LDB TA,DA.RPW ;GET ASSOCIATED
ANDI TA,LMASKR ;[1451]
ADD TA,RPWLOC ; RPWTAB ENTRY
HRRM TA,CURRPW
LDB TE,RW.GPI ;IF NOT 'GROUP INDICATE',
JUMPE TE,SETR76 ; NO CODE
LDB TE,RW.SLK ;IF NO SOURCE LINK,
JUMPE TE,SETR76 ; NO CODE
;See code at WRG32B
MOVE EACA,EOPLOC ;SET UP AND CALL 'MOVE'
SKIPE .RWSRC(TA) ; DID WE STORE A SOURCE ITEM FOR EOPTAB?
JRST STR75A ;YES, COPY IT
MOVEI EACC,2 ;NO--NEED 2 WORDS FOR THE ITEM THEN
SETZM 1(EACA)
SETZM 3(EACA)
MOVEM TE,2(EACA) ;*
LDB TE,RW.DAT ;*
MOVEM TE,4(EACA) ;*
ADD EACA,[XWD 4,4] ;*
MOVEM EACA,EOPNXT
PUSHJ PP,MOVGEN ;*
JRST SETR76
;WE HAVE STORED THE SOURCE ITEM AS AN EOPTAB-TYPE THING.
; COPY IT TO EOPTAB, ACCOUNT FOR 2 OR MORE WORDS (IT COULD BE SUBSCRIPTED!)
STR75A: MOVE TE,.RWSRC+1(TA) ;GET 2ND WORD
LDB TE,[POINT 6,TE,17] ;SUBSCRIPT COUNT IN OPERAND
LSH TE,1 ;= # WORDS FOR SUBSCRIPTS AND ADDITIVES
MOVEI EACC,2(TE) ;EACC:= TOTAL # WORDS IN THE OPERAND
HRLI TD,.RWSRC(TA) ;COPY FROM HERE
HRRI TD,1(EACA) ; TO HERE
MOVEI TC,(EACA) ;START
ADD TC,EACC ; + # WORDS
BLT TD,(TC) ;COPY THE OPERAND.
;SETUP THE "TO" ITEM:
MOVEI TD,(EACA) ;SETUP TD= START OF 2ND OPERAND
ADD TD,EACC
LDB TA,RW.DAT ;GET DATAB LINK OF WHERE TO MOVE ITEM
MOVEM TA,2(TD)
PUSHJ PP,LNKSET
LDB TE,DA.LNC ;GET LN&CP OF DATAB ITEM
MOVEM TE,1(TD) ;STORE IN EOPTAB
;CALL MOVGEN
MOVEI TD,2(EACC) ;TOTAL # WORDS USED UP IN EOPTAB
HRL TD,TD ;MAKE N,,N
ADD EACA,TD
MOVEM EACA,EOPNXT
PUSHJ PP,MOVGEN ;GENERATE THE MOVE
SETR76: PUSHJ PP,NXTDAT ;GET NEXT DATA ITEM
JRST SETR80 ;NO MORE--QUIT
LDB TE,DA.LVL ;IF NOT
CAIE TE,LVL.01 ; 01-LEVEL,
JRST SETR75 ; LOOP
JRST SETR72 ;START AGAIN WITH NEW GROUP
;DONE WITH 'GROUP INDICATE' CODE
SETR80: PUSHJ PP,GENPPJ ;GENERATE <POPJ 17,>
GETRD
LDB TA,RW.BRO ;DOES IT HAVE A BROTHER?
ANDI TA,LMASKR ;[1451]
JUMPN TA,SETR00 ;IF TRUE, LOOP BACK FOR IT
POPJ PP, ;NOT TRUE--QUIT
SUBTTL SET A SUM-COUNTER TO ZERO
SETZER: LDB TA,RW.SLK ;GET LINK TO ITEM
JUMPE TA,CPOPJ ;IGNORE ZEROES
MOVE TC,EOPLOC ;SET UP
MOVEI TC,1(TC) ; EOPTAB TO
MOVEM TC,CUREOP ; LOOK AS IF
MOVEM TC,OPERND ; ITEM CAME FROM GENFIL
SETZM 0(TC)
HRRZM TA,1(TC)
MOVEI LN,EBASEB ;NOW SET UP 'B' PARAMETERS
PUSHJ PP,SETOPN
TSWF FERROR ;IF TROUBLE,
POPJ PP, ; QUIT
MOVEI TD,MZC1. ;PRETEND IT IS 1-WORD ACCUMULATOR
HRRZ TE,EMODEB ;IF IT IS ACTUALLY
CAIN TE,D2MODE ; 2-WORDS,
MOVEI TD,MZC2. ; USE THAT ROUTINE
JRST (TD) ;CALL ONE OF THE ZERO ROUTINES & RETURN
SUBTTL PUT OUT RH, RF, PH & PF ROUTINES
ROUTS: GETRD
SETZM RPWDPR ;[1433] SET PAGE HEADING DUMMY ROUTINE FLAG
PUSHJ PP,GETTAG ;GET TAG FOR
DPB CH,RW.GIR ; 'GROUP INDICATE' ROUTINE
LDB TA,RW.FGP ;GET LINK TO FIRST GROUP
JUMPE TA,ROUT2A ;IF NONE--FORGET THE WHOLE THING
ROUTS1: PUSHJ PP,LNKSET ;CONVERT DATAB LINK TO ADDRESS
LDB TA,DA.RPW ;GET LINK TO ASSOCIATED RPWTAB ENTRY
ANDI TA,LMASKR ;[1451]CLEAR CODE BITS
JUMPE TA,ROUT2A
PUSH PP,TA ;SAVE IT
ADD TA,RPWLOC
HRRM TA,CURRPW ;SAVE IT
LDB TB,RW.TYP ;GET TYPE
CAIN TB,%RG.RH ;IS IT AN 'RH'?
JRST ROUTRH
CAIN TB,%RG.RF ;NO--'RF'?
JRST ROUTRF
CAIN TB,%RG.PH ;NO--'PH'?
JRST ROUTPH
CAIN TB,%RG.PF ;NO--'PF'?
JRST ROUTPF
ROUTS2: POP PP,TA ;GET ADDRESS OF 01-ITEM AGAIN
ADD TA,RPWLOC ;GET ABS. ADDR
LDB TA,RW.DAT ;GET DATAB LINK
PUSHJ PP,LNKSET
LDB TC,DA.FAL ;DOES THIS
JUMPN TC,ROUT2A ; ITEM
LDB TA,DA.POP ; HAVE A
JUMPN TA,ROUTS1 ; BROTHER?
ROUT2A: GETRD
LDB TE,RW.PHR ;IF THERE IS ALREADY A PH ROUTINE,
JUMPN TE,CPOPJ ; WE ARE DONE
PUSHJ PP,GETTAG ;THERE ISN'T--GET TAG FOR DUMMY ROUTINE
SETOM RPWDPR## ;[1433] SIGNAL THIS IS A DUMMY PAGE ROUTINE
DPB CH,RW.PHR
PUSHJ PP,PUTTAG ;PASS IT TO ASSEMBLER
PUSHJ PP,ROUT2B ;[200] AOS PAGE-COUNT
ROUT21: LDB CH,RW.GIR ;[200] GENERATE
HRLI CH,JRST. ;[200] <JRST GI-ROUTINE>
PUSHJ PP,RIFTAG ;REFERENCE TAG
JRST PUTASY ;[200]
ROUT2B: LDB CH,RW.PC ;[200] GENERATE
ANDI CH,LMASKB ;[200] <AOS PAGE-COUNTER>
IORI CH,AS.DAT ;[200]
HRLI CH,AOS. ;[200]
PUSHJ PP,PUTASY ;[1373]
SKIPE RPWDPR ;[1433] IS THIS A DUMMY PAGE ROUTINE ?
POPJ PP, ;[1433] YES, EXIT
LDB TE,RW.RHL## ;[1373] TEST IF HEADING LINES
JUMPE TE,CPOPJ ;[1373] NO, RETURN
LDB CH,RW.PC ;[1373] TO ALLOW MORE THAN 1
ANDI CH,LMASKB ;[1373] REPORT HEADING LINE
IORI CH,AS.DAT ;[1373] GENERATE
HRLI CH,MOV##+AC16 ;[1373] <MOVE 16,PAGE-COUNTER>
PUSHJ PP,PUTASY ;[1373]
MOVE CH,[CAIN.##+AC16,,1] ;[1373] GENERATE <CAIN 16,1>
PUSHJ PP,PUTASY ;[1373] TO CHECK FOR FIRST PAGE
LDB CH,RW.LC ;[1373]
ANDI CH,LMASKB ;[1373] TO SET LINE-COUNTER AT END OF
IORI CH,AS.DAT ;[1373] REPORT HEADER
HRLI CH,MOV+AC15 ;[1373] GENERATE <MOVE 15,LINE-COUNT>
PUSHJ PP,PUTASY ;[1373]
MOVE CH,[CAIE.##+AC16,,1] ;[1373] GENERATE <CAIE 16,1>
JRST PUTASY ;[1373] TO SKIP IF FIRST PAGE
ROUTRH: SKIPA TB,RW.RHR
ROUTRF: MOVE TB,RW.RFR
JRST ROUTS3
ROUTPF: MOVE TB,RW.PFR
ROUTS3: PUSHJ PP,ROUTSX
PUSHJ PP,GENPPJ ;GENERATE <POPJ 17,>
JRST ROUTS2
ROUTPH: PUSHJ PP,ROUTAG ;[200] TAG ROUTINE FOR HEADER
GETRD ;[200] GET RD LOCATION
PUSHJ PP,ROUT2B ;[200] AOS PAGE-COUNT
MOVE TB,RW.PHR ;[200] PAGE HEADER POINTER
GETRD ;[200] GET RD LOCATION
PUSHJ PP,ROUTSY ;[200] FINISH HEADER CODE FOR PAGE
GETRD ;[200] GET RD LOCATION
PUSHJ PP,ROUT21 ;[200] GENERATE JRST GI-ROUTINE
JRST ROUTS2
ROUTSX: GETRD
LDB TC,TB ;IF THERE IS A ROUTINE OF THIS TYPE,
JUMPN TC,ROUTSE ; IT IS AN ERROR
PUSHJ PP,GETTAG ;THERE ISN'T--GET A TAG FOR THIS ONE
DPB CH,TB ;SAVE IT
PUSHJ PP,PUTTAG
ROUTSY: MOVEI TE,LINE.H ;[200] SET UP
MOVEM TE,RWSAV7 ; FOR 'LINE.X' CALL
JRST WRIGRP
ROUTSE: MOVEI DW,E.354
JRST RWERA
ROUTAG: GETRD ;[200] GET RD LOCATION
MOVE TB,RW.PHR ;[200] PAGE HEADER
LDB TC,TB ;[200] IF THERE IS A ROUTINE OF THIS TYPE,
JUMPN TC,ROUTSE ;[200] IT IS AN ERROR
PUSHJ PP,GETTAG ;[200] THERE ISN'T--GET A TAG FOR THIS ONE
DPB CH,TB ;[200] SAVE IT
JRST PUTTAG ;[200] ASSEMBLE TAG AND RETURN
SUBTTL BUILD 'A' AND 'B' PARAMETERS FOR A CONTROL IDENTIFIER
;'A' IS CONTROL ID ITSELF, 'B' IS THAT %PARAM INTO WHICH
;CONTROL ID IS SAVED AT RUN-TIME.
BLDPAR: SWOFF FEOFF1 ;TURN OFF MOST FLAGS
MOVE TE,RWSAV2
ADD TE,RCOLOC
HLRZ TA,(TE) ;GET LINK TO DATAB
JUMPE TA,CPOPJ ;IF ZERO--FORGET IT
MOVE TB,EOPLOC ;CREATE OPERAND
MOVEM TA,2(TB)
PUSHJ PP,LNKSET ;GET DATAB ADDRESS
MOVEM TA,CURDAT ;SAVE
LDB TE,DA.LNC ;GET LN&CP
MOVEM TE,1(TB)
MOVSI TD,(LKSFLG) ; [1105] SET LINK SECTION BIT
LDB TC,DA.LKS ; [1105] FIND DATAB ENTRY BIT SETTING
SKIPE TC ; [1105] SKIP IF NOT LINKAGE ITEM
IORM TD,1(TB) ; [1105] SET L.S. IN OPERAND
MOVEI TC,1(TB)
MOVEM TC,CUREOP
MOVSM TC,OPERND
MOVEI TD,3(TB) ; [315] GET LOCATION OF 'B' PARAMETER IN EOPTAB
HRRM TD,OPERND ; [315] PUT IN RIGHT HALF OF OPERND
PUSHJ PP,SETOPA ; [315] SET UP 'A' OPERND
MOVE TE,RWSAV2 ; GET PREVIOUS DATA VALUE ADR
ADD TE,RCOLOC
HRRZ TA,(TE) ; . .
JUMPE TA,CPOPJ ; [315] NO PREVIOUS VALUE NO GO
MOVE TB,EOPLOC ; [315] GET BACK EOPLOC
MOVEM TA,4(TB) ; [315] STORE OPERAND
PUSHJ PP,LNKSET ; [315] GET CORE ADR OF OPERAND
LDB TE,DA.LNC ; [315] GET SOURCE LINE AND CHAR
MOVEM TE,3(TB) ; [315] STORE
MOVEI TC,3(TB) ; [315] SET UP FOR B PARM
PUSHJ PP,SETOPB## ; [315] SET UP SECOND OPERAND
JRST CPOPJ1
SUBTTL GENERATE CODE TO WRITE OUT ALL LINES FOR A GROUP
WRIGRP: PUSHJ PP,FINDLG ;FIND LARGEST PRINT RECORD
POPJ PP, ;TROUBLE--QUIT
SETZM RWSV10## ; [342] RESET LINE CLAUSE INDICATOR
SETOM RPWLIN ;NO 'LINE INTEGER' YET
SETOM RWSAV9 ; [305] RESET INTRA-GROUP CNT
SETZM RWSAV4 ;CLEAR COLUMN NUMBER
MOVE TA,CURRPW ;GET ADDRESS OF THIS ITEM
LDB CH,RW.SUP## ;COULD PRESENTATION OF THIS GROUP
; BE SUPPRESSED?
JUMPE CH,WRG00C ;NO
SUBI CH,1 ;YES, MAKE A %PARAM OFFSET
ADD CH,RPWPRS##
PUSH PP,CH ;SAVE IT
MOVE CH,[SETZM.+ASINC,,AS.MSC]
PUSHJ PP,PUTASY ;GEN CODE TO CLEAR THE %PARAM
POP PP,CH
PUSHJ PP,PUTASN
WRG00C: LDB CH,RW.USE ;IS THERE A 'USE' PROCEDURE?
JUMPE CH,WRG00B ;NO
ANDI CH,LMASKB
HRRZ TA,CH ;GET TAG NUMBER
PUSHJ PP,REFTAG## ;REFERENCE IT
IORI CH,AS.TAG
HRLI CH,EPJPP
PUSHJ PP,PUTASY ; GENERATE <PUSHJ PP,%TAG-FOR-USE>
MOVE TA,CURRPW ;REGET ADDRESS OF THE ITEM
LDB TB,RW.SUP ;COULD PRESENTATION OF THIS GROUP BE SUPPRESSED?
JUMPE TB,WRG00D ;JUMP IF NO
LDB TC,RW.TYP ;DIFFERENT CODE FOR DIFFERENT GROUP TYPES
CAIN TC,%RG.PH ;PAGE HEADER?
JRST WRG00E ;YES
CAIE TC,%RG.RH ;REPORT HEADER?
CAIN TC,%RG.RF ; OR REPORT FOOTING?
JRST WRG00F ;YES
CAIN TC,%RG.PF ;OR PAGE FOOTING?
JRST WRG00F ;YES
CAIE TC,%RG.CF
CAIN TC,%RG.CH ;CONTROL?
JRST WRG00G ;YES
JRST WRG00D ;* ELSE NO SUPPRESS CODE NOW*
;GEN SUPPRESS CODE FOR PAGE HEADER
WRG00E: PUSHJ PP,SUPSKE ;GEN "SKIPE SUPPRESS-FLAG"
GETRD ;SETUP TA AGAIN
PUSHJ PP,ROUT21 ;GEN "JRST GI"
JRST WRG00D ;GO ON
;GEN SUPPRESS CODE FOR RH, RF, OR PF
WRG00F: PUSHJ PP,SUPSKE ;GEN "SKIPE SUPPRESS-FLAG"
PUSHJ PP,GENPPJ ;GEN "POPJ PP,"
JRST WRG00D
;GEN SUPPRESS CODE FOR CF, CH
WRG00G: PUSHJ PP,SUPSKE ;GEN "SKIPE SUPPRESS-FLAG"
PUSHJ PP,SUPJTG ;GEN "JRST %TAG", SAVE AWAY %TAG.
WRG00D: MOVE TA,CURRPW ;REGET ADDRESS OF THE ITEM
WRG00B: LDB TE,RW.DAT ;SAVE DATAB LINK TO
HRLZM TE,RWSAV8 ; 01-LEVEL ITEM
LDB TE,RW.NLC ;GET 'NEXT GROUP' CODE
MOVSM TE,RWSAV3
LDB TE,RW.NXT ;AND 'NEXT GROUP' INTEGER
HRRM TE,RWSAV3
LDB TE,RW.TYP ;[1471]
CAIN TE,%RG.PH ;[1471] IS IT PH ?
JRST WRG0B1 ;[1471] YES, GO GEN LIN.H
LDB TE,RW.LCD ;IF THERE IS
MOVEM TE,RWSV10 ; [342] STORE LINE CODE
JUMPN TE,WRG00A ; NO LINE CODE,
SKIPL RWSAV7 ; AND THIS IS NOT REPORT-NAME GENERATION,
WRG0B1: PUSHJ PP,WRIG47 ;[1471] [305] IF PH GEN LIN.H AND FOR ALL GROUP BLANK PRINT LINE
MOVE TA,CURRPW
WRG00A: LDB TA,RW.DAT ;GET DATAB LINK FOR THIS ITEM
WRIG00: PUSHJ PP,LNKSET ;CONVERT TO ABSOLUTE
WRIG01: MOVEM TA,CURDAT ;SAVE ADDRESS OF DATAB ENTRY
LDB TA,DA.RPW
ANDI TA,LMASKR ;[1451]
ADD TA,RPWLOC
HRRM TA,CURRPW
LDB TB,RW.LCD ;GET LINE CODE
SKIPG RWSV10 ; [342] DO WE HAVE A LINE CODE FOR THIS GROUP?
MOVEM TB,RWSV10 ; [342] NO-STORE CURRENT ONE
JUMPE TB,WRIG06 ;IF NONE--NO WRITING NOW
CAIE TB,%RG.LN ;IS IT 'LINE IS INTEGER'?
JRST WRIG1B ;NO
LDB TE,RW.LIN ;YES--IS THAT
CAMN TE,RPWLIN ; INTEGER SAME AS LAST ONE?
JRST WRIG06 ;YES--PRETEND THERE IS NO 'LINE' CLAUSE
MOVEM TE,RPWLIN ;SAVE THIS INTEGER
WRIG1B: SKIPL RWSAV7 ;IF GENERATING 'RD'
SKIPN RWSAV4 ; OR LINE IS EMPTY
JRST WRIG02 ; DON'T WRITE LINE
PUSHJ PP,WRIG40 ;YES--WRITE OUT CURRENT LINE
MOVEI CH,0 ;WRITE OUT 'LINES TO SKIP'
PUSHJ PP,PUTASY
WRIG02: SETZM RWSAV4 ;RESET COLUMN NUMBER
MOVE TA,CURRPW ;*
LDB CH,RW.LIN ;*
LDB TB,RW.LCD ;*
PUSHJ PP,WRIG50 ;PUT OUT 'LINE.X' CODE
PUSHJ PP,WRIG45 ;SET PRINT LINE TO SPACES
;NEW LINE IS NOW SET UP
WRIG06: MOVE TA,CURDAT ;IF THIS
LDB TB,DA.SON ; ITEM IS ELEMENTARY,
JUMPE TB,WRIG07 ; PROCESS IT
MOVE TA,TB ;IT ISN'T, GO TO SON
JRST WRIG00
;WE HAVE AN ELEMENTARY ITEM
WRIG07: PUSHJ PP,WRIG20 ;GENERATE MOVE TO THIS ITEM
SKIPGE RWSAV7 ;IF WE ARE GENERATING 'RD'
JRST WRIG09 ; DON'T WRITE
MOVE TA,CURRPW ;GET BACK TO ITEM
MOVE TE,[XWD ESAVRW,EBASEB] ;GET PRINTER PARAMETERS
BLT TE,EBASBX
LDB TB,RW.COL ;ANY COLUMN NUMBER?
SOJL TB,WRIG09
;MOVE ITEM TO PRINT LINE
HRRZ TE,CURMNE ;GET ADDRESS OF 'CODE' ENTRY
JUMPE TE,WRIG08 ;IF ZERO, NO CODE
ADDI TB,2 ;ADD SIZE OF CODE TO 'B' INCREMENT
WRIG08: MOVEM TB,EINCRB
MOVE TA,CURDAT
LDB TE,DA.SGN ;IF
SKIPE TE ; ITEM IS SIGNED,
SWONS FASIGN ; SET FLAG,
SWOFF FASIGN ; ELSE CLEAR FLAG
LDB TE,DA.EXS
MOVEM TE,ESIZEA
ADD TE,EINCRB ;WILL ITEM FIT IN
CAMLE TE,ESIZEB ; PRINT-LINE?
JRST WRIG10 ;NO--ERROR
MOVEM TE,RWSAV4 ;YES--THAT IS LAST COLUMN SO FAR
MOVE TE,ESIZEA ;SIZE OF 'B' IS
MOVEM TE,ESIZEB ; SIZE OF 'A'
SETZM EDPLA ;NO
SETZM EDPLB ; DECIMAL PLACES
LDB TE,DA.RES ;SET RESIDUE
HRLM TE,ERESA
LDB TE,DA.USG ;SET
SUBI TE,1 ; MODE
MOVEM TE,EMODEA
SETZM EINCRA
SUB TA,DATLOC
ANDI TA,LMASKB
IORI TA,AS.DAT
HRRM TA,EBASEA
MOVE TD,EINCRB
MOVE TE,EMODEB ;GET CORRECT OUTPUT MODE
IDIV TD,BYTE.W(TE)
MOVEM TD,EINCRB
IMUL TC,BYTE.S(TE)
MOVNS TC
ADDI TC,^D36
HRLM TC,ERESB
MOVE TE,[XWD EBASEA,ESAVEB]; SAVE 'A' PARAMETERS
BLT TE,ESAVBX
SWOFF FANUM!FBNUM!FASUB!FBSUB; TURN OFF A FEW FLAGS
PUSHJ PP,MXX. ;GENERATE MOVE
MOVE TA,CURRPW ;IF THIS IS
LDB TE,RW.GPI ; NOT GROUP-INDICATE
JUMPE TE,WRIG09 ; WE ARE DONE
MOVE TE,[XWD ESAVEB,EBASEB]; RESTORE 'A' TO BE 'B'
BLT TE,EBASBX
MOVE TE,EMODEB ;CALL APPROPRIATE
MOVE TB,ESIZEB ;[241] GET SIZE OF GI ITEM
MOVEM TB,ESIZEZ ;[241] STORE FOR BLANKING ROUTINE
PUSHJ PP,@MSX.(TE) ; SPACE-FILL ROUTINE
;ITEM HAS BEEN MOVED--GO TO NEXT ITEM
WRIG09: PUSHJ PP,NXTDAT ;GET NEXT DATA ITEM
JRST WRIG9A ;NO MORE--DONE
LDB TE,DA.LVL ;IS IT
CAIE TE,LVL.01 ; 01-LEVEL?
JRST WRIG01 ;NO--LOOP
WRIG9A: SKIPGE RWSAV7 ;IF WE ARE GENERATING 'RD'
POPJ PP, ; NO WRITING
SKIPN RWSAV4 ;ANYTHING IN LINE?
JRST WRIG9B ;NO--JUST ADVANCE
PUSHJ PP,WRIG40 ;YES--WRITE THAT FINAL LINE
HLRZ TB,RWSAV3 ;GET 'NEXT GROUP' CODE
CAIN TB,%RG.PI ;IS IT 'PLUS INTEGER'?
JRST WRIG9C ;YES
MOVEI CH,0 ;NO--SET 'ADVANCE 0 LINES'
PUSHJ PP,PUTASY
WRIG9B: SKIPN CH,RWSAV3
POPJ PP,
HLRZ TB,CH
CAIE TB,%RG.NP
JRST WRIG50
JRST WRIG9E
WRIG9C: HRRZ CH,RWSAV3 ;SET 'ADVANCE N LINES'
PUSHJ PP,PUTASY
HRLI CH,MOVEI. ;GENERATE
PUSHJ PP,PUTASY ; <MOVEI. 0,<LINES TO ADVANCE>>
GETRD
LDB CH,RW.LC ;GENERATE
ANDI CH,TM.DAT ; <ADDM 0,LINE-COUNTER>
IORI CH,AS.DAT ;*
HRLI CH,ADDM. ;*
JRST PUTASY
;'NEXT GROUP IS NEXT PAGE'
;IF PH,PF,RH OR RF SIMPLY SKIP TO TOP-OF-FORM
WRIG9E: MOVE TA,CURRPW
LDB TE,RW.TYP
CAIE TE,%RG.PH
CAIN TE,%RG.PF
JRST WRIG9G
CAIE TE,%RG.RH
CAIN TE,%RG.RF
JRST WRIG9G
;CALL PAGE-FOOTING ROUTINE
GETRD
LDB CH,RW.PFR
JUMPE CH,WRIG9F
HRLI CH,EPJPP
PUSHJ PP,RIFTAG ;REFERENCE TAG
PUSHJ PP,PUTASY
;CALL PAGE-HEADING ROUTINE
WRIG9F: LDB CH,RW.PHR
JUMPE CH,WRIG9G
HRLI CH,EPJPP
PUSHJ PP,RIFTAG ;REFERENCE TAG
JRST PUTASY
WRIG9G: GETRD
LDB CH,RW.LC ;GENERATE
ANDI CH,TM.DAT ; <AOS LINE-COUNTER>
IORI CH,AS.DAT ; TO INSURE THAT
HRLI CH,AOS. ; LINE-COUNTER IS
PUSHJ PP,PUTASY ; ALREADY '1'
MOVE CH,[XWD MOVEI.+AC15,1]
PUSHJ PP,PUTASY
LDB CH,RW.RWT
HRLI CH,MOVEI.+AC16
PUSHJ PP,RIFTAG ;REFERENCE TAG
PUSHJ PP,PUTASY
MOVEI CH,LINE.H
JRST WRIG56
;ERROR--ITEM WILL NOT FIT IN PRINT-LINE
WRIG10: MOVE TA,CURDAT
MOVEI DW,E.360
PUSHJ PP,RWERA1
JRST WRIG09
;GENERATE CODE TO MOVE SOMETHING INTO AN ITEM
WRIG20: MOVE TA,CURRPW
LDB TB,RW.SCD ;IS IT
CAIN TB,%RG.SM ; SUM?
JRST WRIG37 ;YES
CAIE TB,%RG.SR ;NO--IS IT SOURCE?
POPJ PP, ;NO
;GENERATE CODE FOR 'SOURCE'
WRIG30: LDB TE,RW.GPI ;IS IT 'GROUP INDICATE'?
JUMPN TE,CPOPJ ;YES--FORGET IT
;IT IS EITHER A 'SOURCE' OR A 'SUM' IN A CONTROL-FOOTING GROUP
MOVE EACA,EOPLOC ;PTR TO EOPTAB
SKIPE .RWSRC(TA) ; DID WE STORE A SOURCE ITEM FOR EOPTAB?
JRST WRG31A ;YES, COPY IT
MOVEI EACC,2 ;NO--NEED 2 WORDS FOR THE ITEM THEN
LDB TE,RW.SLK ;GET LINK
MOVEM TE,2(EACA)
MOVE TA,CURRPW
LDB TE,RW.DAT
MOVEM TE,4(EACA)
LDB TA,RW.DAT ;GET DATAB LINK
PUSHJ PP,LNKSET
LDB TE,DA.LNC ;GET LN&CP OF DATAB ITEM
MOVEM TE,1(EACA)
MOVEM TE,3(EACA)
HRRZ TA,2(EACA) ;GET PTR TO SOURCE
PUSHJ PP,LNKSET
LDB TB,DA.LKS## ;IN LINKAGE SECT?
JUMPE TB,WRIG32 ;NO
MOVSI TB,400 ;SET GENFIL-TYPE LKS FLAG
IORM TB,1(EACA)
JRST WRIG32
;WE HAVE STORED THE SOURCE ITEM AS AN EOPTAB-TYPE THING.
; COPY IT TO EOPTAB, ACCOUNT FOR 2 OR MORE WORDS (IT COULD BE SUBSCRIPTED!)
WRG31A: MOVE TE,.RWSRC+1(TA) ;GET 2ND WORD
LDB TE,[POINT 6,TE,17] ;SUBSCRIPT COUNT IN OPERAND
LSH TE,1 ;= # WORDS FOR SUBSCRIPTS AND ADDITIVES
MOVEI EACC,2(TE) ;EACC:= TOTAL # WORDS IN THE OPERAND
HRLI TD,.RWSRC(TA) ;COPY FROM HERE
HRRI TD,1(EACA) ; TO HERE
MOVEI TC,(EACA) ;START
ADD TC,EACC ; + # WORDS
BLT TD,(TC) ;COPY THE OPERAND.
;SETUP THE "TO" ITEM:
MOVEI TD,(EACA) ;SETUP TD= START OF 2ND OPERAND
ADD TD,EACC
LDB TA,RW.DAT ;GET DATAB LINK OF WHERE TO MOVE ITEM
MOVEM TA,2(TD)
PUSHJ PP,LNKSET
LDB TE,DA.LNC ;GET LN&CP OF DATAB ITEM
MOVEM TE,1(TD) ;STORE IN EOPTAB
WRIG32: MOVE TA,CURRPW ; [315] GET RPWTAB FOR SOURCE ITEM
LDB TC,RW.TYP ; [315] GET TYPE OF GROUP
LDB TD,RW.FNC## ; [315] SEE IF FINAL
SKIPN TD ; [315] IF FINAL USE NORMAL SOURCE
CAIE TC,%RG.CF ; [315] CONTROL FOOTING ?
JRST WRG32B ; [315] NO USE NORMAL SOURCE ITEM
LDB TE,RW.SLK ; [315] GET DATAB ADR OF SOURCE
HRRZ TD,RWSAV2 ; [315] GET CONTROL ID
ADD TD,RCOLOC
WRG32L: LDB TD,RC.BRO ; GET NEXT CONTROL IDENTIFIER
JUMPE TD,WRG32B ; LOOP THRU CID
ADD TD,RCOLOC ; MAKE ABSOLUTE ADDRESS
HLRZ TB,(TD) ; [315] GET CONTROL ID DATAB ADR
MOVE TA,TD
CAME TE,TB ; [315] IF SOURCE IS CONTROL ID USE PREVIOUS
JRST WRG32L ; [315] NOT THIS CID-- LOOK FOR MORE CIDS
HRRZ TE,(TD) ; [315] GET DATAB ADR FOR PREVIOUS VALUE
MOVEM TE,2(EACA) ; [315] USE IT AS OPERAND
MOVSI TD,400 ; [315] GET LINKAGE SECTION BIT
ANDCAM TD,1(EACA) ; [315] SHUT IT OFF- PREVIOUS VALUE ALWAYS
; [315] IN W-S
CAIN EACC,2 ;PREVIOUS SENDING ITEM ONLY TAKE UP 2 WORDS?
JRST WRG32B ;YES, NOTHING ELSE TO DO.
; WE ARE REPLACING A SENDING ITEM THAT TOOK MORE THAN 2 WORDS IN EOPTAB.
; (IT MUST HAVE BEEN A SUBSCRIPTED 'SOURCE' ITEM)
MOVEI TD,1(EACA) ;GET START OF "TO" ITEM
ADD TD,EACC
MOVE TC,(TD) ;MOVE THEM UP IN EOPTAB
MOVEM TC,3(EACA)
MOVE TC,1(TD)
MOVEM TC,4(EACA)
MOVEI EACC,2 ;SET WORD COUNT OF SENDING ITEM TO 2
WRG32B: ;[315]
MOVEI TD,2(EACC) ;TOTAL # WORDS USED UP IN EOPTAB
HRL TD,TD ;MAKE N,,N
ADD EACA,TD
MOVEM EACA,EOPNXT
;SAVE CURDAT OVER CALL TO MOVGEN
HRRZ TD,CURDAT ;ABS ADDRESS
HRRZ TE,DATLOC ;ABS START
SUB TD,TE
PUSH PP,TD ;SAVE THIS VALUE
PUSHJ PP,MOVGEN ;GENERATE A MOVE
POP PP,TD ;RESTORE RELATIVE CURDAT ITEM
ADD TD,DATLOC ; MAKE ABS PTR
MOVEM TD,CURDAT ;RESTORE OLD CURDAT
MOVE TA,CURRPW ;IS THIS ITEM
LDB TE,RW.TYP ; IN A
CAIE TE,%RG.CF ; CONTROL-FOOTING GROUP?
CAIN TE,%RG.DE ;NO--DETAIL?
JRST WRIG34 ;YES--MAYBE SUMMING NEEDED
POPJ PP, ;NO
WRIG34: LDB TA,RW.SLK ;GET SOURCE OR SUM LINK
HRRM TA,RWSAV8 ;SAVE IT
PUSHJ PP,LNKSET ;CONVERT TO ADDRESS
LDB TE,DA.RBS ;IS IT REFERENCED BY SUM?
JUMPE TE,CPOPJ ;NO, JUST RETURN
SKIPN RWSV11 ;SUPPRESSING IN EFFECT?
PJRST SUMIT ;NO, JUST DO SUMMING AND RETURN
PUSHJ PP,SUPPTG ;PUT OUT %TAG: SUPPRESSION JUMPS TO HERE.
PUSHJ PP,SUMIT ;GO DO SUMMING
MOVE TA,RWSV12 ;REGET ADDRESS OF THE ITEM
ADD TA,RPWLOC ; . .
LDB TB,RW.SUP ;GET SUPPRESS OFFSET
PUSHJ PP,SUPSKE ;GEN "SKIPE SUPPRESS-FLAG"
PUSHJ PP,SUPJTG ;JUMP TO YET ANOTHER TAG.
POPJ PP, ;RETURN
;ITEM TO BE PRESENTED IS A 'SUM'
WRIG37: LDB TE,RW.TYP ;IS IT IN
CAIN TE,%RG.CF ; A CONTROL-FOOTING GROUP?
JRST WRIG30 ;YES--OK
POPJ PP, ; [315] ERROR- IGNORE- COBOLC ALREADY FLAGGED IT
;WRITE OUT THE CURRENT LINE
WRIG40: HLRZ CH,CURFIL ;GENERATE <WADV. FILTAB>
ANDI CH,LMASKS
IORI CH,AS.FIL
HRLI CH,WADV.
PUSHJ PP,PUTASY
MOVE CH,[XWD AS.XWD,1];PUT OUT FIRST HALF OF THE 'WADV.' PARAMETER
PUSHJ PP,PUTASN
MOVS CH,RWSAV4
LSH CH,6
TLO CH,20
HRRI CH,AS.CNB
JRST PUTASN
;SET PRINT-LINE TO SPACES
WRIG45: SKIPGE RWSAV7 ;IF WE ARE GENERATING 'RD',
POPJ PP, ; NO NEED FOR CODE
MOVE TE,[XWD ESAVRW,EBASEB];SET 'B' TO BE PRINT-LINE
BLT TE,EBASBX
HRRZ TA,CURMNE ;GET ADDRESS OF 'CODE' ENTRY
JUMPE TA,WRIG46 ;IF ZERO, NO CODE
MOVE TD,[XWD ^D36,AS.MSC] ;SET UP 'A'
MOVEM TD,EBASEA ; TO BE
LDB TD,MN.RCV ; 'CODE' LITERAL
HRRZM TD,EINCRA
MOVEI TD,2
MOVEM TD,ESIZEA
SETZM EDPLA
MOVEI TD,D6MODE
MOVEM TD,EMODEA
SWOFF FASUB!FANUM!FASIGN
JRST MXX. ;MOVE 'CODE' TO PRINT LINE
WRIG46: MOVE TE,ESIZEB ;SET SIZE
MOVEM TE,ESIZEZ ; TO SIZE OF PRINT-LINE
MOVE TE,EMODEB ;CALL APPROPRIATE
JRST @MSX.(TE) ; SPACING ROUTINE
WRIG47: LDB TB,RW.TYP ; [305] GET GROUP TYPE
CAIN TB,%RG.PH ; [305] PH?
PUSHJ PP,WRIG48 ; [305] YES- DO PH CODING
JRST WRIG45 ; [305] NO-DO REGLUAR LINE-SPACING
WRIG48: AOS RWSV10 ; [342] FOR PAGE HEADING
SETZM RWSAV4 ; [305] CLEAR COLUMN COUNT
LDB TA,RW.DAT ; [305] GET LINK TO DATAB LINE
PUSHJ PP,LNKSET ; [305] CONVERT TO REAL ADDR
MOVEM TA,CURDAT ; [305] SAVE IT
GETRD ; [305] GET BACK RD LCOACTION
LDB CH,RW.PHL ; [305] GET HEADING-LINE
MOVEI TB,%RG.LN ; [305] INTEGER LINE MODE
PJRST WRIG50 ; [305] GENERATE LINE.H CODE
;GENERATE 'LINE.X' CODE
WRIG50: SKIPGE RWSAV7 ;IF WE ARE GENERATING 'RD',
POPJ PP, ; NO NEED FOR CODE
AOS RWSAV9 ; [342] BUMP INTRA-GROUP CNTR
CAIE TB,%RG.NP ; [342] IF NEXT-PAGE
JRST WRIG58 ; [342] NOT NEXT PAGE-GO ON
PUSHJ PP,WRIG60 ; [342] NEXT PAGE SPACING
POPJ PP, ; [342] RETURN IF NO FURTHER SPACING NEEDED
WRIG58: HRLI CH,MOVEI.+AC15 ; [342] SET UP DESIRED LINE NUMBER
PUSHJ PP,PUTASY ; [342]
CAIE TB,%RG.PI ;IS IT 'PLUS INTEGER'?
JRST WRIG55 ;NO
LDB TB,RW.TYP ; [305] GET GROUP TYPE
SKIPG RWSAV9 ; [305] BEEN HERE BEFORE?
CAIE TB,%RG.PH ; [305] PH?
JRST WRIG54 ; [305] BEEN HERE BEFORE OR NOT PH-GO ON
GETRD ; [305] GET RD PNTR
HRLI CH,MOVEI.+AC15 ; [305] MOVEI AC15,LINE-INCREMENT
PUSHJ PP,PUTASY ; [305]
LDB CH,RW.PHL ; [305] GET HEADING LINE
HRLI CH,AC15+ADDI.## ; [305] ADD IT TO PLUS INTEGER
PUSHJ PP,PUTASY ; [305] GENERATE ADDI 15,HEADING
JRST WRIG55 ; [305] CONTINUE
WRIG54: GETRD ; [305] GET RD ADDREESS
LDB CH,RW.LC ;GET ADDRESS OF LINE-COUNTER
ANDI CH,LMASKB ;CONVERT TO
IORI CH,AS.DAT ; DATAB ASYFIL LINK
HRLI CH,AC15+AD## ;GENERATE
PUSHJ PP,PUTASY ; <ADD 15,LINE-COUNTER>
WRIG55: GETRD
LDB CH,RW.RWT ;GET ADDRESS OF RUN-TIME RPWTAB
HRLI CH,MOVEI.+AC16 ;GENERATE
PUSHJ PP,RIFTAG ;REFERENCE TAG
PUSHJ PP,PUTASY ; <MOVEI 16,RPWTAB>
MOVE CH,RWSAV7 ;GET 'LINE.X'
WRIG56: TSWT FAS3 ;ARE WE IN NON-RESIDENT SEGMENT?
JRST WRIG57 ;NO
MOVE TE,CH ;YES--
ANDI TE,LMASKS ; SET
ADD TE,EXTLOC ; FLAG
MOVSI TD,1B18 ; IN
IORM TD,1(TE) ; EXTAB
WRIG57: HRLI CH,EPJPP ;GENERATE <PUSHJ 17,LINE.X>
PUSHJ PP,RIFTAG ;REFERENCE IF TAG
JRST PUTASY ; AND RETURN
; LINE-NEXT PAGE CODE
; FIRST FOURCE TOP OF PAGE CODE
; THEN SPACE TO APPROPRIATE LINE DEPENDING ON TYPE OF LINE
; IF NO PAGE-LIMIT CLAUSE OF IF LINE TO SPACE IS 1 OR LESS
; ONLY FORCE TO TOP OF PAGE
; FOR SPACING ALL OTHERS
; IF REPORT HEADING OR REPORT FOOTING OR PAGE HEADING SPACE TO HEADING LINE
; IF DETAIL OR CONTROL HEADING OR CONTROL FOOTING SPACE TO FIRST DETAIL
; IF PAGE FOOTING SPACE TO FOOTING
WRIG60: HRLZI CH,MOVEI.+AC15 ; [342] SET TO LINE 0 TO FORCE TOP OF PAGE
PUSHJ PP,PUTASY ; [342]
PUSHJ PP,WRIG55 ; [342] FINISH UP LINE.X CODE
GETRD ; [342] PICK UP RD TABLE
LDB TB,RW.PAG ; [342] ANY PAGE CLAUSE
MOVE TA,CURRPW ; [342] POINT TO REPORT CLAUSE
JUMPE TB,WRIG69 ; [342] EXIT NO PAGE CLAUSE
LDB TB,RW.TYP ; [342] GET TYPE OF LINE
GETRD ; [342] PICK UP RD TABLE
CAIE TB,%RG.RH ; [342] IF REPORT HEADING
CAIN TB,%RG.PH ; [342] OR PAGE HEADING
JRST WRIG66 ; [342] USE HEADING
CAIN TB,%RG.RF ; [342] IF REPORT FOOTING INCREMENT
JRST WRIG64 ; [342] PAGE-COUNTER THEN USE HEADING
CAIE TB,%RG.DE ; [342] IF FIRST DETAIL
CAIN TB,%RG.CH ; [342] OR CONTROL HEADING
JRST WRIG65 ; [342] USE FIRST DETAIL
CAIN TB,%RG.CF ; [342] LIKE-WISE FOR CONTROL FOOTING
JRST WRIG65 ; [342]
CAIE TB,%RG.PF ; [342] FOR PAGE FOOTING USE FOTTING
JRST WRIG69 ; [342] NONE OF THE ABOVE EXIT
LDB CH,RW.CFL ; [342] CONTROL FOOTING
JRST WRIG68 ; [342] FINISH UP
WRIG65: LDB CH,RW.FDE ; [342] FIRST DETAIL
JRST WRIG68 ; [342]
WRIG64: PUSHJ PP,ROUT2B ;[1007] GENERATE 'AOS PAGE-COUNTER'
WRIG66: LDB CH,RW.PHL ; [342] PAGE HEADING
WRIG68: CAIG CH,1 ; [342] IF DESIRED LINE NOT > 1 EXIT NOW
JRST WRIG69 ; [342] IT ISN'T
MOVEI TB,%RG.LN ; [342] SET LINE CODE FOR INTEGER
AOS (PP) ; [342] SET UP FOR SKIP RETURN
WRIG69: MOVE TA,CURRPW ; [342] POINT TO REPORT ITEM
POPJ PP, ; [342] RETURN
SUBTTL GENERATE SUMS WHICH REFERENCE CURRENT ITEM
;ENTER WITH LINK TO SUM IDENTIFIER IN RH OF RWSAV8,
; AND DATAB LINK TO REPORT-GROUP IN LH OF RWSAV8
SUMIT: MOVE TA,CURRPW ;GET TO
LDB TA,RW.DAT ; CF OR DE
PUSHJ PP,LNKSET ; DATAB ENTRY
LDB TB,DA.LNC ;SAVE LN&CP FOR LATER USE
MOVE EACA,EOPLOC ;*
MOVEM TB,1(EACA) ;*
MOVEM EACA,EOPNXT ;SET 'EOPTAB IS EMPTY'
GETRD
LDB TD,RW.CID ;ANY CONTROL IDENTIFIERS?
JUMPE TD,CPOPJ ;IF NOT--QUIT
PUSH PP,CURRPW ;SAVE SOME
PUSH PP,RWSAV2 ; STUFF
ANDI TD,LMASKR ;[1451] COMPUTE ADDRESS OF
HRRZM TD,RWSAV2 ; AND SAVE IT
SUMIT1: ADD TD,RCOLOC
HRRZ TA,1(TD) ;GET LINK TO CF GROUP
SUMIT3:
ANDI TA,LMASKR ;[1451]
JUMPE TA,SUMIT7 ;IF NONE, NO CF
ADD TA,RPWLOC ; ASSOCIATED RPWTAB ENTRY
HRRM TA,CURRPW ;SAVE IT
LDB TE,RW.SCD ;DOES THAT ITEM
CAIE TE,%RG.SM ; HAVE A SUM CLAUSE?
JRST SUMIT6 ;NO
LDB TE,RW.NSI ;YES--GET NUMBER OF SUM IDENTIFIERS
JUMPE TE,SUMIT6 ;IF NONE--FORGET IT
MOVEM TE,RWSAV6 ;SAVE IT
HRRZ TA,CURRPW ;COMPUTE BYTE-POINTER TO
ADD TA,[POINT 18,SZ.RPG] ; SUM-IDENTIFIER LINKS
MOVEM TA,RWSAV5 ;SAVE IT
SUMIT4: ILDB TE,RWSAV5 ;GET LINK TO SUM-IDENTIFIER
JUMPE TE,SUMIT5 ;IF ZERO, FORGET IT
HRRZ TD,RWSAV8 ;IF NOT THE
CAIE TE,(TD) ; ONE WE ARE AFTER,
JRST SUMIT5 ; GO TO NEXT IDENTIFIER
MOVE TA,CURRPW ;GET CURRENT ITEM'S RPWTAB LINK
LDB TB,RW.NUP## ;GET NUMBER OF UPON IDENTIFIERS
JUMPE TB,SMIT4A ;IF NO UPON IDENTS, GEN CODE TO SUM
LDB TA,RW.UPN ;GET UPON TABLE LINK
ADD TA,RPWLOC ;MAKE REAL ADDRESS
SMIT3A: LDB TE,RW.UP1## ;GET UPON IDENTIFIER
HLRZ TD,RWSAV8 ;IS THIS THE SUM IDENTIFIER UPON DATA ITEM ?
CAIN TE,(TD)
JRST SMIT4A ;UPON DATA NAMES MATCH, GENERATE CODE
SUBI TA,SZ.RPU ;GET ADDRESS OF NEXT UPON DATA ITEM ELEMENT
SOJG TB,SMIT3A ;CHECK NEXT UPON STATEMENT
JRST SUMIT5 ;DATA ITEMS DO NOT MATCH UPON LIST, DON'T GEN
SMIT4A: MOVE EACA,EOPLOC ;IS EOPTAB
CAME EACA,EOPNXT ; EMPTY?
JRST SMIT4B ;NO--THERE MUST BE SUM RESULT OPS ALREADY
HRRZ TA,RWSAV8 ;YES--SET UP
MOVEM TA,2(EACA) ; EOPTAB FOR 'ADDTGN'
PUSHJ PP,LNKSET ;IF ITEM IS
LDB TE,DA.CLA ; NOT
CAIE TE,%CL.NU ; NUMERIC
JRST SMIT10 ; OR
LDB TE,DA.EDT ; IT IS
JUMPN TE,SMIT10 ; EDITED, ERROR
MOVSI TD,(LKSFLG) ;[1105] SET LINKAGE SECTION BIT
LDB TC,DA.LKS ;[1105] FIND DATAB ENTRY BIT SETTING
SKIPE TC ;[1105] SKIP IF NOT LINKAGE ITEM
IORM TD,1(EACA) ;[1105] SET L.S. IN OPERAND
ADD EACA,[XWD 2,2] ;GENERATE
MOVEM EACA,EOPNXT ; THE
PUSHJ PP,ADDTGN ; FIRST HALF OF 'ADD TO'
MOVE EACA,EOPLOC
MOVE TA,CURRPW ; [326] GET CURRENT EPRT ITEM
LDB TA,RW.SLK ; [326] GET SOURCE (I.E. SUM ) ITEM POINTER
MOVEM TA,2(EACA) ; [326] PUT SUM ITEM IN EOPTAB
PUSHJ PP,LNKSET ; [326] CONVERT SUM POINTER TO REAL ADDRESS
LDB TB,DA.LNC ; [326] GET SOURCE LINE AND CHAR POSITION OF SUM ITEM
MOVEM TB,1(EACA) ; [326] STORE THIS INTO EOPTAB
JRST SMIT4D ; [326] FINISH SETTING EOPTAB
SMIT4B: MOVE EACA,EOPNXT
MOVE TE,-1(EACA) ;GET LN,CP FROM PREVIOUS OPERAND
MOVEM TE,1(EACA) ;PUT IT IN THIS OPERAND
MOVE TA,CURRPW
LDB TA,RW.SLK
MOVEM TA,2(EACA)
SMIT4D: ADD EACA,[XWD 2,2] ; [326] BUMP UP EOPTAB POINTER
MOVEM EACA,EOPNXT
;STEP TO NEXT IDENTIFIER FOR THIS SUM
SUMIT5: SOSLE RWSAV6 ;IF MORE SUM ID'S,
JRST SUMIT4 ; LOOP
SUMIT6: PUSHJ PP,NXTDAT ;GO TO NEXT DATAB ITEM
JRST SUMIT7 ;NO MORE--WE ARE DONE WITH GROUP
LDB TE,DA.LVL ;IF THE NEXT IS
CAIN TE,LVL.01 ; 01-LEVEL,
JRST SUMIT7 ; WE ARE DONE WITH GROUP
LDB TA,DA.RPW ;NOT DONE--GET ASSOCIATED RPWTAB ENTRY
JRST SUMIT3 ; AND LOOP
;STEP TO NEXT CONTROL PARAMETER
SUMIT7: MOVE TA,RWSAV2 ; RESTORE LINK TO CONTROL IDENTIFIER
ADD TA,RCOLOC ; MAKE ABSOLUTE ADDRESS
LDB TD,RC.BRO ; GET BROTHER
JUMPE TD,SUMIT8 ; NO MORE BROTHERS, EXIT
MOVEM TD,RWSAV2 ; SAVE BROTHER LINK
JRST SUMIT1 ; DO THAT CF GROUP
SUMIT8: MOVE EACA,EOPNXT ;IS THERE
CAME EACA,EOPLOC ; ANYTHING IN EOPTAB?
PUSHJ PP,RESGEN ;YES--GENERATE 'RESULT'
POP PP,RWSAV2 ;RESTORE SOME
POP PP,CURRPW ; LOCATIONS
POPJ PP, ;GO AWAY
;ERROR--ITEM TO BE SUMMED IS NOT NUMERIC
SMIT10: MOVEI DW,E.362
PUSHJ PP,RWERA
JRST SUMIT5
SUBTTL FIND LARGEST PRINTING RECORD FOR REPORT
;SET UP 'ESAVRW' WITH PARAMETERS SPECIFYING LARGEST RECORD OF
; PRINTING FILE
FINDLG: GETRD
LDB TA,RW.FIL ;GET LARGEST RECORD FOR FILE, IN
JUMPE TA,CPOPJ ; OPERAND FORMAT, INTO
MOVSM TA,CURFIL
PUSHJ PP,LNKSET
HRRM TA,CURFIL
PUSHJ PP,LARGER## ;[245] 'EINTO'
MOVEI LN,ESAVRW ;[245] SET FOR OPERAND STORE
MOVEI TC,EINTR## ;[245] SET EOPTAB TYPE ADR
SETZM EINTR ;[245] CLEAN UP, SO ENDIFGEN WON'T BE CONFUSED
PUSHJ PP,SETOPN
TSWT FERROR ;IF ERROR,
AOS (PP) ; DON'T BUMP RETURN
POPJ PP,
SUBTTL SKIP DOWN TO NEXT DATAB ITEM
;EXIT TO CALL+1 IF NO MORE DATAB ITEMS
;EXIT TO CALL+2 IF ANOTHER FOUND, WITH DATAB ADDRESS IN 'TA'
NXTDAT: HRRZ TA,CURRPW ;GET TO RPW ENTRY
LDB TA,RW.DAT ;GET TO
PUSHJ PP,LNKSET ; CURRENT DATAB ENTRY
LDB TE,DA.SON ;IF HE HAS A SON,
JUMPN TE,NXDAT3 ; HE IS WHAT WE WANT
NXDAT2: LDB TE,DA.FAL ;IF THERE IS A BROTHER,
JUMPE TE,NXDAT4 ; GO TO HIM
LDB TA,DA.POP ;GET FATHER LINK
LDB TE,LNKCOD ;GET TABLE TYPE
CAIE TE,TB.DAT ;IF NOT DATAB,
POPJ PP, ; QUIT
PUSHJ PP,LNKSET ;GET ADDRESS AND
JRST NXDAT2 ; TRY HIM
NXDAT3: SKIPA TA,TE ;TA_SON LINK
NXDAT4: LDB TA,DA.BRO ;TA_BROTHER LINK
JUMPE TA,CPOPJ ;IF ZERO--EXIT TO CALL+1
AOS (PP) ;WE HAVE NEXT ITEM
JRST LNKSET ;CONVERT TO ADDRESS AND EXIT TO CALL+2
SUBTTL SET UP 'CURMNE' TO POINT TO 'CODE'
SETCOD: GETRD
LDB TA,RW.COD ;GET LINK TO MNETAB ENTRY FOR 'CODE'
SETZM CURMNE ;CLEAR 'CURMNE'
JUMPE TA,CPOPJ ;IF ZERO, NO CODE
PUSHJ PP,LNKSET ;GET ADDRESS OF MNETAB ENTRY
HRRZM TA,CURMNE
LDB TE,MN.RCV## ;GET CODE
JUMPE TC,[SETZM CURMNE ;IF ZERO, CLEAR OUT
GETRD
DPB TC,RW.COD ; LINK
POPJ PP,] ; AND FORGET THE WHOLE THING
TRNE TE,700000 ;IF ALREADY SET UP,
POPJ PP, ; NO ACTION NEEDED
;GENERATE LITERAL FOR CODE VALUE
SETCD1: MOVE TA,[SIXLIT,,1] ;PUT OUT SIXBIT LITERAL
PUSHJ PP,STASHP ; HEADER
HRRZ TA,CURMNE ;RESTORE MNETAB LINK
SETZ TB, ;CLEAR TB
MOVE TE,[POINT 6,TB]
SETCD3: LDB CH,MN.RCV ;GET BOTH LITERAL BYTES
MOVE TA,CH ;MAKE A COPY
LSH CH,-7 ;FIRST BYTE
ANDI TA,177 ;SECOND BYTE
PUSHJ PP,SETCD5 ;CONVERT TO SIXBIT
EXCH CH,TA ;GET SECOND BYTE
PUSHJ PP,SETCD5 ;CONVERT IT
LSH TA,6 ;MAKE ROOM
IOR TA,CH
LSH TA,4*6 ;LEFT JUSTIFY
PUSHJ PP,POOLIT ;COMPLETE LITERAL
MOVE TA,CURMNE ;PUT
SKIPN TE,PLITPC ;GET POOLED LIT PC
MOVE TE,ELITPC ; ADDRESS
IORI TE,AS.LIT ; OF LITERAL
DPB TE,MN.RCV ; INTO MNETAB
SKIPN PLITPC
AOS ELITPC ;BUMP LITERAL PC
POPJ PP,
SETCD5: CAIG CH,137 ;IF IT IS
CAIGE CH,40 ; OUTSIDE SIXBIT RANGE,
JRST SETCD6 ; WE NEED SPECIAL PROCESSING
SUBI CH,100 ;CONVERT TO SIXBIT
POPJ PP,
;BYTE IS OUTSIDE SIXBIT RANGE
SETCD6: CAIG CH,"Z"+40 ;IS IT
CAIGE CH,"A"+40 ; LOWER-CASE?
JRST SETCD7 ;NO--TROUBLE
SUBI CH,40 ;YES--CONVERT TO SIXBIT UPPER-CASE
POPJ PP, ; AND USE THAT
SETCD7: PUSH PP,TA
PUSH PP,TE
GETRD
MOVEI DW,E.387
LDB LN,RW.LN
LDB CP,RW.CP
PUSHJ PP,FATAL
POP PP,TE
POP PP,TA
MOVEI CH,'\'
POPJ PP,
SUBTTL SUPSKE - GEN "SKIPE SUPPRESS-FLAG"
;CALL: TA/ POINTS TO RD ENTRY FOR THE GROUP
; TB/ IS THE SUPPRESS-FLAG %PARAM OFFSET
; PUSHJ PP,SUPSKE
;RETURN: SMASHES TA,TB
SUPSKE: SUBI TB,1 ;GET REAL OFFSET
ADD TB,RPWPRS ;GET %PARAM+N
PUSH PP,TB ;SAVE IT
MOVE CH,[SKIPE.+ASINC,,AS.MSC]
PUSHJ PP,PUTASY ;GEN FIRST PART OF INSTRUCTION
POP PP,CH ;RESTORE %PARAM+N
PJRST PUTASN ;FINISH INSTRUCTION AND RETURN
;ROUTINE TO GENERATE JRST %TAG AND STORE IT IN RWSV11
SUPJTG: PUSHJ PP,GETTAG ;GET A TAG
HRRZM CH,RWSV11## ;SAVE IT
HRRZ TA,CH ;GET TAG NUMBER
PUSHJ PP,REFTAG## ;REFERENCE IT
;PUT OUT "JRST %TAG"
HRRZ CH,RWSV11 ;GET %TAG
HRLI CH,JRST.
PJRST PUTASY
;ROUTINE TO WRITE TAG% FROM RWSV11 IF WE PUT ONE THERE,
; AND ZERO IT
SUPPTG: SKIPN RWSV11 ;IS THERE A TAG?
POPJ PP, ;NO, JUST RETURN
MOVE CH,RWSV11 ;GET IT
PUSHJ PP,PUTTAG ;WRITE THE %TAG OUT
SETZM RWSV11 ;CLEAR TAG
POPJ PP, ;RETURN
SUBTTL PUT OUT AN ERROR DIAGNOSTIC
;ENTER WITH DIAG NUMBER IN 'DW'
RWERA: MOVE TA,CURRPW
LDB TA,RW.DAT
PUSHJ PP,LNKSET
RWERA1: LDB CP,DA.CP
LDB LN,DA.LN
JRST FATAL
EQTEST==1B29 ;'EQUAL' FLAG IN 'IF' OPERAND
EXTERNAL RWSAV9 ; [305]
EXTERNAL RWSAV2,RWSAV3,RWSAV4,RWSAV5,RWSAV6,RWSAV7,RWSAV8
EXTERNAL RWBRKC,RWMBRK,RPWLIN,LMASKB,LMASKS
EXTERNAL EBASEA,EBASBX,ESIZEA,ESIZEB,EMODEA,EMODEB
EXTERNAL EBASEB,ESAVRW,EINCRA,EINCRB,ESIZEZ
EXTERNAL EDPLA,EDPLB,ERESA,ERESB,ESAVEB,ESAVBX,EBASBX
EXTERNAL EXTLOC,RPWLOC,RPWNXT,CURRPW,CURFIL,DATLOC,CURDAT
EXTERNAL EOPLOC,EOPNXT,CUREOP,CURMNE,EAS1PC,ELITPC
EXTERNAL OPERND,BYTE.W,BYTE.S,OPLINE,LNKCOD
EXTERNAL D2MODE,D6MODE
EXTERNAL JRST.,EPJPP,MOVEI.,MOVEM.,SETOM.,POPJ.,AOS.,SOS.,SOSGE.,WADV.,ADDM.
EXTERNAL HRLOI.,SETZM.,SKIPE.,LINE.C,LINE.D,LINE.H,LIN.RH
EXTERNAL SIXLIT
EXTERNAL DA.POP,DA.BRO,DA.LNC,DA.LVL,DA.RES,DA.RPW,DA.SON,DA.USG,DA.EXS
EXTERNAL DA.LN,DA.CP,DA.FAL,DA.CLA,DA.SGN,DA.EDT,DA.RBS
EXTERNAL TB.DAT,TM.DAT
EXTERNAL AS.CNB,AS.DAT,AS.FIL,AS.MSC,AS.PAR,AS.XWD,AS.OCT,AS.TAG
EXTERNAL AS.LIT
EXTERNAL RW.BRO,RW.LN,RW.CP,RW.FIL,RW.FGP,RW.LC,RW.PC
EXTERNAL RW.PHL,RW.CFL,RW.FDE,RW.LDE,RW.PAG,RW.RWT,RW.RHR,RW.RFR
EXTERNAL RW.PHR,RW.PFR,RW.GIR,RW.COD,RW.CID,RW.BKT,RW.FBT
EXTERNAL RW.RDL,RW.DAT,RW.LCD,RW.NLC,RW.SCD,RW.TYP,RW.NSI,RW.LIN
EXTERNAL RW.COL,RW.NXT,RW.RES,RW.SLK,RW.UPN,RW.GPI,RW.RSF,RW.USE
EXTERNAL RW.SUP
EXTERNAL CPOPJ,CPOPJ1
END