Trailing-Edge
-
PDP-10 Archives
-
ap-c800d-sb
-
sugens.mac
There are no other files named sugens.mac in the archive.
; UPD ID= 1941 on 6/19/79 at 11:52 AM by N:<NIXON>
TITLE SUGENS FOR COBOL V12
SUBTTL SIMULTANEOUS ACCESS CODE GENERATION ROUTINES.
;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, 1979 BY DIGITAL EQUIPMENT CORPORATION
;;; EDITS
;SSC 2-AUG-76 MAKE ERENQ GEN CALL TO CNTAI. FOR COMPOUND RETAIN
SEARCH P
%%P==:%%P
;THIS FILE CONTAINS THE SOURCE CODE FOR ALL THE GENERATORS
;RELATING TO THE SIMULTANEOUS UPDATE FEATURE.
TWOSEG
RELOC 400000
ENTRY FENQGN,EFENQG,FUNAVG,EFUNAV
ENTRY ERENQG,RDEQGN
ENTRY ERUNAV,ENRGEN,RENQGN,ERDEQG
EXTERN AS.EXT,AS.LIT,AS.MSC,AS.TAG,COMEBK,CUREOP
EXTERN AS.CNB,AS.FIL,OCTLIT
EXTERN ELITPC,EOPNXT,ESAVW1,ESUCNT,ESUCT2
EXTERN ESUFN1,ESUFN2,ESUTAG,ESUTC,GETTAG
EXTERN JRST.,XJRST.,MOVEI.,XWDLIT,PUSH12,PUSHJ.,PUTASN
EXTERN PUTASY,PUTASA,PUT.EX,PUT.PJ,PUTTAG,REFTAG,SARG,XWDLIT,ARG
EXTERN EUNSPT,EUNSTK
EXTERN LFENQ.,LRENQ.,LRDEQ.,CNTAI.
EXTERN STASHI,STASHL,STASHP,STASHQ,POOLIT,PLITPC
IFN ANS74, EXTERN FI.ORG,FI.FAM
IFN ANS68, EXTERN FI.ACC
;FILE ENQUEUE - RECORD ENQUEUE
FENQGN:
RENQGN: PUSHJ PP,PUSH12 ;SAVE OPERATOR ON OPERAND STACK
AOS ESUCNT ;INCREMENT COUNT OF OPERATORS STACKED
AOJA EACC,COMEBK ;GO BACK FOR MORE
;FILE UNAVAILABLE
FUNAVG: PUSHJ PP,GETTAG ;GET A LABEL
AOS TA,EUNSPT
CAILE TA,20
JRST KILL## ;CHECK IF UNAVAILABLE STACK OVERFLOW
MOVEM CH,EUNSTK-1(TA) ;STORE LABEL ON STACK IF NO OVERFLOW
IOR CH,[JRST.,,AS.TAG]
PUSHJ PP,PUTASY ;GENERATE JRST TAG
MOVE TA,EUNSTK-1(TA)
PUSHJ PP,REFTAG ;REFERENCE TAG
SKIPE CH,ESUTAG ;IF ESUTAG IS NON-ZERO
PUSHJ PP,PUTTAG ;DEFINE LABEL USED BY EFENQG
JRST COMEBK ;ALL DONE; UNAVAILABLE CODE GENERATED NEXT
;END FILE ENQUEUE
EFENQG: MOVEM W1,ESAVW1 ;SAVE FLAG IN W1 FOR USE LATER
MOVE TA,ESUCNT
MOVEM TA,ESUCT2 ;SAVE N FOR DECREMENTING
AOJ TA,
LSH TA,1
HRLI TA,XWDLIT ;CREATE HEADER WORD FOR LITERAL
PUSHJ PP,STASHI ;STASH AWAY HEADER WORD
LSH W1,-8
TLZ W1,777776
HLL TA,W1 ;MOVE UNAVAILABLE BIT TO LH OF TA
HRRI TA,AS.CNB
PUSHJ PP,STASHL ;STASH UNAVAILABLE FLAG IN LIT TAB
HRL TA,ESUCNT
HRRI TA,AS.CNB
PUSHJ PP,STASHL ;STASH AWAY N IN LIT TABLE
EFENQ1: SOSGE ESUCT2 ;IS THERE ANOTHER FILE ARGUMENT ?
JRST EFENQ2 ;NO
MOVE EACA,EOPNXT ;YES, GET POINTER TO TOP OF STACK
POP EACA,W2
POP EACA,TA ;POP OFF OPERATOR
HRRI TA,AS.CNB
PUSHJ PP,STASHL ;STASH AWAY FLAGS
POP EACA,TA
ANDI TA,77777
ORI TA,AS.FIL
PUSHJ PP,STASHL ;STASH AWAY FILE TABLE ADDRESS
POP EACA,W1 ;POP OFF OPERAND
MOVEM EACA,EOPNXT ;UPDATE POINTER TO TOP OF STACK
SUBI EACC,2 ;DECREMENT COUNT OF OPERANDS ON STACK
JRST EFENQ1 ;GO BACK FOR THE NEXT ONE
EFENQ2: MOVE CH,[MOVEI.+ASINC+AC16,,AS.MSC]
PUSHJ PP,PUTASY ;GENERATE MOVEI 16,LIT-TABLE-ENTRY
HRRZ CH,ELITPC
TRO CH,AS.LIT
PUSHJ PP,PUTASN ;(IT REQUIRES 2 WORDS IN THE AS FILE)
MOVEI CH,LFENQ.
PUSHJ PP,PUT.PJ ;GENERATE PUSHJ 17,LFENQ
AOS TA,ESUCNT
ADDM TA,ELITPC ;INCREMENT ELITPC BY N+1
SETZM ESUCNT ;ZERO COUNT OF OPERANDS
MOVE TA,ESAVW1
TLNN TA,000400 ;USER SUPPLIED UNAVAILABLE STATEMENT?
JRST COMEBK ;NO, WE'RE ALL DONE
PUSHJ PP,PUTASA ;IN SECOND SET
PUSHJ PP,GETTAG ;GET A LABEL
MOVEM CH,ESUTAG ;SAVE FOR LATER USE BY FUNAVG
IOR CH,[XJRST.,,AS.TAG]
PUSHJ PP,PUTASY ;GENERATE JRST TAG
MOVE TA,ESUTAG ;GET TAG
PUSHJ PP,REFTAG ;REFERENCE IT
JRST COMEBK ;ALL DONE
;END FILE UNAVAILABLE - END RECORD UNAVAILABLE
;END NOT RETAINED
EFUNAV:ERUNAV:
ENRGEN: SOSGE TA,EUNSPT ;CHECK FOR STACK UNDERFLOW
JRST KILL
MOVE CH,EUNSTK(TA) ;GET LABEL FROM TOP OF UNAVAILABLE STACK
PUSHJ PP,PUTTAG ;DEFINE IT
;END RECORD ENQUEUE - END RECORD DEQUEUE
ERENQG:
ERDEQG: MOVE TA,ESUCNT ;GET COUNT OF RENQ OR RDEQ OPERATORS ON STACK
JUMPE TA,COMEBK ;ZERO COUNT MEANS USER SYNTAX ERROR - NO CODE GENERATED
MOVE TC,EOPNXT
MOVEM W1,ESAVW1 ;SAVE ERENQ OR ERDEQ FLAGS
ERENQ1: POP TC,W2 ;LOCATE 1ST RENQ OR RDEQ OPERATOR ON STACK
POP TC,W1
JUMPL W1,ERENQ1 ;JUMP IF OPERAND
CAIN W2,147
JRST ERENQ0 ;JUMP IF RENQ
CAIE W2,152
JRST ERENQ1 ;JUMP IF NOT RDEQ
ERENQ0: SOJG TA,ERENQ1 ;JUMP IF NOT 1ST RENQ OR RDEQ
ERENQ2: POP TC,W2 ;LOCATE FILE-NAME OPERAND FOR 1ST RENQ OR RDEQ
POP TC,W1
JUMPGE W1,ERENQ2 ;JUMP IF OPERATOR (SHOULDN'T BE ANY, THOUGH)
TLNE W1,200000
JRST ERENQ2 ;JUMP IF LITERAL
LDB TE,[POINT 3,W2,20]
JUMPN TE,ERENQ2 ;JUMP IF NOT FILE-NAME
AOJ TC, ;ADJUST TC TO POINT AT 1ST WORD OF FILE-NAME
MOVEM TC,ESUFN1 ;SAVE POINTER TO 1ST WORD OF FILE-NAME
SKIPA
ERENQ3: ADDI TC,2 ;POINT TO NEXT ITEM
ERENQ4: HRRZ TE,EOPNXT ;ARE WE LOOKING AT THE TOP OF THE STACK?
CAIN TE,-1(TC)
JRST ERENQ5 ;YES, JUMP (ALL SUBSCRIPTS HAVE BEEN HANDLED)
SKIPL TE,0(TC) ;ARE WE LOOKING AT AN OPERAND?
JRST ERENQ3 ;NO, IGNORE ITEM
TLNE TE,200000
JRST ERENR0 ;JUMP IF LITERAL OR FIG CONSTANT
LDB TE,[POINT 3,1(TC),20]
JUMPE TE,ERENR1 ;JUMP IF WE ARE LOOKING AT A FILE-NAME
ERENR0: MOVEM TC,CUREOP ;SET CUREOP FOR SARG
PUSHJ PP,SARG ;GENERATE CODE FOR SUBSCRIPTS, IF ANY
MOVEM TC,ESUTC ;SAVE RETURNED TC
MOVE TC,CUREOP ;RESTORE TC THAT POINTS TO ARGUMENT
PUSHJ PP,ARG ;SET ARG LIST FOR LATER OUTPUT
MOVE TC,ESUTC ;RESTORE RETURNED TC
JRST ERENQ4
ERENR1: SKIPL TA,2(TC)
JRST ERNR1A ;JUMP IF NO OPERAND FOLLOWING FILE NAME
MOVEM TC,CUREOP ;SAVE TC
TLNN TA,GNLIT ;SKIP IF OPERAND A LITERAL OR FIGURATIVE CONSTANT
JRST ERENR2
TLNE TA,GNFIGC
JRST ERENR8 ;JUMP IF FIGURATIVE CONSTANT
TLNN TA,GNNUM
JRST ERENR8 ;JUMP IF NON-NUMERIC LITERAL
MOVE TA,3(TC)
PUSHJ PP,LNKSET##
LDB TA,[POINT 7,0(TA),6]
CAILE TA,^D10
JRST ERENR8 ;JUMP IF MORE THAN 10 CHARACTERS IN LITERAL
MOVEM TA,ESIZEA
MOVEI TA,D1MODE##
MOVEM TA,EMODEA## ;SET EMODEA TO COMP
MOVE TC,CUREOP
ADDI TC,2
JRST ERENR7
; NO OPERAND FOLLOWING FILE NAME
;(NO KEY WAS GIVEN). IF CBL74,
;IF ORGANIZATION IS SEQUENTIAL OR RELATIVE, (NOT INDEXED),
; AND ACCESS MODE = SEQUENTIAL, THEN SET "NEXT" BIT.
ERNR1A:
IFN ANS74,<
MOVE TA,1(TC) ;POINT TO FILE TABLE
PUSHJ PP,LNKSET
LDB TB,FI.ORG ;ORGANIZATION
CAIN TB,%ACC.I ; IF INDEXED, DON'T SET "NEXT" BIT
JRST ERENQ3
LDB TB,FI.FAM ;FILE ACCESS MODE
CAIE TB,%FAM.S ;SEQUENTIAL?
JRST ERENQ3 ;NO, DON'T SET "NEXT" BIT.
MOVSI TB,(1B15) ;NICE SYMBOLIC CONSTANT, HA HA
IORM TB,2(TC) ;SET "NEXT" BIT FOR CONVENIENCE OF LSU
>;END IFN ANS74
JRST ERENQ3 ;
ERENR8: LDB LN,[POINT 13,2(TC),28]
LDB CP,[POINT 7,2(TC),35]
MOVEI DW,E.570
PUSHJ PP,FATAL## ;GENERATE ERROR MESSAGE
;(LITERAL OR FIGURATIVE CONSTANT NOT ALLOWED)
ERENR9: MOVE TC,CUREOP ;RESTORE TC
JRST ERENQ3 ;RETURN TO MAIN STREAM
ERENR2: MOVEI LN,EBASEA##
ADDI TC,2
PUSHJ PP,SETOPN## ;GET DESCRIPTION OF DATA NAME
ERENR7: MOVE TA,-1(TC)
PUSHJ PP,LNKSET## ;GET POINTER TO FILE TABLE
IFN ANS68, LDB TB,FI.ACC
IFN ANS74, LDB TB,FI.ORG
CAIN TB,%ACC.I
JRST ERENR3 ;JUMP IF FILE INDEXED
MOVE TB,EMODEA##
CAIN TB,D1MODE##
JRST ERENR9 ;JUMP IF 1 WORD COMP
MOVE TC,CUREOP
LDB LN,[POINT 13,2(TC),28]
LDB CP,[POINT 7,2(TC),35]
MOVEI DW,E.571
PUSHJ PP,FATAL## ;GENERATE ERROR MESSAGE
;(KEY FOR SEQUENTIAL OR RELATIVE MUST BE COMP)
JRST ERENR9
ERENR3: LDB TA,FI.SKY## ;SET UP EMODEB, ESIZEB FOR SYMBOLIC KEY
JUMPE TA,ERENR9 ;ERROR, SYMBOLIC KEY NOT DEFINED
PUSHJ PP,LNKSET##
LDB TB,DA.USG##
SUBI TB,1
MOVEM TB,EMODEB##
LDB TB,DA.INS##
MOVEM TB,ESIZEB##
MOVE TC,CUREOP
MOVE TB,EMODEB##
CAME TB,EMODEA##
JRST ERENR4 ;JUMP IF USAGE DOESN'T MATCH
MOVE TA,ESIZEA##
CAMN TA,ESIZEB##
JRST ERENQ3 ;JUMP IF SIZE MATCHES
CAIE TB,D1MODE##
JRST ERENR4
CAMG TA,ESIZEB
JRST ERENQ3 ;JUMP IF SIZE OF SYMBOLIC KEY
;GREATER THAN SIZE OF LITERAL
;OR DATA NAME IF BOTH ARE COMP
ERENR4: LDB LN,[POINT 13,2(TC),28]
LDB CP,[POINT 7,2(TC),35]
MOVEI DW,E.572
PUSHJ PP,FATAL## ;GENERATE ERROR MESSAGE
;(KEYS DON'T AGREE IN USAGE AND SIZE)
JRST ERENR9
ERENQ5: MOVE CH,[MOVEI.+ASINC+AC16,,AS.MSC]
PUSHJ PP,PUTASY ;GENERATE MOVEI 16,LIT-TABLE-ENTRY
HRRZ CH,ELITPC
TRO CH,AS.LIT
PUSHJ PP,PUTASN ;(IT TAKES 2 WORDS)
MOVE TA,[OCTLIT,,1] ;CREATE HEADER WORD FOR LITERAL
PUSHJ PP,STASHI
HLL TA,ESAVW1 ;GET ERENQ OR ERDEQ FLAGS
TLZ TA,777377 ;ZERO ALL BITS EXCEPT UNAVAILABLE
LSH TA,-8 ;NORMALIZE IN LH
HRR TA,ESUCNT ;SET RH TO N
PUSHJ PP,STASHL ;STASH AWAY
AOS ELITPC
LDB W1,[POINT 9,ESAVW1,8]
MOVEI CH,LRDEQ.
CAIN W1,000153
JRST ERNQ5A
MOVE TA,ESAVW1 ;GEN COMPOUND RETAIN FLAG
MOVEI CH,LRENQ. ;PRESUME NOT COMPOUND
TLNE TA,200
MOVEI CH,CNTAI.
ERNQ5A: PUSHJ PP,PUT.PJ ;GENERATE PUSHJ 17,LRENQ (OR LRDEQ)
SKIPA TE,ESUFN1
ERENQ6: MOVE TE,ESUFN2 ;GET POINTER TO FILE-NAME IN CUREOP
MOVEM TE,CUREOP
ERENQ7: ADDI TE,2 ;GET POINTER TO CORRESPONDING RENQ OR RDEQ IN TE
LDB TA,[POINT 9,0(TE),8]
CAIN TA,000147
JRST ERENQ9
CAIE TA,000152
JRST ERENQ7
ERENQ9: HLLZ W1,0(TE) ;SET UP RENQ OR RDEQ & FLAGS IN LH
HRR W1,CUREOP
HRR W1,1(W1)
ORI W1,AS.FIL
CAMN W1,[152400,,0] ;IF FREE EVERY RECORD, THEN
ORI W1,AS.CNB ;SET FILE TABLE TO NULL
ADDI TE,2
MOVEM TE,ESUFN2 ;SAVE POINTER TO NEXT FILE NAME (IF ANY)
MOVE TA,[XWDLIT,,2]
PUSHJ PP,STASHI
MOVE TA,W1
HRRI TA,AS.CNB
PUSHJ PP,STASHL
HRRZ TA,W1
PUSHJ PP,STASHL ;STASH AWAY FILE ARGUMENT
AOS ELITPC
MOVE TC,CUREOP
LDB CH,[POINT 9, 2(TC), 8]
CAIN CH,000147
JRST ERENQ8
CAIN CH,000152
JRST ERENQ8 ;JUMP IF OPERATOR
MOVE TA,[XWDLIT,,2]
PUSHJ PP,STASHI
HLRZ TA,2(TC)
ANDI TA,740 ;EXTRACT AC FIELD OF OPERAND
CAIN TA,2B30 ;CONVERT TO NEW TYPE CODES
MOVEI TA,4B30
CAIN TA,0B30
MOVEI TA,2B30
CAIN TA,10B30
MOVEI TA,15B30
CAIN TA,17B30
MOVEI TA,7B30
MOVE CH,2(TC)
TLNE CH,20
TRO TA,20
PUSHJ PP,STASHL
HRRZ TA,2(TC)
HRL TA,3(TC)
PUSHJ PP,STASHL ;GENERATE XWD (IT TAKES 3 STASHL'S)
AOS ELITPC
ERENQ8: HRRZ TA,ESUFN2 ;HAVE WE GENERATED LAST ITEM?
HRRZ TE,EOPNXT
SUB TA,TE
SOJN TA,ERENQ6 ;NO, GO BACK AND DO NEXT ITEM
HRRZ TA,ESUFN1 ;YES
SOJ TA,
SUBB TE,TA
LSH TE,-1
SUB EACC,TE ;ADJUST EACC
HRL TA,TA
MOVN TA,TA
ADDB TA,EOPNXT ;ADJUST EOPNXT
MOVEM TA,EACA ;ADJUST EACA
SETZM ESUCNT
MOVE TA,ESAVW1 ;GET UNAVAILABLE FLAG
TLNN TA,000400
JRST COMEBK ;ALL DONE IF NO UNAVAILABLE STATEMENT
SETZM ESUTAG ;OTHERWISE GENERATE JRST AROUND UNAVAILABLE STATEMENT
JRST FUNAVG
;RECORD DEQUEUE
RDEQGN: TLNN W1,000400
JRST FENQGN
MOVEM W1,ESAVW1
HRLZI W1,400000
HRRZI W2,000001
PUSHJ PP,PUSH12 ;IF FREE EVERY RECORD, PUT DUMMY FILE NAME ON OPERAND STACK
MOVE W1,ESAVW1
HRRZI W2,000152
AOJA EACC,FENQGN
END