Trailing-Edge
-
PDP-10 Archives
-
BB-H580E-SB_1985
-
ipcgen.mac
There are 14 other files named ipcgen.mac in the archive. Click here to see a list.
; UPD ID= 3245 on 11/18/80 at 4:10 PM by NIXON
TITLE IPCGEN FOR COBOL V12C
SUBTTL GENERATORS FOR SUBPROGRAMMING STATEMENTS CHUCK MCCOMAS
SEARCH COPYRT
SALL
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1974, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
SEARCH P
%%P==:%%P
;EDITS
;NAME DATE COMMENTS
;V12B****************
;JEH 13-FEB-84 [1513] Fix second descriptor word of Fig. Const. arg.
;JEH 12-MAY-83 [1470] MAKE PUTAYY EXTERNAL FOR EDIT 1447
;SMI 28-DEC-82 [1447] ILL. MEM. REF WHEN PROGRAM-ID CONTAINS ANY
; CHARACTER OTHER THAN "A"-"Z", "a"-"z", "0"-"9"
;DMN 07-OCT-82 [1414] OUTPUT CALL TO INITDB FOR SUBPROGRAMS CONTAINING
; DBMS INVOKE STATEMENT
;JEH 30-MAR-82 [1346] FATAL IF DATA KEY CONV RTN ADDR CAN'T BE STORED
;DMN 31-AUG-81 [1306] FIX BAD TABLE LINK IF RELATIVE KEY HAS ERROR
;V12*****************
;DAW 24-JUL-80 [1041] BAD CODE GENERATED FOR "CALL <IDENTIFIER>"
;DMN 26-MAR-80 [1002] CHANGE CHECK FOR MISSING CALL/ENTER ARGS.
;DMN 24-OCT-79 [752] COBOL-74 ILLEGAL INST. IF DATAB CONTAINS ERRORS
;V12*****************
;MFY 1-FEB-79 [632] REMOVE SECOND (WRONG) DEFINITION OF ARGSGN
;DAW 4-OCT-78 [565] PASS NUMERIC EDITED FIELDS TO A SUBROUTINE CORRECTLY
;V10*****************
;VR 20-MAY-77 [475] PASS NUMERIC AND SIGN BITS TO MACRO SUBROUTINE CORRECTLY
;EHM 23-JUN-76 [432] PASS NUMERIC FIELDS TO A SUBROUTINE CORRECTLY
; PASS SIGN BIT CORRECTLY, USE EXTERNAL SIZE
; 3/19/76 [411] CORRECT PARAM WORD SETTING FOR SUBSCRIPTED USING ARGS
;DBT 1/18/75 REVERSE PUTASY AND PUTASN CALLS IN ENTRY GENERATION
; UUO WAS NOT BEING SENT TO PUTASY
;GPS 12/23/74 MAKE ARG AND SARG SUBROUTINES AVAILABLE FOR USE BY SIMULTANEOUS UPDATE
;DBT 12/18/74 MODIFY CANGEN TO GENERATE AN ARGUMENT LIST
; FOR THE CANCEL CALL WHICH PASSES THE ADDRESS
; OF THE SUBROUTINE TO BE CANCELED RATHER THAN
; THE NAME OF IT
;DBT 1/23/75 REVERSE PUTASY/ASN CALLS IN GOBKGN
;DBT 1/24/75 DETECT CANCEL OF CURRENT ROUTINE
;DBT 1/24/75 REVERSE PTASY/N CALLS IN ENTRYGEN
;DBT 6/23/75 GENERATE THE SIXBIT ENTRY NAME AT ENTRY-1 AND
; GENERATE A POINTER TO THE MAIN ENTRY POINT AT
; ENTRY-2. THESE WILL BE USED BY COBDDT AND
; LIBOL ERROR HANDLING.
;********************
; EDIT 330 SKIP SUBARG IF ANY FATAL ERROR AND FIX GOING AROUND SUBSCRIPT IN DUMMY ARGUMENT
; EDIT 324 JUMP AROUND DECLARITIVES IF ANY IN A SUBPROGRAM
; EDIT 254 PREVENT INDIRECT BIT BEING TURNED FOR COMP USING ARG AT WRONG TIME
;**; EDIT 124 FIX UP CALL FOR USING ARGS
;**; EDIT 112 PASS CORRECT USAGE FOR USING ARGUMENTS IN CALL AND ENTER STATEMENTS.
TWOSEG
.COPYRIGHT ;Put COPYRIGHT statement in .REL file.
RELOC 400000
SALL
ENTRY ENTRGN ;ENTER AND CALL
ENTRY ARGGEN ;USING
ENTRY GOBKGN ;GOBACK AND EXIT PROGRAM
ENTRY NTRYGN ;ENTRY
ENTRY CANGEN ;CANCEL
ENTRY PUTOC0 ;PUT AN OCTAL 0 IN AS1FIL
ENTRY SARG ;GENERATE CODE TO EVALUATE SUBSCRIPT
ENTRY ARG ;SET UP TO GENERATE CODE FOR ARGUMENT
EXTERN STASHI,STASHL,STASHP,STASHQ,POOLIT,CPOPJ
EXTERN PUT.EX,PUT.PJ,PUTAYY ;[1470]
IPCGEN::
SUBTTL GENERATE AN "ENTER" OR "CALL"
IFN ANS68,<
ENTRGN: TLNE W1,(CALLF!MACRO!F10) ;IS THIS A "CALL" OR ENTER MACRO OR ENTER FORTRAN?
JRST CALLGN ;YES, USE NEW CALLING SEQUENCE
;ENTER FORTRAN-IV -- USE OLD CALLING SEQUENCE
SWOFF FEOFF1 ;TURN OFF MOST FLAGS
MOVEM W1,OPLINE
PUSHJ PP,READEM
MOVEM EACA,EOPNXT##
EXCH W1,OPLINE
HRRZ TE,W2
CAIN TE,ARGOP.
PUSHJ PP,SUBARG
HRRZ TA,EOPLOC ;PICK UP OPERAND'S TABLE-LINK
MOVE CH,2(TA)
ANDI CH,77777 ;CLEAR ALL BUT LOW-ORDER 15 BITS
IORI CH,AS.EXT ;SET "EXTERNAL"
HRLI CH,AC16+JSA.## ;F40 -- USE JSA WITH IN LINE ARGS
PUSHJ PP,PUTASY##
TSWT FAS3 ;ARE WE IN NON-RESIDENT SEGMENT?
JRST ENTR4 ;NO--GO TO "USING"
MOVE TA,2(TA) ;YES--GET OPERAND LINK
PUSHJ PP,LNKSET## ;GET EXTAB ADDRESS
SETO TE, ;SET "REFERENCED IN NON-RES"
DPB TE,EX.NRS
ENTR4: MOVE W1,OPLINE
HRRZ TE,W2
CAIN TE,ARGOP.
JRST ARGGEN
ENTR5: MOVE TD,EOPLOC
HRLI TD,2(TD)
MOVN EACA,[XWD 2,2]
ADDB EACA,EOPNXT
BLT TD,0(EACA)
JRST @EOPCOD##(TE)
>
SUBTTL GENERATE "USING" ARGUMENT LIST FOR ENTER FORTRAN-IV
ARGGEN: TSWF FERROR ;IF ERRORS WERE SEEN,
POPJ PP, ; QUIT
HRRZ TC,EOPLOC ;AIM CUREOP AT FIRST USING OPERAND
ADDI TC,3
MOVEM TC,CUREOP##
ARGEN1: PUSHJ PP,ARG ;PROCESS CURRENT ARG OPERAND
;GENERATE IN LINE ARG LIST ENTRY FOR THIS OPERAND
MOVE TC,CUREOP ;SET PTR TO OPERAND
MOVE CH,(TC) ;GET 1ST WORD TO PUT OUT
JUMPE CH,ARGN3B ;NONE THERE
PUSHJ PP,PUTASY
MOVE CH,1(TC) ;SECOND WORD
JUMPE CH,ARGN3B ;NONE THERE
PUSHJ PP,PUTASN##
ARGN3B: MOVEI TC,2 ;BUMP UP TO NEXT EOPTAB ENTRY
ADDB TC,CUREOP
MOVE EACA,EOPNXT ;END OF LIST?
CAIL TC,(EACA)
POPJ PP, ;YES
SKIPE (TC) ;NO, THIS A WIPED OUT SUBSCRIPT?
JRST ARGEN1 ;NO, PROCESS IT
JRST ARGN3B ;YES, TRY NEXT ENTRY
;SCAN THRU ARGUMENT OPERANDS LOOKING FOR SUBSCRIPTED ITEMS
SUBARG: MOVEM EACA,EOPNXT
HRRZ TC,EOPLOC
ADDI TC,3
CAIL TC,(EACA)
JRST BADEOP##
SARG1: MOVEM TC,CUREOP
PUSHJ PP,SARG ;SET UP SUBSCRIPTS FOR CURRENT ARG
MOVE EACA,EOPNXT
CAIL TC,(EACA)
POPJ PP,
JRST SARG1
SUBTTL CALL/ENTER ARGUMENT ROUTINES
;PROCESS ONE ARG OPERAND
; PUT 2-WORD DESCRIPTOR IN LITERALS IF NECESSARY
; AND SET UP CODE TO PUT OUT TO ASSEMBLY FILE
ARG: TSWF FFATAL ; [330] ANY FATAL ERRORS IN PROGRAM?
POPJ PP, ; [330] YES GO NO FURTHER
AOS ARGCTR ;COUNT ARGS
MOVE TE,0(TC) ;IS IT A LITERAL?
TLNE TE,GNLIT
JRST ARGN1B ;YES
MOVE TE,1(TC) ;NO--IS IT A DATA-NAME?
TLNE TE,GNNOTD ;IS IT A TEMP?
JRST ARGN1B ;YES
LDB TD,[POINT 3,TE,20]
CAIN TD,TB.DAT##
JRST ARGN1B ;YES
TLNN TE,FLOBIT## ;NO--BETTER BE PROCEDURE-NAME
CAIN TE,TB.PRO##
JRST ARGEN9 ;IT MUST BE
JRST ARGN9B ;IT ISN'T
ARGN1B: MOVEI LN,EBASEA##
PUSHJ PP,SETOPN##
TSWF FERROR;
JRST ARGN9C
HRRZ TE,EMODEA##
CAIN TE,LTMODE##
JRST ARGEN4
CAIN TE,FCMODE##
JRST ARGEN8
MOVE TA,CUREOP ;[432] GET DATAB LINK
HRRZ TA,1(TA) ;[432]
CAIL TA,<CD.DAT>B20 ;[432]BE SURE IT IS DATAB LINK
CAILE TA,<CD.DAT>B20+77777 ;[432]
JRST ARGN12 ;[432] NOT DATAB LINK
PUSHJ PP,LNKSET ;[432] GET EXTERNAL SIZE
LDB TB,DA.EDT## ;EDITED?
JUMPE TB,ARGN12 ;NO, SKIP THIS
LDB TB,DA.EXS## ;[432] TO PASS TO SUBROUTINE
MOVEM TB,ESIZEA ;[432] SO SUB KNOWS REAL SIZE
MOVE TA,CUREOP
MOVSI TB,GNFCS ;GET FLAG WHICH WILL MEAN "EDITED"
IORM TB,(TA) ;SET IN OPERAND WORD (SEE "SARG+FEW")
ARGN12: MOVSM TC,OPERND##
PUSHJ PP,SUBSCA##
HLRZ TC,OPERND
MOVE TE,EMODEA
ARGN1A: MOVE CH,ARGLST(TE) ;GET ARGUMENT TYPE
CAILE TE, DSMODE## ;IF IT'S NOT DISPLAY
CAIN TE, C3MODE## ; OR COMP-3
TRNA
JRST ARGEN2 ; GO ON.
MOVE TE,1(TC) ;IS IT A TEMP?
TLNE TE,GNNOTD
JRST ARGN2A ;YES--SUBSCRIPTED
;ARGUMENT IS DISPLAY ITEM
ARGN1C: MOVE TA,[XWD BYTLIT##,2]
PUSHJ PP,STASHI
PUSHJ PP,MBYTEA##
PUSHJ PP,ARSUB2 ;ZERO OUT SUBSCRIPTS
PUSH PP,CH ;SAVE ARG TYPE FOR LATER
HRRZ CH,ELITPC ;SAVE LIT PTR FOR ASY OUTPUT
IORI CH,AS.LIT
PUSH PP,CH
AOS ELITPC##
;SET UP THE SECOND WORD FOR ARG TYPE 15.
MOVE TA, [XWD OCTLIT##,1] ;WRITE IT OUT IN OCATAL.
PUSHJ PP, STASHI
SETZI TA, ;BUILD IT IN TA.
MOVE TE, EMODEA## ;SET UP THE MODE FIELD.
CAIN TE, C3MODE##
MOVEI TE, C3ARG-1
ADDI TE, 1
DPB TE, ARGMOD
MOVE TE, CUREOP## ;GET THE GENFIL FLAGS.
MOVE TE, (TE)
TLNN TE, GNLIT ;[432]TEST FOR LITERAL
JRST ARGN1D ;[432] NOT LITERAL
TLO TA, ARGLIT ; SET THE LITERAL
TLNE TE, GNALL ; AND ALL FLAGS.
TLO TA, ARGALL
JRST ARGN1E ;[432] JUMP AROUND NUM SWITCH
ARGN1D: TLNE TE,GNOPNM ;[432] FOR NUMERIC EDITED SET
SWON FANUM ;[432] SWITCH ON TO PASS
TSWT FANUM;
ARGN1E: JRST ARGN1K ;[432]IF IT'S NOT NUMERIC, GO ON
TLO TA, ARGNUM
TLNE TE, GNFCS ;(SEE SARG+FEW) IF NUMERIC EDITED,
TLO TA, ARGEDT ;SET "EDITED" BIT
; NUMERIC ARG.
TSWF FASIGN; ;TRANSFER THE SIGN FLAG.
TLO TA, ARGSGN
MOVE TE, EDPLA## ;DECIMAL PLACES?
JUMPGE TE, ARGN1G ;IF IT'S POSITIVE, THEY ARE REAL
; GO ON.
MOVMS TE ;IT'S NEGATIVE - IT'S ACTUALLY
; THE SCALE FACTOR.
TLO TA, ARGSCL ;NOTE IT.
ARGN1G: DPB TE, ARGNDP ;STASH THE SCALE FACTOR (OR
; OR DECIMAL PLACES.)
MOVE TE, ESIZEA## ;GET THE SIZE.
DPB TE, ARGNSZ ;STASH IT.
JRST ARGN1P ;GO STASH THE WORD.
; NON-NUMERIC ARG.
ARGN1K: MOVE TE, ESIZEA## ;GET THE SIZE.
DPB TE, ARGDSZ ;STASH IT.
ARGN1P: PUSHJ PP, STASHL## ;STASH THE LITERAL.
AOS ELITPC## ;BUMP THE PC.
MOVE TC,CUREOP ;SET UP ASY FILE OUTPUT
MOVE CH,-1(PP) ;GET BACK ARG TYPE
HRRI CH,AS.MSC
TLO CH,ASINC
MOVEM CH,(TC)
POP PP,CH ;GET LIT PTR
MOVEM CH,1(TC)
POP PP,CH ;SCRATCH ARG TYPE FROM PDL
POPJ PP, ;RETURN
ARGLIT==(1B5)
ARGALL==(1B6)
ARGNUM==(1B7)
ARGSGN==(1B8)
ARGSCL==(1B9)
ARGEDT==(1B10)
C3ARG==4
ARGMOD: POINT 4,TA,4
ARGNDP: POINT 5,TA,30
ARGNSZ: POINT 5,TA,35
ARGDSZ: POINT 24,TA,35
CHGMOD: POINT 4,CH,4 ;[411] MODE TYPE
CHGNDP: POINT 5,CH,30 ; [411] NUMBER OF DECIMAL PLACES
CHGNSZ: POINT 5,CH,35 ; [411] SIZE FOR NUMERIC ITEMS
CHGDSZ: POINT 24,CH,35 ; [411] SIZE FOR NON-NUMERIC ITEMS
;ARG IS NUMERIC DATA ITEM
;SIMULATE PUT.A## BUT PUT VALUES
; IN EOPTAB INSTEAD OF ON ASY FILE
ARGEN2: MOVE TC,CUREOP ;GET PTR TO OPERAND
HRRZ TB,(TC) ;NON-LITERAL SUBSCRIPT OR IN LINKAGE SECTION?
ANDI TB,700000
CAIN TB,AS.PAR
TLO CH,20 ;YES, SET INDIRECT BIT FOR ARG PTR
ARGN2A: MOVE TC,CUREOP
TSWF FASUB ;IS IT SUBSCRIPTED?
JRST PUT.A2 ;YES
PUT.A1: HRR CH,EBASEA
SKIPE EINCRA
JRST PUT.A3
PUSHJ PP,ARSUB2 ;ZERO SUBSCRIPTS
MOVEM CH,(TC)
SETZM 1(TC)
POPJ PP, ;RETURN
PUT.A3: TLO CH,ASINC
PUSHJ PP,ARSUB2 ;ZERO SUBSCRIPTS
MOVEM CH,(TC)
HRRZ CH,EINCRA
MOVEM CH,1(TC)
POPJ PP, ;RETURN
PUT.A2: LDB TE,[POINT 3,EBASEA,20]
CAIE TE,TB.DAT
JRST PUT.A1
TLO CH,SXR
HRR CH,EINCRA
PUSHJ PP,ARSUB2 ;ZERO SUBSCRIPTS
MOVEM CH,(TC)
SETZM 1(TC)
POPJ PP, ;RETURN
;OPERAND IS A LITERAL
ARGEN4: TSWT FANUM ;IS IT NUMERIC?
JRST ARGEN7 ;NO
PUSHJ PP,CONVNL## ;YES--CONVERT IT TO BINARY
JUMPN TD,ARGEN5 ;2-WORD COMP?
MOVE CH,[AS.D1##,,1] ;NO--1 WORD
PUSHJ PP,PUTAS1
TSWT FLNEG ;NEGATIVE?
SKIPA CH,TC ;NO
MOVN CH,TC ;YES
PUSHJ PP,PUTAS1
MOVSI CH,ARG.##
PUSHJ PP,ARSUB1 ;SET UP ASY OUTPUT
AOS EAS1PC
POPJ PP, ;RETURN
ARGEN5: TSWF FLNEG ;NEGATIVE?
PUSHJ PP,NEGATL## ;YES--NEGATE IT
MOVE CH,[AS.D2##,,2]
PUSHJ PP,PUTAS1
MOVE CH,TD
PUSHJ PP,PUTAS1
MOVE CH,TC
PUSHJ PP,PUTAS1
MOVSI CH,ARG.+11B30
PUSHJ PP,ARSUB1 ;SET UP ASY OUTPUT
MOVEI TA,2
ADDM TA,EAS1PC
POPJ PP, ;RETURN
;ARGUMENT IS A NON-NUMERIC LITERAL
ARGEN7: MOVSI TA,ASCLIT##
PUSHJ PP,STASHI
HRRZM TE,CURLIT##
MOVE TA,CUREOP
MOVE TA,1(TA)
PUSHJ PP,LNKSET
HRLI TA,350700
LDB TD,TA
MOVEI TC,D7MODE##
MOVEM TC,EMODEB##
MOVEM TA,EBYTEA##
SETZM IMCONS## ;INCASE STILL SET
PUSHJ PP,VALLIT##
PUSHJ PP,STASHL
SUB TE,CURLIT
HRRZS CH,TE
ADDM TE,@CURLIT
EXCH CH,ELITPC
ADDM CH,ELITPC
IORI CH,AS.LIT##
MOVEM CH,EINCRA##
MOVE TE,[XWD ^D36,AS.MSC##]
MOVEM TE,EBASEA
MOVEI TE,D7MODE
MOVEM TE,EMODEA
MOVE CH,ARGLST+1
JRST ARGN1C
;ARGUMENT IS A FIGURATIVE CONSTANT
ARGEN8: HRRZ TE,EFLAGA## ;GET FIG. CONST. TYPE
CAIN TE,0 ;TODAY?
JRST ARGN8F ;YES
CAILE TE,5 ;IF NOT IN RANGE,
MOVEI TE,1 ; USE SPACES
PUSHJ PP,@FCLIST-1(TE) ; OTHERWISE DISPATCH
MOVE CH,ARGLST
MOVE TC,CUREOP
MOVEM CH,(TC)
JRST ARGN8G
FCLIST: EXP ARGN8H ;SPACES
EXP ARGN8D ;ZEROES
EXP ARGN8E ;QUOTES
EXP ARGN8B ;HIGH-VALUES
EXP ARGN8A ;LOW-VALUES
;SUBROUTINE TO SET UP ASY FILE OUTPUT IN THE STYLE OF PUT.LD
ARSUB1: MOVE TC,CUREOP ;GET PTR TO CURRENT OPERAND
HRRI CH,AS.MSC ;SIMULATE PUT.LD##,
TLO CH,ASINC ; BUT PUT ITEMS IN EOPTAB
MOVEM CH,(TC) ; INSTEAD OF IN ASY FILE
HRRZ CH,EAS1PC
IORI CH,AS.PAR
MOVEM CH,1(TC)
POPJ PP,
;SUBROUTINE TO ZERO OUT SUBSCRIPTS IN EOPTAB ENTRY
ARSUB2: MOVE TC,CUREOP ;PTR TO CURRENT OPERAND
MOVE TE,2(TC) ;WORD AFTER ENTRY A ZEROED SUBSCRIPT?
JUMPE TE,CPOPJ ;YES
LDB TE,[POINT 1,(TC),9] ;OPERAND IN LINKAGE SECTION?
JUMPN TE,CPOPJ ;YES
LDB TE,[POINT 6,1(TC),17] ;GET # OF SUBSCRIPTS
LSH TE,1
ADDI TC,(TE) ;AIM PTR AT LAST SUBSCRIPT
ARS2A: CAMN TC,CUREOP ;ALL SUBSCRIPTS WIPED OUT?
POPJ PP, ;YES
SETZM (TC) ;NO, ZERO IT
SUBI TC,2 ;BACK UP ONE ENTRY
JRST ARS2A
;ARGUMENT IS "TODAY"
ARGN8F: MOVE CH,ARGLST
MOVE TC,CUREOP
MOVEM CH,(TC)
HRRZ TB,1(TC) ;GET TEMP ADDRESS
MOVEI TD,^D12 ;SIZE OF 'TODAY'
MOVEI TC,440600
JRST ARGN8C
;ARGUMENT IS 'LOW-VALUES'
ARGN8A: TDCA TB,TB
;ARGUMENT IS 'HIGH-VALUES'
ARGN8B: HRROI TB,-2
MOVE TA,[XWD OCTLIT##,1]
PUSHJ PP,STASHI
MOVE TA,TB
PUSHJ PP,STASHL
HRRZ TB,ELITPC
IORI TB,AS.LIT
AOS ELITPC
POPJ PP,
;ARGUMENT IS A FIGURATIVE CONSTANT (CONT'D)
;ARGUMENT IS 'ZEROES'
ARGN8D: PUSHJ PP,AZRJ.##
HRRZ TB,EAZRJ##
POPJ PP,
;ARGUMENT IS 'QUOTES'
ARGN8E: PUSHJ PP,AQRJ.##
HRRZ TB,EAQRJ##
POPJ PP,
;ARGUMENT IS 'SPACES'
ARGN8H: PUSHJ PP,ASRJ.##
HRRZ TB,EASRJ##
POPJ PP,
;COMMON EXIT FOR FIG CONSTANT ROUTINES
ARGN8G: MOVE TD,[EXP 11B6+1] ;[1513] DISPLAY-7 + FIG. CONST.,,SIZE
MOVEI TC,440700
ARGN8C: MOVE TA,[XWD BYTLIT,2]
PUSHJ PP,STASHI
HRRZI TA,AS.MSC
PUSHJ PP,STASHL
HRLZ TA,TC
HRR TA,TB
PUSHJ PP,STASHL
HRRZ CH,ELITPC
IORI CH,AS.LIT
AOS ELITPC
MOVE TC,CUREOP
MOVEM CH,1(TC)
MOVE TA,[XWD XWDLIT##,2]
PUSHJ PP,STASHI
MOVE TA,TD
HRRI TA,AS.CNB##
PUSHJ PP,STASHL
MOVS TA,TD
HRRI TA,AS.CNB##
PUSHJ PP,STASHL
AOS ELITPC
POPJ PP, ;RETURN
;ARGUMENT IS A PROCEDURE NAME
ARGEN9: TLNN TE,FLOBIT
JRST ARGN9A
ANDI TE,77777
ADD TE,FLOLOC##
HRRZ TE,0(TE)
LDB TD,[POINT 3,TE,20]
CAIE TD,TB.PRO
JRST ARGN9B
ARGN9A: ANDI TE,77777
MOVEI CH,AS.PRO##(TE)
HRLI CH,ARG.+17B30
MOVE TC,CUREOP ;GET PTR TO CURRENT OPERAND
MOVEM CH,(TC)
SETZM 1(TC)
POPJ PP, ;RETURN
ARGN9B: MOVEI DW,E.317
PUSHJ PP,OPNFAT##
ARGN9C: MOVE TC,CUREOP ;GET PTR TO CURRENT OPERAND
SETZM (TC) ;SIGNAL NOTHING TO OUTPUT TO ASY FILE
SOS ARGCTR ;DON'T COUNT THIS ARG
POPJ PP, ;RETURN
;SET UP SUBSCRIPTS FOR ARGS THAT REQUIRE THEM
; ALSO SET UP TODAY IF IT IS USED AS AN ARG
SARG: MOVSM TC,OPERND
LDB TE,[POINT 3,1(TC),20] ;IS IT DATA-NAME?
CAIE TE,TB.DAT
JRST SARG3 ;NO
MOVEI LN,EBASEA ;YES--SET UP PARAMETERS
PUSHJ PP,SETOPN
TSWF FERROR ;IF ERROR,
JRST SARG4 ; FORGET IT
PUSHJ PP,SUBSCA ;SEE IF IT IS
HLRZ TC,OPERND ; GET OPERAND ADR OF ARG [254]
HLLZS 0,(TC) ; TURN OFF THE SOURCE LINE # [254]
TSWT FASUB ; SUBSCRIPTED
JRST SARG4 ;NO--FORGET THIS ONE
;[565] IF NUMERIC EDITED, SET UP EXTERNAL SIZE IN ESIZEA
MOVE TA,ETABLA## ;[565] GET EXTERNAL SIZE
PUSHJ PP,LNKSET ;[565] FOR THIS DATANAME
LDB TE,DA.EDT## ;EDITED?
JUMPE TE,SARG2 ;NO, SKIP THE HACK
LDB TE,DA.EXS ;[565]
MOVEM TE,ESIZEA ;[565] SAVE IN ESIZEA
;;**** BEWARE -- THE FOLLOWING IS A HACK ! ****
;THE FLAG "GNFCS",WHICH USUALLY MEANS "FIG. CONST- SPACES" WILL
; BE SET TO INDICATE THAT THE ARGUMENT IS NUMERIC EDITED. THIS IS
; OK FOR THE DURATION OF THE "CALL" STATEMENT CODE GENERATION BECAUSE
; THE "GNLIT" FLAG (= LITERAL OR FIG. CONST) IS ALWAYS TESTED FIRST, SO
; THE FAKE "GNFCS" AND REAL "GNFCS" CASES WILL BE HANDLED IN DIFFERENT CODE.
MOVSI TE,GNFCS ;GET A FLAG TO INDICATE "NUMERIC EDITED"
IORM TE,(TC) ; ARGUMENT
SARG2: MOVE EACC,EAS1PC## ;GET %PARAM ADDRESS
IORI EACC,AS.PAR##
AOS EAS1PC
HLRZ TC,OPERND
HRRM EACC,0(TC)
MOVE CH,MOVSAC##
PUSHJ PP,PUTASY
HRRZ CH,EACC
PUSHJ PP,PUTASN
MOVE CH,[XWD AS.OCT##,1]
PUSHJ PP,PUTAS1##
MOVEI CH,0
PUSHJ PP,PUTAS1
HRRZ TE,EMODEA
CAIE TE,C3MODE ;[411] IF COMP-3
CAIG TE,DSMODE
PUSHJ PP,SARG5
MOVSI TD,GNNOTD
MOVE TE,ESIZEA
DPB TE,ACSIZE##
MOVE TE,EMODEA
DPB TE,ACMODE##
HRR TD,EDPLA
LDB TE,[POINT 6,1(TC),17]
MOVEM TD,1(TC)
SARG2A: MOVEI TC,2(TC)
SOJL TE,CPOPJ
SETZM 0(TC)
JRST SARG2A
;OPERAND IS NOT A DATA NAME
SARG3:
IFN ANS68,<
MOVE TE,0(TC) ;GET FIRST WORD OF OPERAND
TLNE TE,GNLIT ;IS IT EITHER A LITERAL OR FIG. CONST.?
TLNN TE,GNFIGC ;YES--FIG. CONST.?
JRST SARG4 ;NO
TLNN TE,GNTODY ;IS IT "TODAY"?
JRST SARG4 ;NO
MOVEI TE,2 ;YES--RESERVE
PUSHJ PP,GETEMP## ; 2 TEMP WORDS
HRRM EACC,1(TC) ;SAVE THE TEMP ADDRESS
MOVEI CH,TODAY.## ;GENERATE <PUSHJ 17,TODAY.>
PUSHJ PP,PUT.PJ
IFN BIS,<
PUSHJ PP,PUTASA
MOVE CH,[DMOVM.##,,AS.MSC]
>
IFE BIS,<
MOVE CH,[XWD MOVEM.,AS.MSC] ;GENERATE <MOVEM 0,%TEMP>
>
PUSHJ PP,PUTASY
HRRZ CH,EACC
PUSHJ PP,PUTASN
IFE BIS,<
MOVE CH,[XWD MOVEM.+AC1,AS.MSC] ;GENERATE <MOVEM 1,%TEMP+1>
PUSHJ PP,PUTASY
MOVEI CH,1(EACC)
PUSHJ PP,PUTASN
>
>
;GO TO NEXT OPERAND
SARG4: PUSH PP,CUREOP ;SAVE CUREOP (TO MAKE THIS END LIKE SARG2A)
PUSHJ PP,BMPEOP##
JFCL ;IGNORE SKIP RETURNS
MOVE TC,CUREOP ;SET TC TO NEW ARG
POP PP,CUREOP ;RESET CUREOP TO ARG JUST DONE
POPJ PP,
;WRITE OUT PARAMETER WORD FOR SUBSCRIPTED DISPLAY ITEM
SARG5: AOS EAS1PC
MOVE CH, [XWD AS.OCT##,1] ; [411] WRITE IT OUT IN OCTAL.
PUSHJ PP,PUTAS1 ; [411] PUT INTO ASSEMBLY FILE
SETZI CH, ; [411] BUILD IT IN TA.
MOVE TE, EMODEA## ; [411] SET UP THE MODE FIELD.
CAIN TE, C3MODE## ; [411] COMP3?
MOVEI TE, C3ARG-1 ; [411] YES SET IT UP
ADDI TE, 1 ; [411] SET FOR ARGUMENT
DPB TE, CHGMOD ; [411] PUT INTO PARM WORD
;[565] IF NUMERIC EDITED, SET NUMERIC BIT
MOVE TE, 0(TC) ;[565] GET FLAG BITS FOR OPERAND
TLNE TE, GNOPNM ;[565] IF NUMERIC EDITED,
SWON FANUM ;[565] SET NUMERIC BIT
TSWT FANUM ; [411] NUMERIC?
JRST SARG5B ; [411] NOT NUMERIC GO ON
; TLO TA, ARGNUM ; [411] SET NUMERIC IN PARAM WORD
TLO CH, ARGNUM ;[475] SET NUMERIC IN PARAM WORD
; NUMERIC ARG.
TLNE TE, GNFCS ;(SEE HACK IN SARG) IF NUMERIC EDITED,
TLO CH, ARGEDT ;SET EDITED BIT IN PARAM WORD
TSWF FASIGN ; [411] TRANSFER THE SIGN FLAG.
; TLO TA, ARGSGN ; [411] SET SIGN BIT IN PARAM WORD
TLO CH, ARGSGN ;[475] DECIMAL PLACES?
MOVE TE, EDPLA## ; [411] DECIMAL PLACES?
JUMPGE TE, SARG5A ; [411] IF IT'S POSITIVE, THEY ARE REAL
MOVMS TE ; [411] IT'S NEGATIVE - IT'S ACTUALLY
; [411] THE SCALE FACTOR.
; TLO TA, ARGSCL ; [411] NOTE IT.
TLO CH, ARGSCL ;[475] STASH THE SCALE FACTOR (OR
SARG5A: DPB TE, CHGNDP ; [411] STASH THE SCALE FACTOR (OR
; [411] OR DECIMAL PLACES.)
MOVE TE, ESIZEA## ; [411] GET THE SIZE.
DPB TE, CHGNSZ ; [411] STASH IT.
JRST PUTAS1 ; [411] GO STASH THE WORD.
; NON-NUMERIC ARG.
SARG5B: MOVE TE, ESIZEA## ; [411] GET THE SIZE.
DPB TE, CHGDSZ ; [411] STASH IT.
JRST PUTAS1 ; [411] GO STASH THE WORD.
;TABLE OF ARGUMENT TYPES FOR "USING"
ARGLST: XWD ARG.+10B30+ASINC,AS.MSC ;SIXBIT
XWD ARG.+10B30+ASINC,AS.MSC ;ASCII
XWD ARG.+10B30+ASINC,AS.MSC ;EBCDIC
XWD ARG.,0 ;1-WORD COMP
XWD ARG.+11B30,0 ;2-WORD COMP
XWD ARG.+2B30,0 ;FL.PT.
XWD ARG.+10B30+ASINC,AS.MSC ;COMP-3
;MISCELLANEOUS CONSTANTS
AC16==16B30
AC17==17B30
ASINC==1B19
ARGOP.==46 ;OPERATOR CODE FOR "ARG"
AC1==1B30
MACRO==1B9 ;MACRO FLAF
F40==1B10 ;FORTRAN-IV FLAG
USINGF==1B11 ;USING FLAG FOR CALL AND ENTER
CALLF==1B12 ;CALL FLAG
F10==1B13 ;FORTRAN FLAG (NEW FORTRAN)
PDENTF==1B9 ;PROC DIV ENTRY POINT FLAG
GOBAKF==1B9 ;GOBACK
EXPGMF==1B10 ;EXIT PROGRAM
SUBTTL GENERATE "CALL"
IFN ANS74,<
ENTRGN:
>
CALLGN: SWOFF FEOFF1 ;CLR FLAGS
SETZM ARGCTR## ;CLR ARG CTR
TLNN W1,(USINGF) ;THIS CALL HAVE ARGS?
JRST CALL1 ;NO
MOVEM W1,OPLINE## ;SAVE SRC POSITION AND FLAGS OF CALL
PUSHJ PP,READEM## ;GET USING OPERATOR
MOVEM EACA,EOPNXT
EXCH W1,OPLINE ;STASH USING & GET BACK CALL
MOVEM EACA,EOPNXT
HRRZ TC,EOPLOC
ADDI TC,3
CAIL TC,(EACA)
POPJ PP, ;[1002] ARG MISSING, GIVE UP, DIAGNOSTIC PUT OUT BY DTREE
CALL2: MOVEM TC,CUREOP
TLNN W1,(CALLF) ;CALL OR ENTER?
JRST CALL8 ;ENTER, NO SPECIAL CHECK ON ARGS
HRRZ TA,1(TC) ;GET PTR TO OPERAND
LDB TB,[POINT 3,TA,20] ;DATAB ITEM?
CAIE TB,CD.DAT
JRST CALL8 ;NO, LET LITERALS PASS
PUSHJ PP,LNKSET
LDB TB,DA.RES## ;IS ITEM LEFT JUSTIFIED IN A WORD?
CAIN TB,44
JRST CALL8 ;YES, IT IS GOOD
MOVEI DW,E.396 ;NO, ?MUST BE WORD ALIGNED
PUSHJ PP,OPNFAT
CALL8: MOVE TC,CUREOP ;GET BACK OPERAND PTR
PUSHJ PP,SARG ;SET UP SUBSCRIPTS FOR CURRENT ARG
MOVE TC,CUREOP
PUSHJ PP,ARG ;SET ARG LIST FOR LATER OUTPUT
CALL3: MOVEI TC,2 ;BUMP UP TO NEXT EOPTAB ENTRY
ADDB TC,CUREOP
MOVE EACA,EOPNXT ;END OF LIST?
CAIL TC,(EACA)
JRST CALL1 ;YES
SKIPE (TC) ;NO, THIS A WIPED OUT SUBSCRIPT?
JRST CALL2 ;NO, PROCESS IT
JRST CALL3 ;YES, TRY NEXT ENTRY
CALL1: HRRZ TA,EOPLOC ;AIM AT SUBPROG NAME
MOVEI TB,1(TA) ;RESET CUREOP
MOVEM TB,CUREOP
MOVE TA,2(TA) ;GET EXTAB LINK
IFN ANS74,<
LDB TB,[POINT 3,TA,20]
CAIN TB,CD.DAT ;SEE IF JUST DATAB LINK
JRST CALL9 ;YES IT IS
>
PUSHJ PP,LNKSET
LDB TB,EX.ENT## ;ENTRY?
MOVEI DW,E.398
JUMPN TB,OPNFAT ;IF SO, ?ILLEGAL CALL
MOVE TA,[OCTLIT,,1] ;PUT NEGATIVE ARG CNT IN LITERALS
PUSHJ PP,STASHI ; IN LEFT HALF OF -1(16)
MOVN TA,ARGCTR
HRLZI TA,(TA)
PUSHJ PP,STASHL
AOS ELITPC
MOVE CH,[MOVEI.##+ASINC+AC16,,AS.MSC] ;PUT OUT "MOVEI 16,%LIT00+N"
PUSHJ PP,PUTASY
HRRZ CH,ELITPC
IORI CH,AS.LIT
PUSHJ PP,PUTASN
HRRZ TA,EOPLOC## ;GET CALL OPERAND'S LINK
MOVE CH,2(TA) ;PUT OUT "PUSHJ 17,ENTRY-ADDR"
ANDI CH,77777
IORI CH,AS.EXT##
TLO CH,PUSHJ.##+AC17
PUSHJ PP,PUTASY
CALL1A: TSWT FAS3 ;ARE WE IN NON-RESIDENT SEGMENT?
JRST CALL7 ;NO--GO TO "USING"
MOVE TA,2(TA) ;YES--GET OPERAND LINK
PUSHJ PP,LNKSET ;GET EXTAB ADDRESS
SETO TE, ;SET "REFERENCED IN NON-RES"
DPB TE,EX.NRS##
CALL7: TLNE W1,(USINGF) ;IF THERE WERE NO ARGS OR THERE
TSWF FFATAL ; WAS A FATAL ERROR, DON'T WRITE
JRST CALL6 ; THE ARG LIST OUT.
;PUT ARG LIST FOR CALL IN LITERALS
HRRZ TC,EOPLOC ;RESET CUREOP TO TOP OF LIST
ADDI TC,3
CALL4: MOVEM TC,CUREOP
SKIPN CH,(TC) ;OUTPUT ARG LIST TO LITFIL
JRST CALL5
MOVE TA,[XWDLIT##,,2]
PUSHJ PP,STASHI
HLRZ TA,CH
ANDI TA,740 ;GET AC FIELD ONLY
CAIN TA,2B30 ;CONVERT TO NEW ARG TYPE CODES
MOVEI TA,4B30
CAIN TA,0B30
MOVEI TA,2B30
CAIN TA,10B30
MOVEI TA,15B30
CAIN TA,17B30
MOVEI TA,7B30
TLNE CH,20 ;INDIRECT BIT ON?
TRO TA,20 ;YES, SET IN TA TOO
PUSHJ PP,STASHL
HRRZ TA,(TC)
HRL TA,1(TC)
PUSHJ PP,STASHL
AOS ELITPC
CALL5: ADDI TC,2 ;ON TO NEXT ARG
MOVE EACA,EOPNXT ;END OF LIST?
CAIGE TC,(EACA)
JRST CALL4 ;NO
POPJ PP, ;YES
;NO ARGS
CALL6: MOVE TA,[OCTLIT,,1] ;0 TO 1ST ITEM OF ARGLIST
PUSHJ PP,STASHI
MOVEI TA,0
PUSHJ PP,STASHL
AOS ELITPC
POPJ PP,
;HERE FOR ANS-74 CALL WITH SUBROUTINE UNKNOWN AT COMPILE TIME
IFN ANS74,<
CALL9: PUSHJ PP,LNKSET
MOVE TC,CUREOP ;POINT TO IT
PUSHJ PP,SETOPA## ;GET ARG
MOVE TE,[EBASEA,,EBASEB]
BLT TE,EBASBX ;COPY
MOVEI TE,D6MODE## ;FORCE SIXBIT
MOVEM TE,EMODEB ;AS TARGET
MOVEI TE,6 ;6 OR LESS CHARS.
MOVEM TE,ESIZEB## ;LEFT JUSTIFIED
MOVEI TE,1 ;GET 1 WORD
PUSHJ PP,GETEMP## ; OF TEMP STORAGE
MOVEM EACC,EINCRB ;POINT "B" AT TEMP
MOVE TA,[^D36,,AS.MSC]
MOVEM TA,EBASEB
SWOFF FBSUB
PUSH PP,EINCRB ;[1041] SAVE SINCE MXX. MAY DESTROY IT
PUSHJ PP,MXX.## ;GO DO MOVE
POP PP,EINCRB ;[1041] RESTORE EINCRB
MOVE TA,[OCTLIT,,1] ;PUT NEGATIVE ARG CNT IN LITERALS
PUSHJ PP,STASHI ; IN LEFT HALF OF -1(16)
MOVN TA,ARGCTR
HRLZI TA,(TA)
PUSHJ PP,STASHL
AOS ELITPC
MOVE CH,[MOVEI.##+ASINC+AC16,,AS.MSC] ;PUT OUT "MOVEI 16,%LIT00+N"
PUSHJ PP,PUTASY
HRRZ CH,ELITPC
IORI CH,AS.LIT
PUSHJ PP,PUTASN
HRRZI CH,S.CALL##
HRLI CH,AC17+PUSHJ.
PUSHJ PP,PUTASY ;PUSHJ 17,S.CALL
MOVSI CH,ARG.##
PUSHJ PP,PUT.B ;ARG %TEMP+N
JRST CALL1A ;NOW FOR REST OF IT
>
SUBTTL GENERATE AN "ENTRY"
NTRYGN: MOVE CH, [XWD AS.SMC##,1] ;TELL PHASE G TO PUT
PUSHJ PP, PUTASN ; OUT A FORM FEED
MOVE CH, [XWD AS.PFF##,AS.MS1##] ; HERE.
PUSHJ PP, PUTASN
TLNN W1,(PDENTF) ;THIS THE PROCEDURE DIVISION ENTRY?
JRST NTRY1 ;NO, PUT OUT JRST OVER ENTRY CODE
MOVE CH,EAS1PC ;YES, GET A %PARAM LOC FOR CALL FLAG
AOS EAS1PC
IORI CH,AS.PAR
HRRZM CH,RETPTR##
PUSHJ PP,PUTOC0 ;OCTAL 0 TO AS1FIL
MOVE CH,EAS1PC ;AND A %PARAM LOC FOR THE CALLER'S ARG PTR
AOS EAS1PC
IORI CH,AS.PAR
HRRZM CH,ARGPTR##
PUSHJ PP,PUTOC0 ;OCTAL 0 TO AS1FIL
JRST NTRY2
NTRY1: PUSHJ PP,GETTAG## ;GET TAG FOR JUMP OVER ENTRY CODE
HRRZM CH,ENTAGS## ;SAVE
HRLI CH,JRST.## ;<JRST %TAG>
HRRZ TA,CH ;GET TAG NUMBER
PUSHJ PP,REFTAG## ;REFERENCE IT
PUSHJ PP,PUTASY
NTRY2:
;PUT OUT ENTRY POINT INFORMATION AREA.
;[74] LINK TO OTHER ENTRY POINTS IN EXTERNAL SUBROUTINES
; XWD PROGRAM'S-BASE-ADDRESS,MAIN-ENTRY-POINT
; SIXBIT "ENTRY-NAME"
;
; THIS LIST CAN BE EXPANDED IN THE NEGATIVE DIRECTION
; WITHOUT AFFECTING COMPATABILITY OF EARILER VERSIONS
IFN ANS74,<
MOVE CH,[AS.OCT,,1] ;ALLOCATE SPACE FOR LINK WORD
PUSHJ PP,PUTASN
SETZ CH, ;JUST PUT OUT 0
PUSHJ PP,PUTASY
>
MOVE CH,[AS.XWD##,,1] ;PUT OUT XWD 0,MAIN-ENTRY
PUSHJ PP,PUTASN
MOVE CH, [XWD AS.BSA##,AS.MS1##] ;LEFT IS THE PROGRAM'S
; BASE ADDRESS.
PUSHJ PP,PUTASN
HRRZ TA,EOPLOC ;GET EXTAB LINK FOR ENTRY OPERAND
HRRZ CH,2(TA)
ANDI CH,77777 ;SUBSTITUTE AS.EXT FOR CD.EXT
IORI CH,AS.EXT
PUSH PP,CH ;SAVE CH FOR A FEW MINUTES
TLNN W1,(PDENTF) ;PROCEEDURE DIVISION ENTRY?
JRST .+3 ;NO
MOVEM CH,PRGEAD## ;YES - SAVE FOR LATER ENTRIES
TDZA CH,CH ;0 FOR MAIN ENTRY
MOVE CH,PRGEAD## ;GET MAIN ENTRY POINT
PUSHJ PP,PUTASY ;OUTPUT RIGHT HALF OF XWD
;NOW FOR THE NAME
MOVE CH,[AS.SIX,,1] ;IN SIXBIT
PUSHJ PP,PUTASN
HRRZ TA,EOPLOC ;GET POINTER TO HLDTAB ENTRY CONTAINING
HRRZ TA,2(TA) ;THE ENTRY NAME
PUSHJ PP,LNKSET
LDB TB,EX.HLD
HRRZ TA,HLDLOC##
ADDI TA,2(TB) ;START OF THE NAME - USE ONLY FIRST
MOVE CH,(TA) ;SIX CHARACTERS
PUSHJ PP,PUTAYY ;[1447]
POP PP,CH ;RESTORE CH
HRLI CH,AS.ENT## ;OUTPUT ENTRY, BUT DON'T BUMP PC
PUSHJ PP,PUTASN
TLNN W1,(PDENTF) ;PRO. DIV. ENTRY?
JRST NTRY6 ;NO
MOVE CH,EAS2PC## ;YES, SAVE PC
MOVEM CH,PRGENT##
NTRY6: PUSHJ PP,PUTASA## ;GEN FUNNY UNOPTIMIZABLE "SKIPA"
HRLZI CH,XSKPA.## ;OUTPUT "SKIPA" OVER THE ENTRY PARAMETER
PUSHJ PP,PUTASY
MOVE CH,[AS.XWD,,1] ;OUTPUT "XWD %SUBRLIST,FILES."
PUSHJ PP,PUTASN
HRLZ CH,SUBLST##
TLO CH,AS.LIT
HRRI CH,AS.MSC
PUSHJ PP,PUTASY
MOVE CH,[AS.FLS##,,AS.MSC]
PUSHJ PP,PUTASN
MOVE CH,[ASINC+SKIPE.##,,AS.MSC] ;OUTPUT "SKIPE %CALLFLAG"
PUSHJ PP,PUTASY
HRRZ CH,RETPTR
PUSHJ PP,PUTASN
MOVEI CH,ILLC%## ;RECURSIVE CALL CHECK
PUSHJ PP,PUT.PJ
MOVE CH,[ASINC+SETOM.##,,AS.MSC] ;"SETOM %CALLFLAG"
PUSHJ PP,PUTASY
HRRZ CH,RETPTR
PUSHJ PP,PUTASN
MOVE CH,[ASINC+AC16+MOVEM.##,,AS.MSC] ;"MOVEM 16,%ARGPTR"
PUSHJ PP,PUTASY
HRRZ CH,ARGPTR
PUSHJ PP,PUTASN
HRRZ TA,EOPLOC ;GET ENTRY ADDRESS
HRR CH,2(TA)
ANDI CH,77777
IORI CH,AS.EXT
TLO CH,MOVEI.##+AC16 ;
PUSHJ PP,PUTASY
MOVEI CH,PUTF%##
PUSHJ PP,PUT.PJ
SKIPE PRODSW## ;/P ON?
JRST NTRY4 ;YES, NO TRACE CODE
HRRZ TA,EOPLOC ;MAKE PTR TO HLDTAB ENTRY CONTAINING
HRRZ TA,2(TA) ; NAME OF ENTRY
PUSHJ PP,LNKSET
LDB TB,EX.HLD##
HRRZ TA,HLDLOC##
ADDI TA,(TB)
MOVEM TA,CURHLD##
MOVEI CH,C.TRCE##
PUSHJ PP,PUT.PJ
MOVE CH,[AS.XWD,,1]
PUSHJ PP,PUTASN
HRRZ TA,CURHLD ;LH = COUNT OF NAME WORDS
LDB CH,HL.QAL##
MOVEM CH,CURNAM## ;SAVE COUNTER
ADDI CH,1001 ;PLUS ENTRY FLAG AND COUNT OF XWD ARG
TLNE W1,(PDENTF) ;IS PROGRAM-ENTRY FLAG?
ADDI CH,1000 ;YES, MAKE PROGRAM-ENTRY FLAG
PUSHJ PP,PUTASN
MOVEI CH,0 ;RIGHT HALF = 0
PUSHJ PP,PUTASY
HRLZI CH,AS.SIX## ;PUT OUT SIXBIT NAME OF ENTRY
HRR CH,CURNAM
PUSHJ PP,PUTASN
AOS CURHLD ;AIM AT LAST BASIC HLDTAB WORD
MOVN TC,CURNAM ;MAKE CTR
HRLM TC,CURHLD
NTRY7: SKIPL TA,CURHLD ;GET CTR-PTR
JRST NTRY4 ;ALL DONE
AOBJP TA,.+1 ;BUMP CTR-PTR
MOVEM TA,CURHLD ;SAVE NEW COPY
MOVE CH,(TA) ;GET NAME WORD
PUSHJ PP,PUTAYY ;[1447] TO ASY FILE
JRST NTRY7
NTRY4: TLNN W1,(USINGF) ;ANY ARGS?
JRST NTRY5
;CODE TO PICK UP ARGS
MOVEM W1,OPLINE ;SAVE ENTRY OP
PUSHJ PP,READEM ;READ IN ARG LIST
MOVEM EACA,EOPNXT
EXCH W1,OPLINE
MOVE CH,[ASINC+ARGS.##,,AS.MSC] ;OUTPUT "ARGS. 0,%LIT"
PUSHJ PP,PUTASY
HRRZ CH,ELITPC
AOJ CH, ;AIM AT LIT LOC AFTER ARG COUNT WORD
IORI CH,AS.LIT
PUSHJ PP,PUTASN
PUSHJ PP,DUMARG ;SET UP ARG LIST PTRS
NTRY5: TLNE W1,(PDENTF) ;PROC DIV ENTRY POINT?
JRST NTRY8 ; [324] YES, JUMP AROUND DECLARITIVES IF ANY
HRRZ CH,ENTAGS ;OUTPUT "%TAG:"
JRST PUTTAG## ;AND RETURN
NTRY8:
IFN DBMS,<
;PUT OUT "MOVEI 16,INITDB-ARG-LIST-ADDR"
SKIPN INVSEE## ;[1414] WAS THERE A DBMS INVOKE?
JRST NTRY8A ;[1414] NO
MOVE CH,[MOVEI.+ASINC+AC16,,AS.MSC] ;[1414]
PUSHJ PP,PUTASY ;[1414]
HRRZ CH,DBUSES## ;[1414] ADDRESS OF DBMS USE PROCEDURE
IORI CH,AS.LIT ;[1414]
PUSHJ PP,PUTASN ;[1414]
;PUT OUT "PUSHJ 17,INITDB"
MOVEI CH,INITDB## ;[1414]
PUSHJ PP,PUT.PJ ;[1414]
NTRY8A:> ;[1414]
MOVE CH,PROGST## ;GET START ADDRESS
TLZN CH,-1 ;IN NON-RESIDENT SECTION?
JRST NTRY3 ;NO
PUSHJ PP,PUTTAG ;YES, THIS BECOMES START ADDRESS
MOVE CH,[OVLAY.##+ASINC,,AS.MSC]
PUSHJ PP,PUTASY
MOVE TA,[XWDLIT,,2]
PUSHJ PP,STASHI
HLRZ TA,PROGST ;GET NON-RES ADDRESS
PUSHJ PP,STASHL
TRC TA,600000 ;CHANGE 2 TO 4
PUSHJ PP,LNKSET ;GET PROTAB ADDRESS
LDB TA,PR.PRI## ;GET LEVEL
HRLZ TA,TA
HRRI TA,AS.CNB
PUSHJ PP,STASHL
AOS CH,ELITPC ;ACCOUNT FOR LITERAL
MOVEI CH,AS.LIT-1(CH) ;
HRRZS PROGST ;JUST INCASE
IFN ANS68,<
JRST PUTASN ;FINISH OFF
>
IFN ANS74,<
PUSHJ PP,PUTASN ;FINISH OFF
JRST NTRY9
>
NTRY3: SKIPN DECLR.## ;[324] DOES THIS SUBPROGRAM HAVE DECLARITIVES
IFN ANS74,<
SKIPE RELKEY## ;OR RELATIVE KEY CONVERSION REQUIRED?
CAIA ;YES TO AT LEAST ONE OF THEM
>
POPJ PP, ; [324] NO ALL DONE
HRRZ CH,PROGST## ; [324] YES NEED TO JUMP AROUND DECLARITVES
HRLI CH,JRST. ; [324] JRST TO START OF SUBPROGRAM BEYOND NON-DECLARIVES SECTION.
PUSHJ PP,PUTASY ;[324] PUT IN ASY FILE
HRRZ TA,PROGST ;GET TAG
IFN ANS68,<
JRST REFTAG## ;REFERENCE IT AND RETURN
>
IFN ANS74,<
PUSHJ PP,REFTAG## ;REFERENCE IT
NTRY9: SKIPN RELKEY ;NEED TO CONVERT?
POPJ PP, ;NO
;YES
;FALL THROUGH
MOVE CH,[XWD AS.SMC##,1] ;TELL PHASE G TO PUT
PUSHJ PP,PUTASN ; OUT A FORM FEED
MOVE CH,[XWD AS.PFF##,AS.MS1##] ; HERE.
PUSHJ PP,PUTASN
SWOFF FASUB+FBSUB ;JUST INCASE
SETZM RELKEY ;ONLY DO IT ONCE
;SCAN DATAB FOR NON-COMP DEPENDING ITEMS
MOVEI TA,1
JRST CKDT.T ;MAKE TEST
CKDT.0: LDB TB,DA.PWA ;PIC WORD ALLOCATED?
LDB TE,DA.SUB ;OR WORDS 8 & 9 ALLOCATED?
IOR TB,TE
JUMPE TB,CKDT.Z ;NO, SO NO DEPENDING ITEM
LDB TB,DA.DEP## ;DEPENDING ITEM?
JUMPE TB,CKDT.Z ;NO
LDB TB,DA.DCR## ;SEE IF NEEDED
JUMPE TB,CKDT.Z ;NO
PUSHJ PP,GETTAG## ;GET NEXT TAG
TRNN CH,077777 ;WE CANNOT USE 0
JRST .-2 ;SO GET NEXT TAG
TRNN CH,076000 ;[1346] IS TAG GREATER 1023?
JRST CKDT.1 ;[1346] NO
PUSH PP,CH ;[1346] YES, WON'T FIT IN DA.DCR
MOVEI DW,E.746 ;[1346]
LDB LN,TCLN## ;[1346] SET UP LN
LDB CP,TCCP## ;[1346] SET UP CP
PUSHJ PP,FATAL## ;[1346]
POP PP,CH ;[1346]
CKDT.1: ;[1346]
DPB CH,DA.DCR ;DEPENDING CONVERSION ROUTINE
PUSHJ PP,PUTTAG## ;OUTPUT TAG TO ASYFIL
; LDB TD,DA.DEP ;GET REAL DEPENDING ITEM
; SETZ TE, ;FAKE IT OUT
; MOVEI TC,TE ; SINCE WE DON'T HAVE REAL OPERAND
PUSH PP, W1 ;SAVE W1
PUSH PP, W2 ; AND W2.
PUSH PP, OPERND## ;SAVE OPERND TOO. (IN CASE IT'S
; IN THE LINKAGE SECTION.)
LDB W2, DA.DEP## ;GET THE DEPENDING ITEM.
MOVEI TA, (W2) ; AND POINT AT IT.
PUSHJ PP, LNKSET##
HRLZI W1, (1B0) ;SET THE OPERAND FLAG.
LDB TD, DA.SYL## ;SET THE SYNC FLAGS.
DPB TD, [POINT 1,W1,5]
LDB TD, DA.SYR##
DPB TD, [POINT 1,W1,6]
LDB TD, DA.CLA## ;SET THE NUMERIC FLAG.
CAIN TD, %CL.NU
TLO W1, (1B7)
LDB TD, DA.JST## ;SET THE JUSTIFIED FLAG.
DPB TD, [POINT 1,W1,8]
LDB TD, DA.LKS## ;SET THE LINKAGE SECTION FLAG.
DPB TD, [POINT 1,W1,9]
LDB TD, DA.USG## ;SET THE USAGE.
DPB TD, [POINT 4,W1,13]
PUSHJ PP, PUSH12## ;STASH THE INFO IN EOPTAB.
HRRZI TC, -1(EACA) ;POINT AT THE EOPTAB ENTRY.
MOVEM TC, CUREOP ;MAKE IT THE CURRENT ENTRY.
HRLZM TC, OPERND## ;MAKE IT THE CURRENT OPERAND TOO.
MOVEI LN,EBASEA ;[752] SET IT UP AS "A" OPERAND
PUSHJ PP,SETOPN## ;[752] CANNOT USE SETOPA INCASE OF ERROR
TSWF FERROR ;[752] IF ERROR?
JRST CKDT.E ;[752] GIVE UP
MOVEI TE,10 ;USE AC'S 10 OR 7 & 10
MOVEM TE,EAC##
IFN BIS,<
SETOM ESAFLG## ;DON'T MOVE FROM 10 TO 10
>
SETZM ECARRY##
PUSHJ PP,MXAC.## ;GET IT INTO ACCS
IFN BIS,<
SETZM ESAFLG
>
MOVE CH,[MOVMM.##+ASINC+,,AS.MSC]
MOVE TE,EAC
DPB TE,CHAC## ;INCASE BIS DP
PUSHJ PP,PUTASY## ;OUTPUT MOVMM 10,
MOVEI CH,AS.PAR## ;+ %PARAM+0
PUSHJ PP,PUTASN
MOVSI CH,POPJ.+AC17
PUSHJ PP,PUTASY ;END WITH POPJ 17,
CKDT.E: POP PP, OPERND## ;[752] RESTORE OPERND.
POP PP, W2 ;RESTORE W2
POP PP, W1 ; AND W1.
MOVE EACA, EOPNXT## ;RESET EOPTAB.
POP EACA, (EACA)
POP EACA, (EACA)
MOVE TA,CURDAT
ADD TA,DATLOC
CKDT.Z: LDB TB,DA.PWA## ;PIC WORD ALLOCATED?
JUMPE TB,[LDB TB,DA.SUB## ;NO, WORDS 8 & 9 ALLOCATED?
JUMPE TB,CKDT.Y ;NO
MOVEI TB,SZ.DOC ;YES
JRST .+2]
MOVEI TB,SZ.MSK+SZ.DOC ;YES, SPACE FOR BOTH ITEMS
LDB TE,DA.KEY## ;NO. OF WORDS FOR KEYS?
ADDI TB,(TE) ;ADD THEM IN
CKDT.Y: MOVE TA,CURDAT
ADDI TA,SZ.DAT(TB) ;TOTAL LENGTH
CKDT.T: MOVEM TA,CURDAT
ADD TA,DATLOC## ;GET CURRENT LOCATION
HRRZ TA,TA
HRRZ TB,DATNXT## ;END
CAMG TA,TB ;ALL DONE?
JRST CKDT.0 ;NO
;SCAN FILE TABLES FOR NON-COMP RELATIVE KEYS
MOVE CH,[XWD AS.SMC##,1] ;TELL PHASE G TO PUT
PUSHJ PP,PUTASN ; OUT A FORM FEED
MOVE CH,[XWD AS.PFF##,AS.MS1##] ; HERE.
PUSHJ PP,PUTASN
SWOFF FASUB+FBSUB ;JUST INCASE
SETZM RELKEY ;ONLY DO IT ONCE
MOVE TA,FILLOC## ;ARE THERE ANY FILE TABLES?
CAMN TA,FILNXT##
POPJ PP, ;NO, RETURN.
MOVEI TA,CD.FIL*1B20+1
CKFT.0: PUSHJ PP,LNKSET##
MOVEM TA,CURFIL## ;SAVE POINTER
LDB TB,FI.CKA## ;SEE IF NEEDED
JUMPE TB,CKFT.A ;NO
PUSHJ PP,GETTAG## ;GET NEXT TAG
DPB CH,FI.CKB## ;CONVERT BEFORE TAG
PUSHJ PP,PUTTAG## ;OUTPUT TAG TO ASYFIL
LDB TA,FI.CKB ;GET TAG
PUSHJ PP,REFTAG ;REFERENCE IT SO OPTIMIZER WILL LEAVE
MOVE TA,CURFIL
LDB TD,FI.CKA ;GET REAL KEY
SETZ TE, ;FAKE IT OUT
MOVEI TC,TE ; SINCE WE DON'T HAVE REAL OPERAND
MOVEI LN,EBASEA ;[752] SET IT UP AS "A" OPERAND
PUSHJ PP,SETOPN## ;[752] CANNOT USE SETOPA INCASE OF ERROR
TSWF FERROR ;[752] IF ERROR?
JRST CKFT.Z ;[752] GIVE UP
MOVE TE,[EBASEA,,EBASEB##]
BLT TE,EBASBX## ;COPY "A" TO "B"
SETZM EAC## ;USE AC'S 0 & 1
SETZM ECARRY##
IFN BIS,<
SETOM ESAFLG## ;DON'T MOVE FROM 10 TO 0
>
PUSHJ PP,MXAC.## ;GET IT INTO ACCS
IFN BIS,<
SETZM ESAFLG
>
MOVE CH,[MOVMM.##+ASINC,,AS.MSC]
MOVE TE,EAC
DPB TE,CHAC## ;INCASE BIS DP
PUSHJ PP,PUTASY## ;OUTPUT MOVMM 0,
MOVEI CH,AS.PAR## ;+ %PARAM+0
PUSHJ PP,PUTASN
MOVSI CH,POPJ.+AC17
PUSHJ PP,PUTASY ;END WITH POPJ 17,
PUSHJ PP,GETTAG ;GET AFTER TAG FOR SKIP RETURN
EXCH TA,CURFIL ;GET FILE BACK
DPB CH,FI.CKA ;STORE TAG
PUSH PP,CH ;SAVE TAG
PUSHJ PP,PUTTAG## ;OUTPUT TAG TO ASYFIL
EXCH TA,(PP) ;SAVE TA, GET TAG #
PUSHJ PP,REFTAG ;REFERENCE IT SO OPTIMIZER WILL LEAVE
POP PP,TA
EXCH TA,CURFIL ;GET "A" BACK
MOVSI CH,AOS.##+17 ;AOS (17)
PUSHJ PP,PUTASY
PUSHJ PP,GETTAG ;GET AFTER TAG FOR NON-SKIP RETURN
PUSH PP,CH ;SAVE TAG
PUSHJ PP,PUTTAG## ;OUTPUT TAG TO ASYFIL
EXCH TA,(PP) ;SAVE TA, GET TAG #
PUSHJ PP,REFTAG ;REFERENCE IT SO OPTIMIZER WILL LEAVE
POP PP,TA
IFE BIS,<
SETZM EAC ;RESULT IS IN AC 0
MOVE CH,[MOVM.##+ASINC,,AS.MSC]
>
IFN BIS,<
MOVEI CH,5
MOVEM CH,EAC ;RESULT IS IN AC 5
MOVE CH,[MOVM.##+AC5+ASINC,,AS.MSC]
>
PUSHJ PP,PUTASY ;GET KEY BACK
MOVEI CH,AS.PAR
PUSHJ PP,PUTASN
MOVEI TE,D1MODE## ;
MOVEM TE,EMODEA ;HOWEVER "A" IS 1-WORD COMP
MOVEI TE,^D10 ;MAX. SIZE OF 1 WORD
CAMGE TE,ESIZEA ;IS "B" LARGER THAN 1 WORD
MOVEM TE,ESIZEA ;YES, RESET IT
PUSHJ PP,MACX.## ;STORE BACK
MOVSI CH,POPJ.+AC17
PUSHJ PP,PUTASY ;POPJ 17,
MOVE TA,CURFIL
;CHECK FOR NON-LITERAL LINAGE COUNTER ITEMS
CKFT.A: LDB TD,FI.LCP## ;ANY LINAGE-COUNTER?
JUMPE TD,CKFT.Z ;NO
LDB CH,FI.LCI## ;YES, DO WE NEED TO CONVERT
JUMPE CH,CKFT.Z ;NO
PUSHJ PP,PUTTAG## ;OUTPUT TAG
LDB TD,FI.LCP ;GET LINAGE-COUNTER AGAIN
SETZ TE, ;FAKE IT OUT
MOVEI TC,TE ; SINCE WE DON'T HAVE REAL OPERAND
PUSHJ PP,SETOPB## ;SET IT UP AS "B" OPERAND
MOVEI TD,1
MOVEM TD,EINCRB## ;OFFSET FROM LINAGE-COUNTER
HRRZ TA,CURFIL
LDB TD,FI.LPP## ;GET LINES PER PAGE
TRNN TD,700000 ;LITERAL?
JRST CKFT.B ;YES
SETZ TE, ;FAKE IT OUT
MOVEI TC,TE ; SINCE WE DON'T HAVE REAL OPERAND
MOVEI LN,EBASEA ;[752] SET IT UP AS "A" OPERAND
PUSHJ PP,SETOPN## ;[752] CANNOT USE SETOPA INCASE OF ERROR
TSWF FERROR ;[752] IF ERROR?
JRST CKFT.Z ;[752] GIVE UP
SETZM EAC## ;USE AC'S 0 & 1
SETZM ECARRY##
PUSHJ PP,MXAC.## ;GET IT INTO ACCS
PUSHJ PP,PUTASA##
HRRZ TA,CURFIL
MOVSI CH,HRLM.##
PUSHJ PP,PUT.B##
CKFT.B: HRRZ TA,CURFIL
LDB TD,FI.WFA## ;GET WITH FOOTING AT LIMIT
TRNN TD,700000 ;LITERAL?
JRST CKFT.C ;YES
SETZ TE, ;FAKE IT OUT
MOVEI TC,TE ; SINCE WE DON'T HAVE REAL OPERAND
MOVEI LN,EBASEA ;[752] SET IT UP AS "A" OPERAND
PUSHJ PP,SETOPN## ;[752] CANNOT USE SETOPA INCASE OF ERROR
TSWF FERROR ;[752] IF ERROR?
JRST CKFT.Z ;[752] GIVE UP
SETZM EAC## ;USE AC'S 0 & 1
SETZM ECARRY##
PUSHJ PP,MXAC.## ;GET IT INTO ACCS
PUSHJ PP,PUTASA##
MOVSI CH,HRRM.##
PUSHJ PP,PUT.B##
CKFT.C: HRRZ TA,CURFIL
AOS EINCRB ;OFFSET IS NOW 2
LDB TD,FI.LAT## ;GET LINES AT TOP
TRNN TD,700000 ;LITERAL?
JRST CKFT.D ;YES
SETZ TE, ;FAKE IT OUT
MOVEI TC,TE ; SINCE WE DON'T HAVE REAL OPERAND
MOVEI LN,EBASEA ;[752] SET IT UP AS "A" OPERAND
PUSHJ PP,SETOPN## ;[752] CANNOT USE SETOPA INCASE OF ERROR
TSWF FERROR ;[752] IF ERROR?
JRST CKFT.Z ;[752] GIVE UP
SETZM EAC## ;USE AC'S 0 & 1
SETZM ECARRY##
PUSHJ PP,MXAC.## ;GET IT INTO ACCS
PUSHJ PP,PUTASA##
MOVSI CH,HRLM.##
PUSHJ PP,PUT.B##
CKFT.D: HRRZ TA,CURFIL
LDB TD,FI.LAB## ;GET LINES AT BOTTOM
TRNN TD,700000 ;LITERAL?
JRST CKFT.E ;YES
SETZ TE, ;FAKE IT OUT
MOVEI TC,TE ; SINCE WE DON'T HAVE REAL OPERAND
MOVEI LN,EBASEA ;[752] SET IT UP AS "A" OPERAND
PUSHJ PP,SETOPN## ;[752] CANNOT USE SETOPA INCASE OF ERROR
TSWF FERROR ;[752] IF ERROR?
JRST CKFT.Z ;[752] GIVE UP
SETZM EAC## ;USE AC'S 0 & 1
SETZM ECARRY##
PUSHJ PP,MXAC.## ;GET IT INTO ACCS
PUSHJ PP,PUTASA##
MOVSI CH,HRRM.##
PUSHJ PP,PUT.B##
;[D1306] CKFT.E: HRRZ TA,CURFIL
CKFT.E: ;[M1306]
MOVSI CH,POPJ.+AC17 ;YES
PUSHJ PP,PUTASY ;END WITH POPJ 17,
CKFT.Z: ;[M1306]
HRRZ TA,CURFIL ;[1306] RESTORE CURRENT FILE POINTER
LDB TA,FI.NXT## ;[M1306] ;GET NEXT
JUMPN TA,CKFT.0
POPJ PP,
>
;SET UP DUMMY ARG INDEX LOCS
DUMARG: HRRZ TC,EOPLOC ;MAKE PTR TO FIRST ARG
ADDI TC,3
MOVEM TC,CUREOP
;COUNT ARGS
MOVEI TB,1 ;INIT ARG COUNT,
MOVEM TB,ARGCTR ; PLUS 1 FOR CALLER'S ARG PTR LOC
HRRZ EACA,EOPNXT
DUM1: AOS ARGCTR ;BUMP CTR
LDB TB,[POINT 6,1(TC),17] ;SKIP OVER SUBSCRIPTS
IMULI TB,2 ; [330] EACH SUBSCRIPT TAKES TWO WORDS.
ADDI TC,2(TB)
CAIG TC,(EACA) ;END OF LIST?
JRST DUM1 ;NO
MOVE TA,[OCTLIT,,1] ;PUT ARG COUNT IN LIST
PUSHJ PP,STASHI
MOVN TA,ARGCTR
HRLZI TA,(TA)
PUSHJ PP,STASHL
AOS ELITPC
;PUT ADDRESSES OF DUMMY ARG INDEX LOCS IN LIST
HRRZ TA,ARGCTR ;SET UP XWD LIST IN LITTAB
LSH TA,1
HRLI TA,XWDLIT##
PUSHJ PP,STASHI
MOVEI TA,0 ;OUTPUT CALLER'S ARG PTR ADDR
PUSHJ PP,STASHL
HRLZ TA,ARGPTR
HRRI TA,AS.MSC
PUSHJ PP,STASHL
AOS ELITPC
SKIPA TC,CUREOP ;RESET ARG PTR
DUM2: MOVEM TC,CUREOP
HRRZ TA,1(TC) ;GET DATAB LINK
CAIL TA,<CD.DAT>B20 ;BE SURE IT IS A DATAB LINK
CAILE TA,<CD.DAT>B20+77777
JRST BADONE ;ERROR
PUSHJ PP,LNKSET ;GET ABS PTR
MOVEM TA,CURDAT##
LDB TB,DA.LKS## ;MAKE SURE IT IS IN LINKAGE SECTION
JUMPE TB,BADONE ;ERROR
LDB TB,DA.LVL ;MUST BE 01 OR 77 LEVEL
CAIE TB,77
CAIN TB,01
TDZA TA,TA ;PUT OUT LEFT HALF OF XWD
JRST BADONE ;?ILLEGAL DUMMY ARG
PUSHJ PP,STASHL
AOS ELITPC
MOVE TA,CURDAT ;GET BACK DATAB PTR
DUM5: LDB TB,DA.LVL## ;LEVEL 01 OR 77?
CAIE TB,01
CAIN TB,77
JRST DUM6 ;YES
LDB TA,DA.BRO## ;NO, GET FATHER/BROTHER LINK
PUSHJ PP,LNKSET
JRST DUM5 ;KEEP LOOKING FOR THE 01 ITEM
DUM6: LDB TB,DA.ARG## ;GET ASSIGNED INDEX LOC, IF ANY
JUMPN TB,DUM3 ;OK
MOVE TB,EAS1PC ;HAVE TO ASSIGN ONE
AOS EAS1PC
DPB TB,DA.ARG
PUSHJ PP,PUTOC0 ;OCTAL 0 TO AS1FIL
DUM3: PUSH PP,TB ;[***] SAVE INDEX LOC
DUM3A: LDB TA,DA.BRO ;[***] SEE IF IT HAS A BROTHER
JUMPE TA,DUM3B ;[***] NO, GIVE UP
PUSHJ PP,LNKSET ;[***] POINT TO IT
LDB TB,DA.RDF## ;[***] IS IT A REDEFINES
JUMPE TB,DUM3A ;[***] NO, TRY NEXT
MOVE TB,0(PP) ;[***] GET BACK INDEX LOC
DPB TB,DA.ARG ;[***] STORE SAME LOC FOR REDEFINED ITEM
JRST DUM3A ;[***] TRY NEXT
DUM3B: POP PP,TB ;[***] RESTORE INDEX LOC
IORI TB,AS.PAR ;MAKE IT A %PARAM LOC
HRLZI TA,(TB)
HRRI TA,AS.MSC
PUSHJ PP,STASHL
DUM4: MOVE TC,CUREOP ;UP TO NEXT ENTRY
LDB TB,[POINT 6,1(TC),17]
IMULI TB,2 ; [330] EACH SUBSCRIPT TAKES TWO WORDS.
ADDI TC,2(TB)
CAIG TC,(EACA)
JRST DUM2
POPJ PP,
;BAD DUMMY ARG
BADONE: MOVEI DW,E.93 ;?MUST BE IN LINKAGE SECTION
PUSHJ PP,OPNFAT
MOVEI TA,0 ;PUT A 0 IN THE LIST
PUSHJ PP,STASHL
JRST DUM3 ;GO ON WITH LIST
;PUT AN OCTAL 0 INTO AS1FIL
PUTOC0: MOVE CH,[AS.OCT,,1]
PUSHJ PP,PUTAS1
MOVEI CH,0
JRST PUTAS1
SUBTTL GENERATE A "GOBACK" OR "EXIT PROGRAM"
GOBKGN: HRLZI CH,ASINC+SKIPL.## ;"SKIPL %CALLFLAG"
HRRI CH,AS.MSC
PUSHJ PP,PUTASY
HRRZ CH,RETPTR
PUSHJ PP,PUTASN
TLNE W1,(GOBAKF) ;GOBACK?
JRST GOBGN1 ;YES, DO STOPR.
PUSHJ PP,GETTAG ;NO, "JRST %TAG"
ANDI CH,77777
HRRZM CH,ENTAGS
IORI CH,AS.TAG##
HRLI CH,JRST.
HRRZ TA,CH ;GET TAG NUMBER
PUSHJ PP,REFTAG## ;REFERENCE IT
PUSHJ PP,PUTASY
JRST GOBGN2
GOBGN1: MOVEI CH,STOPR.## ;"PUSHJ 17,STOPR."
PUSHJ PP,PUT.PJ
GOBGN2: HRLZI CH,ASINC+SETZM.## ;"SETZM %RETPTR"
HRRI CH,AS.MSC
PUSHJ PP,PUTASY
HRRZ CH,RETPTR
PUSHJ PP,PUTASN
MOVE CH,[ASINC+MOVEI.##+AC16,,AS.MSC] ;"RESF. %FILES"
PUSHJ PP,PUTASY
MOVEI CH,AS.FLS
PUSHJ PP,PUTASN
MOVEI CH,RESF%##
PUSHJ PP,PUT.PJ ;PUT IN ASY FILE
SKIPE PRODSW ;/P ON?
JRST GOBGN3 ;YES, NO TRACE CODE
MOVEI CH,C.TRCE##
PUSHJ PP,PUT.PJ
MOVE CH,[AS.XWD,,1]
PUSHJ PP,PUTASN
MOVEI CH,10001 ;GOBACK FLAG + ARG COUNT
TLNN W1,(GOBAKF) ;GOBACK OR EXIT PGM?
ADDI CH,10000 ;EXIT PROG
PUSHJ PP,PUTASN
MOVEI CH,0
PUSHJ PP,PUTASY
GOBGN3: HRLZI CH,AC17+POPJ.## ;"POPJ 17,"
PUSHJ PP,PUTASY
TLNE W1,(GOBAKF) ;GOBACK?
POPJ PP, ;YES
HRRZ CH,ENTAGS ;"%TAG:" AFTER EXIT PROGRAM
PJRST PUTTAG
SUBTTL GENERATE A "CANCEL"
CANGEN: SWOFF FEOFF1 ;RESET FLAGS
MOVEM W1,OPLINE ;SAVE POSITION OF OPERATOR
CANGN1: MOVE EACA,EOPNXT
CAMN EACA,EOPLOC ;MORE OPERANDS?
POPJ PP, ;NO, THATS ALL
HRRZ TC,EOPLOC ;GET NEXT OPERAND
MOVEI TC,1(TC)
MOVEM TC,CUREOP
MOVE CH,1(TC) ;GET EXTAB INDEX
IFN ANS74,<
LDB TB,[POINT 3,CH,20]
CAIN TB,CD.DAT ;SEE IF JUST DATAB LINK
JRST CANGN5 ;YES IT IS
>
ANDI CH,77777 ;CLEAR REST
IORI CH,AS.EXT ;EXTERNAL
TLO CH,MOVEI.+AC16
PUSHJ PP,PUTASY
HRRZI CH,CANCL.## ;GET EXTAB LINK TO CANCEL
PUSHJ PP,PUT.PJ ;<PUSHJ 17,CANCL.>
MOVE TA,1(TC) ;GET EXTAB ADDR
PUSHJ PP,LNKSET
LDB TB,EX.ENT## ;CHECK FOR LEGAL CANCEL
MOVEI DW,E.565 ;MESSAGE NUMBER
JUMPN TB,OPNFAT ;CANNOT CANCEL INTERNAL ENTRY POINT
SETO TE, ;SET "REFD IN NON-RES"
TSWF FAS3 ;CK NON-RES FLAG
DPB TE,EX.NRS
CANGN4: MOVE TA,[2,,2] ;GO TO NEXT OPERAND
ADDM TA,EOPLOC
JRST CANGN1
;HERE FOR ANS-74 CALL WITH SUBROUTINE UNKNOWN AT COMPILE TIME
IFN ANS74,<
CANGN5: MOVE TA,CH
PUSHJ PP,LNKSET
MOVE TC,CUREOP ;POINT TO IT
PUSHJ PP,SETOPA ;GET ARG
MOVE TE,[EBASEA,,EBASEB]
BLT TE,EBASBX ;COPY
MOVEI TE,D6MODE## ;FORCE SIXBIT
MOVEM TE,EMODEB ;AS TARGET
MOVEI TE,6 ;6 OR LESS CHARS.
MOVEM TE,ESIZEB## ;LEFT JUSTIFIED
MOVEI TE,1 ;GET 1 WORD
PUSHJ PP,GETEMP ; OF TEMP STORAGE
MOVEM EACC,EINCRB ;POINT "B" AT TEMP
MOVE TA,[^D36,,AS.MSC]
MOVEM TA,EBASEB
SWOFF FBSUB
PUSHJ PP,MXX.## ;GO DO MOVE
MOVSI CH,MOV##+AC16
PUSHJ PP,PUT.B ;MOVE 16,%TEMP+N
MOVEI CH,CANCL.
PUSHJ PP,PUT.PJ ;PUSHJ 17,CANCL.
JRST CANGN4 ;FINISH OFF
>
END