Trailing-Edge
-
PDP-10 Archives
-
BB-H580E-SB_1985
-
bisgen.mac
There are 7 other files named bisgen.mac in the archive. Click here to see a list.
; UPD ID= 1206 on 8/30/78 at 1:15 PM
TITLE BISGEN FOR COBOL V12C
SUBTTL D.B.TOLMAN
SEARCH COPYRT
SALL
COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1975, 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,CHREQV
%%P==:%%P
BIS==:BIS
;EDITS
;NAME DATE COMMENTS
;V12B ***************
;JEH 17-DEC-82 [1446] DON'T OVERWRITE USER-DEFINED FLOATING CURRENCY
; SYMBOL WITH MINUS SIGN
;V10*****************
;********************
; THIS MODULE CONTAINS A SERIES OF ROUTINES
; WHICH ARE CALLED BY THE EDIT GENERATION SECTIONS OF MOVGEN.MAC,
; AND WHICH WILL PRODUCE THE APPROPRIATE PATTERN STRING AND
; IN-LINE CODE TO USE THE EDIT INSTRUCTION OF THE BIS.
; SET UP CODE USES THREE BLOCKS OF STORAGE IN THE LOWSEG
; OF THE GENERATED CODE AS THE EFFECTIVE ADDRESS OF THE
; EDIT INSTRUCTION. THEY ARE SET UP BY LIBOL AT INITIALIZATION
; TIME AND ONLY REQUIRE CORRECTIONS FOR CORRECT TRANSLATION TABLE
; AND CORRECT FILL AND FLOAT CHARACTERS.
; AS THE EDIT INSTRUCTION IS NOT GENERAL ENOUGH TO HANDLE
; SOME OF THE CONSTRUCTIONS REQUIRED, THE EDIT INSTRUCTION
; IS SOMETIMES FOLLOWED BY CODE WHICH TESTS THE FLAG BITS
; IN THE PATTERN AC TO SEE IF MORE WORK NEEDS TO BE DONE.
TWOSEG
.COPYRIGHT ;Put standard copyright statement in REL file
SALL
RELOC 400000
ENTRY BISINI,BSTRAN,BISCAL,BSEND
IFE BIS,<
BISINI: BSTRAN: BISCAL: BSEND:
OUTSTR [ASCIZ /
?Internal compiler error - BISGEN was called.
/]
JRST KILL##
END
>
SUBTTL DEFINITIONS
; REFER TO THE KL-10 EXTENDED INSTRUCTION SET DOCUMENTATION
; FOR THE COMPLETE SPECIFICATION OF THE EDIT INSTRUCTION FORMAT
; PATTERN CODES
B.STOP=0 ;STOP EDIT
B.SEL=1 ;SELECT NEXT INPUT CHARACTER
B.SIG=2 ;SET SIGNIFICANCE ON ( STORE CURRENT
; POINTER IN MARK )
B.SEP=3 ;FIELD SEPARATOR - CLEAR ALL FLAGS
B.EXCH=4 ;EXCHANGE MARK AND DESTINATION POINTERS
B.MSG=100 ;MESSAGE CHARACTER
B.SKPM=500 ;SKIP IF M FLAG SET(NEGATIVE NUMBER)
B.SKPN=600 ;SKIP IF N FLAG SET(NON-ZERO NUMBER)
B.SKPA=700 ;SKIP ALWAYS
; FLAGS IN THE FIRST AC OF THE EDIT BLOCK
S.BIT=400000 ;SIGNIFICANCE FLAG
N.BIT=200000 ;NEGATIVE FLAG
M.BIT=100000 ;MINUS FLAG
; MESSAGE CHARACTER CODES OR INDICES
BM.FIL=0 ;FILL CHARACTER
BM.FLT=1 ;FLOAT CHARACTER
BM.$=2 ;DOLLAR SIGN
BM.COM=3 ;COMMA
BM..=4 ;PERIOD
BM.BL=5 ;BLANK
BM.0=6 ;ZERO
BM.PL=7 ;PLUS
BM.MI=10 ;MINUS
BM.C=11 ;"C"
BM.R=12 ;"R"
BM.D=13 ;"D"
BM.B=14 ;"B"
BM.SL==15 ;SLASH
; A FEW MASK CODES
CODEBL==5 ;BLANK
CODEP==11 ;"."
;EBCDIC CHARACTER CODES OF INTEREST
AST.9==AE%52 ;ASTERISK
PL.9==AE%53 ;PLUS
MI.9==AE%55 ;MINUS
DL.9==AE%44 ;DOLLAR SIGN
BL.9==AE%40 ;BLANK
;SPECIAL FILL AND FLOAT CODES
DOLLAR==400000 ;"$" - EDITB REPLACES BY CORRECT CHAR
BL.6==10000 ;SIXBIT BLANK - SO THAT IT APPEARS TO BE
; SOMETHING NON-ZERO
; THE EDIT INSTR IGNORES FLOAT CHAR IF
; THE RESPECTIVE WORD IS ZERO, SO WE NEED
; TO PUT A CODE THERE THAT IS NON ZERO BUT
; IS STILL A SIXBIT BLANK. USE 10000 SINCE
; IT IS STILL SMALLER THAN ANY OF THE
; AS.* GUYS, SO COBOLG WONT GET CONFUSED
; POINTERS TO FLOAT AND SIGN CHARACTERS AS SET UP BY PSCAN.MAC
; THEY ARE IN SIXBIT AND 0 IMPLIES "+" OR BLANK
EXTERNAL EDITW1,EDITW2,EDITW3
DEFINE FLTCHR = <[POINT 6,EDITW1,17]> ;FLOAT CHR
DEFINE SGNCHR = <[POINT 6,EDITW1,11]> ;SIGN CHARACTER
; STORAGE LOCATIONS USED IN THE GENERATION PROCESS
;BISMIN MINUS SIGN FLAG. SET TO -1 WHEN LEADING MINUS CODE
; NEEDS TO BE ADDED AFTER THE EDIT INSTRUCTION.
;
;BISBW0 BLANK WHEN ZERO. CONTAINS NUMBER OF ADDITIONAL CHARACTERS
; THAT NEED TO BE BLANKED WHEN THERE IS A BLANK WHEN ZERO
; CLAUSE ON THE FIELD, AND THE EDIT INSTR COULDNT HANDLE
; ALL THE SPACES NECESSARY.
;
;BISDST DESTINATION BYTE POINTER. CONTAINS THE ADDRESS OF THE
; DESTINATION BYTE POINTER AFTER CALCULATION. SAVES A
; RECALCULATION OF SUBSCRIPT IN THAT CASE. NORMALLY ZERO,
; BUT WILL CONTAIN EITHER A LITERAL, OR A TEMP ADDRESS.
;
;BISCNT CURRENT CHARACTER COUNTER
;
;BISBFS NUMBER OF CHARACTERS BEFORE SIGNIFICANCE WAS TURNED OFF.
; THIS IS NEEDED FOR BWZ.
;
;BISASS NUMBER OF CHARACTERS AFTER SIGNIFICANCE
; IS TURNED ON BUT BEFORE DECIMAL POINT. ALSO NEEDED
; FOR BWZ.
;
;BISDOT SET TO 1 IF AN EXPLICIT DECIMAL POINT IS
; ENCOUNTERED AND A SIGSET WAS ISSUED. MOST OF THESE
; SPECIAL COUNTERS ARE NEEDED TO REMEMBER THE LOCATION
; OF THE DECIMAL POINT FOR BWZ "*".
;
;BISFLT FLOAT CHARACTER IN ASCII 0R 0.
;
;BISFIL SET TO "*" IF * SUPPRESSION AND 0 OTHERWISE
;
;BISGOT SET TO -1 AFTER 1ST PLACE HOLDER IN OUTPUT FIELD
; HAS BEEN ENCOUNTERED.
; USED TO DETECT LEADING OR TRAILING SIGNS
;
;BISSGN INSERT SIGN CODE: 0=NONE, +1=LEADING, OR -1=TRAILING
;
;BISSIG -1=SIGNIFICANCE ON BUT NO SIGSET YET, 0=OFF, AND
; 1=ON AGAIN AFTER SIGSET
;
;BISALP 0=ALPHABETIC/ALPHANUMERIC EDIT, -1=NUMERIC
; NOTE THAT BWZ FOR A NON-EDITED FIELD IS
; DONE AS AN ALPHANUMERIC EDIT SO THAT NONE
; OF THE OVERPUNCH SIGNS GET CONVERTED
EXTERNAL BISBW0,BISDST,BISMIN
EXTERNAL BISCNT,BISBFS,BISASS,BISDOT,BISFLT
EXTERNAL BISFIL,BISGOT,BISSGN,BISSIG,BISALP
EXTERNAL BISZRF,BISZRL ;FIRST AND LAST LOCS TO ZERO
;AT BEGINNING OF EACH EDIT
EXTERNAL PUTASY,PUTASN,LNKSET,PUT.EX,EMODEA,EMODEB
EXTERNAL DCPNT.,BMSK2B,ETABLB,LNKCOD,TB.DAT,MOVEI.,PUSHJ.
EXTERNAL D6MODE,D7MODE,D9MODE,TB.DAT
EXTERNAL AS.EXT,AS.LIT,AS.XWD,AS.MSC,AS.CNB
EXTERNAL MOV,DMOVM.,MOVEM.,DPB.,IDPB.,HRRM.,JRST.,SETZB.,TLNN.,TLNE.
EXTERNAL OCTLIT,BYTLIT,XWDLIT,XTNLIT,AS.DOT
EXTERNAL IBPFLG,ELITPC,PLITPC
EXTERNAL POOL,POOLIT,MBYTPB,PUT.LD,PUT.EX,PUTASA,STASHP,STASHQ
EXTERNAL GETEMP
SUBTTL MASK TO PATTERN TRANSLATION/DISPATCH TABLE
; THE FOLLOWING TABLE IS USED TO TRANSLATE FROM THE MASKS
; CURRENTLY GENERATED BY MOVGEN FOR EDIT.U/S TO THE
; PATTERN STRINGS NEEDED FOR THE KL-10 EXTENDED EDIT INSTRUCTION
; ROUTINE EDIT.B
; THE LEFT HALF OF EACH ENTRY CONTAINS THE BIS PATTERN CODE
; (SUBJECT TO THE DISPATCH ROUTINE) AND BITS INDICATING WHETHER
; SIGNIFICANCE IS TO BE TURNED ON, OFF, OR LEFT ALONE.
; THE RIGHT SIDE IS THE DISPATCH ADDRESS.
; THE TABLE IS INDEXED BY MASK CODE
SON=400000 ;TURN SIGNIFICANCE ON
SOFF=20000 ;TURN SIGNIFICANCE OFF
BISTAB:
XWD SON!B.SEL, BSTR00 ;0 - ALPHA
XWD SON!B.SEL, BSTR00 ;1 - NUMERIC
XWD SOFF!B.SEL, BSTR00 ;2 - SUPPRESS "*"/"Z"
XWD SOFF!B.SEL, BSTR20 ;3 - FLOAT "$"/"+"/"-"
XWD B.MSG!BM.COM, BSTR30 ;4 - COMMA
XWD B.MSG!BM.BL, BSTR00 ;5 - B
XWD B.MSG!BM.0, BSTR00 ;6 - 0
XWD B.MSG!BM.$, BSTR00 ;7 - $
XWD B.MSG!BM.PL, BSTR40 ;10 - INSERT SIGN
XWD B.MSG!BM.., BSTR50 ;11 - DECIMAL POINT
XWD B.MSG!BM.R, BSTR60 ;12 - CR
XWD B.MSG!BM.B, BSTR70 ;13 - DB
XWD 0, BSTR80 ;14 - V
IFN ANS74,<
XWD B.MSG!BM.SL, BSTR00 ;15 - SLASH
>
; THE REMAINING CODES NEVER REACH THE POINT OF TRANSLATION
SUBTTL INITIALIZATION
; THIS ROUTINE INITIALIZES THE LOCATIONS APPROPRIATELY AT
; THE BEGINNING OF EVERY EDIT GENERATION
BISINI::
SETZM BISZRF ;CLEAR FIRST LOCATION IN BLOCK TO 0
MOVE TB,[BISZRF,,BISZRF+1] ;SET UP ZEROING BLT
BLT TB,BISZRL ;CLEAR
SETOM BISSIG ;INIT SIGNIFICANCE INDICATOR TO -1
TSWF FBNUM ;IS THIS A NUMERIC EDIT?
SETOM BISALP ;YES, REMEMBER THAT.
;SET UP FILL CHARACTER
LDB TB,FLTCHR
CAIE TB,"*"-40 ;IS IT * FILL?
TDZA TB,TB ;NO, SET TO ZERO OTHERWISE
MOVEI TB,"*" ;YES
MOVEM TB,BISFIL ;AND STORE
MOVE TB,[POINT 9,TA] ;INITIALIZE LITTAB BUFFER REGISTER POINTER
POPJ PP, ; AND RETURN
SUBTTL TRANSLATE MASK TO PATTERN
; ROUTINE BSTRAN IS CALLED FOR EACH CHARACTER OF THE
; MASK.
;
; CALL: PUSHJ PP,BSTRAN ;MASK CODE IS IN TE
; RETURN+1 ;PATTERN CODE IS IN TE AND
; ;SHOULD BE STORED
; RETURN+2 ;DO NOT STORE A CHARACTER
; ; IN THE PATTERN
;
; ALL OF THESE ROUTINES EXPECT THAT THE PATTERN POINTER IS IN
; TB POINTING TO TA, AND THAT THE REPEAT COUNT FOR THE MASK
; CHARACTER IS IN TD (<=0 IMPLIES 1).
BSTRAN::
PUSH PP,TC ;SAVE TEMPORARY
HRRZ TC,BISTAB(TE) ;GET DISPATCH ADDRESS
JRST (TC) ;GO
; SIMPLE TRANSLATION FROM TABLE
BSTR00:
HLRZ TE,BISTAB(TE) ;GET TRANSLATION CODE
BSTR01:
TRZE TE,SON ;TURN SIGNIFICANCE ON??
PUSHJ PP,SIGON ;YES
TRZE TE,SOFF ;TURN SIGNIFICANCE OFF??
PUSHJ PP,SIGOFF ;YES
BSTR02:
CAIG TD,0 ;IS REPEAT COUNT >= 1
MOVEI TD,1 ;NO - SET TO ONE
ADDM TD,BISCNT ;ADD TO COUNTER
SETOM BISGOT ;NOTE THAT WE HAVE SEEN SOMETHING
POPTC: POP PP,TC ;RESTORE
POPJ PP, ;AND RETURN
SUBTTL DISPATCH ROUTINES FOR MASK TO PATTERN CONVERSION
BSTR20: ;FLOATING CODE: +/-/$
SKIPE BISFLT ;HAVE WE BEEN HERE BEFORE?
JRST BSTR00 ;YES - RETURN
;DECIDE WHICH SIGN IT IS THAT WE ARE DEALING WITH AND SET UP
; FLOAT CHARACTER
LDB TC,FLTCHR ;GET CHARACTER
ADDI TC,40 ;CONVERT TO ASCII
CAIN TC,"$" ;DOLLAR SIGN?
MOVEI TC,DOLLAR ;YES USE SPECIAL CODE
MOVEM TC,BISFLT ;SAVE IT AWAY
JRST BSTR00 ;RETURN
BSTR30: ;COMMA
;DETERMINE WHETHER A "," OR "." IS SUPPOSED TO BE USED
MOVE TC,DCPNT. ;CODE TO BE USED FOR "."
CAIE TC,"." ;IS IT REALLY "."?
MOVEI TE,CODEP ;THEY WERE SWITCHED - USE "."
JRST BSTR00 ;RETURN
BSTR40: ; INSERT SIGN CODE
; IS IT LEADING OR TRAILING?
SKIPE BISGOT ;HAVE WE SEEN CHARACTERS BEFORE THIS ONE
JRST BSTR41 ;YES - MUST BE TRAILING
;LEADING SIGN INSERT
AOS BISSGN ;NOTE LEADING
LDB TC,SGNCHR ;WHAT SIGN IS IT?
SKIPN TC ;IS IT ZERO?
MOVEI TE,CODEBL ;YES - MINUS SO USE BLANK
JRST BSTR00 ;RETURN
BSTR41: ;TRAILING INSERT SIGN
SETOM BISSGN ;NOTE TRAILING
TSWT FASIGN ;IS A SIGNED?
JRST BSTR42 ;NO - SO NO CHECKING NEEDED
;BOTH A AND B ARE SIGNED
;PUT OUT FOLLOWING PATTERN: SKPM+1,"+"/" ",SKPA,"-"
MOVEI TC,B.SKPM+1 ;SKIP TO "-" IF NUMBER IS NEGATIVE
PUSHJ PP,BISSTO ;STORE IN PATTERN
LDB TC,SGNCHR ;WHAT SIGN IS IT?
SKIPN TC ;0?
SKIPA TC,[B.MSG!BM.BL];YES - MINUS USE BLANK
MOVEI TC,B.MSG!BM.PL ;YES - ITS +
PUSHJ PP,BISSTO ;STORE IN PATTERN
MOVEI TC,B.SKPA ;SKIP
PUSHJ PP,BISSTO ;STORE IT
MOVEI TE,B.MSG!BM.MI ;MINUS
JRST BSTR02 ;RETURN AND HAVE TE STORED
BSTR42: ; UNSIGNED SENDER
; JUST PUT IN + OR BLANK
LDB TC,SGNCHR ;WHAT SIGN?
SKIPN TC
SKIPA TE,[B.MSG!BM.BL];USE BLANK FOR MINUS
MOVEI TE,B.MSG!BM.PL ;OR "+" FOR "+"
JRST BSTR02 ;RETURN TO STORE CODE
BSTR50: ;EXPLICIT DECIMAL POINT
SETOM BISGOT ;NOTE THAT A CODE HAS BEEN SEEN
;BECAUSE WE POPJ BACK SOMETIMES
;RATHER THAN RETURNING TO BSTRAN
PUSHJ PP,SIGON ;TURN SIGNIFICANCE ON IF NECESSARY
;CHECK TO SEE IF THERE WAS A SIGSET ISSUED IN THE PATTERN
; THIS IS IMPORTANT BECAUSE IF NOT THERE IS NO MARK POINTER
; TO GO BACK TO FOR BWZ
SKIPG BISSIG ;?
JRST BSTR51 ;NONE ISSUED
;A SIGSET WAS ISSUED SOME TIME OR OTHER
MOVEI TC,0
EXCH TC,BISCNT ;GET BISCNT AND CLEAR IT
MOVEM TC,BISASS ;SAVE FOR BWZ - THIS IS THE NUMBER OF
;CHARACTERS BEFORE THE DECIMAL
;POINT THAT WOULD HAVE TO BE BLANKED
;OR "*"ED
AOS BISDOT ;COUNT THE DECIMAL POINT
PUSHJ PP,BISGT. ;GET ACTUAL CODE FOR DECIMAL POINT ./,
;RETURN WITH IT IN TE TO BE STORED
JRST POPTC ;RESTORE TC AND RETURN
BSTR51: ; SIGSET WAS NEVER EXPLICITLY ISSUED, IE. SIGNIFICANCE WAS NEVER
; TURNED OFF. WE ARE OK UNLESS ITS A BWZ"*", IN WHICH CASE
; WE MUST BE ABLE TO GET BACK TO DECIMAL POINT.
;SPECIFICALLY THE CASE OF [+/-][$].*[*...]
SKIPE BISFLT ;IS IT * SUPPRESSION?
PUSHJ PP,BISBWZ ;YES - CHECK FOR BWZ REQUEST AND SKIP IF
JRST BSTR52 ;NOT * OR NOT BWZ - NO PROBLEMS
;THE CASE HAS BEEN ENCOUNTERED
;SO ISSUES A SIGSET JUST AFTER THE DECIMAL POINT IN ORDER
;TO GET THE MARK POINTER SAVED SO THAT WE CAN COME BACK WITH
;"*"'S AND NOT DESTROY THE DECIMAL POINT. ANYTHING BEFORE
;THE DECIMAL POINT WILL BE HANDLED BY THE AFTBWZ CODE.
PUSHJ PP,BISGT. ;GET CODE FOR DECIMAL POINT
MOVE TC,TE ;MOVE CODE TO TC
PUSHJ PP,BISSTO ; STORE IT
SKIPE TC,BISCNT ;GET CURRENT COUNT
SETZM BISCNT ;CLEAR IT
MOVEM TC,BISBFS ;SAVE THIS COUNT FOR POSSIBLE AFTBWZ
;NOTE THAT COUNT DOES NOT INCLUDE THE
;DECIMAL POINT SO THE INSTRUCTION WILL
;GO BACK AND HANDLE AFTER THE POINT
;AND AFTBWZ WILL DO BEFORE THE POINT
SETZM BISSIG ;CLEAR
AOS BISSIG ;AND NOTE THAT SIGSET WAS DONE
MOVEI TE,B.SIG ;LEAVE WITH SIGSET CODE TO BE STORED
JRST POPTC ;RESTORE TC AND RETURN
BSTR52: ;OTHERWISE JUST PUT THE POINT IN
PUSHJ PP,BISGT. ;GET CODE FOR POINT
JRST BSTR02 ;RETURN NORMALLY AND COUNT IT
BSTR60: ;"CR"
PUSH PP,TE ;SAVE "R" CODE
MOVEI TE,B.MSG!BM.C ;"C" CODE
JRST BSTR71
BSTR70: ;"DB"
PUSH PP,TE ;SAVE "B" CODE
MOVEI TE,B.MSG!BM.D ;"D" CODE
BSTR71: ;HANDLE "CR" OR "DB"
AOS BISCNT ;ONE FOR EXTRA CHARACTER
TSWT FASIGN ; IS A SIGNED
JRST BSTR72 ;NO
;BOTH A AND B ARE SIGNED SO GENERATE THE FOLLOWING PATTERN:
; SKPM+2," "," ",SKPA+1,"C"/"D","R"/"B"
MOVEI TC,B.SKPM+2 ;SKIP IF NEGATIVE
PUSHJ PP,BISSTO ;STORE IT
MOVEI TC,B.MSG!BM.BL ;BLANK
PUSHJ PP,BISSTO
PUSHJ PP,BISSTO ;STORE
MOVEI TC,B.SKPA+1 ;SKIP OVER CR/DB
PUSHJ PP,BISSTO ;STORE IT
MOVE TC,TE ;GET C/D
PUSHJ PP,BISSTO ;STORE
POP PP,TE ;RESTORE R/B MASK CODE
JRST BSTR00 ;RETURN WITH TE CONTAINING MASK CODE
BSTR72: ; A IS UNSIGNED SO JUST PUT IN BLANKS
POP PP,TE ;FORGET SAVED TE
MOVEI TC,B.MSG!BM.BL ;BLANK
PUSHJ PP,BISSTO ;STORE IT
MOVE TE,TC ;RETURN WITH ANOTHER BLANK IN TE TO BE STORED
JRST BSTR02
BSTR80: ; "V"
; JUST TURN SIGNIFICANCE ON AND IGNORE THE "V"
PUSHJ PP,SIGON ;SIGNIFICANCE ON
POP PP,TC ;RESTORE TC
AOS (PP) ;SKIP RETURN TO AVOID STORING A CHARATER
POPJ PP,
SUBTTL END OF PATTERN PROCESSING
BSEND: ; PATTERN IS DONE
; CHECK FOR BWZ AND LEADING SIGN AND THEN STOP AND
; GENERATE AFTER CODE
PUSH PP,TC ;SAVE A REGISTER
PUSHJ PP,BISBWZ ;BLANK WHEN ZERO REQUEST?
JRST BSEN20 ;NO
;BLANK WHEN ZERO
; FIRST SEE IF THERE WAS A SIGSET BECAUSE IF NOT THEN EDIT
; INSTRUCTION IS NO HELP
SKIPG BISSIG ;?
JRST BSEN0A ;NONE ISSUED
;OK - HOW MANY CHARACTERS CAN EDIT INST HANDLE
MOVE TC,BISASS ;CHARS BEFORE POINT
ADD TC,BISDOT ;POINT
ADD TC,BISCNT ;CHARS AFTER POINT
JUMPE TC,BSEN00 ;IF NONE FORGET IT
;OK PUT OUT THE FOLLOWING PATTERN STRING:
; SKPN+N,EXCHMD,FILL,...,("."/FILL),FILL,...,STOP
; THIS WILL GO BACK TO WHERE SIGNIFICANCE STARTED AND
; OVERWRITE IT IF THE VALUE OF THE STRING IS ZERO
ADDI TC,B.SKPN ;SKPN
ADDI TC,1 ;FOR EXCHMD,STOP
PUSHJ PP,BISSTO ;STORE SKIP
;NOW THE EXCHANGE
MOVEI TC,B.EXCH
PUSHJ PP,BISSTO ;STORE IT
;NOW THE CHARACTERS BEFORE THE DECIMAL POINT
MOVEI TC,B.MSG!BM.FIL ;FILL CHARACTER
SKIPE TE,BISASS ;GET COUNT
PUSHJ PP,BISSTO ;STORE CODE
SOJG TE,.-1 ;LOOP
;NOW THE DECIMAL POINT
PUSHJ PP,BISGT. ;GET CODE FOR DECMAL POINT
SKIPE BISFIL ;* OR Z ?
SKIPA TC,TE ;* - PUT DECIMAL POINT IN
MOVEI TC,B.MSG!BM.FIL ;Z - USE FILL CHARACTER
SKIPE BISDOT ;DO WE HAVE A DECIMAL POINT
PUSHJ PP,BISSTO ;YES STORE IT
;AFTER THE POINT
MOVEI TC,B.MSG!BM.FIL ;FILL CHARACTER
SKIPE TE,BISCNT ;GET NUMBER
PUSHJ PP,BISSTO ;STORE
SOJG TE,.-1 ;LOOP
;NOW GENERATE STOP FOR THE FILLING
MOVEI TC,B.STOP
PUSHJ PP,BISSTO
MOVE TE,BISBFS ;AMOUNT LEFT TO BWZ
JRST BSEN01
BSEN0A: SKIPE BISFIL ;IS IT * FILL CHAR?
JRST BSEN20 ;YES, PATTERN DONE, AND NO END CODE
SKIPN BISFLT ;NON-SPACE FOR FLOAT CHAR?
JRST BSEN00 ;NO, NORMAL PROCESSING
; BWZ PATTERN THAT DIDN'T GET FINAL CHAR. (E.G., PIC +++)
MOVEI TC,B.SKPN
PUSHJ PP,BISSTO
MOVEI TC,B.MSG!BM.FIL ;IF N FLAG OFF (IT MOVED 0) STORE THE FILL CHAR
PUSHJ PP,BISSTO
BSEN00: ;BWZ BUT NO SIGSET WAS EVER ISSUED
MOVE TE,BISCNT ;USE BISCNT
SKIPL BISSIG ;UNLESS SIGNIFICANCE WAS TURNED OFF
;THEN USE BISBFS
MOVE TE,BISBFS ;COUNT BEFORE SIGNIFICANCE WAS TURNED OFF
BSEN01: ;BWZ THAT EDIT INSTRUCTION CANNOT HANDLE
;GENERATE THE BWZ AFTER CODE IF NECESSARY
MOVEM TE,BISBW0 ;STORE NUMBER OF CHARS THAT EDIT INSTR
; COULD NOT BLANK FOR AFTER EDIT INSTR
; EXECUTION.
; FALL INTO BSEN20
BSEN20: ;NOW CHECK FOR LEADING SIGNS
SKIPLE BISSGN ;LEADING
TSWT FASIGN ;YES - BUT DO WE CARE
JRST BSEN21 ;FORGET IT
SETOM BISMIN ;REMEMBER TO GENERATE CODE FOR LEADING SIGN
JRST BSEN22
BSEN21: SKIPE TC,BISFLT ;IF THERE IS NO FLOAT CHAR
CAIN TC,DOLLAR ; OR IT IS A DOLLAR SIGN,
JRST BSEN22 ; GO ON.
CAMN TC,DOLLR.## ;[1446] OR IF IT IS A DEFINED CURRENCY SYMBOL
JRST BSEN22 ;[1446] GO ON
;FLOATING SIGN.
TSWT FASIGN ;DO WE CARE?
JRST BSEN22 ;NO.
;PUT OUT EXTRA PROGRAM TO INSERT FLOATING SIGN IF M.BIT SAYS SO
MOVE TE,[POINT 9,[BYTE (9)B.SKPM,B.STOP,B.EXCH,B.MSG!BM.MI]]
ILDB TC,TE
PUSHJ PP,BISSTO
CAIE TC,B.MSG!BM.MI
JRST .-3
BSEN22: ;DON'T WORRY ABOUT SIGNS
MOVEI TC,B.STOP ;STOP
PUSHJ PP,BISSTO ;STORE IT
JRST POPTC ;RESTORE TC AND RETURN
SUBTTL PATTERN GENERATION SUBROUTINES
SIGON: ;TURN SIGNIFICANCE ON IF NOT ALREADY ON
SKIPE BISSIG ;IS IT ON?
POPJ PP, ;YES - RETURN
PUSH PP,TC ;SAVE REGISTER
AOS BISSIG ;NO - SET ON FLAG
SETZM BISCNT ;DON'T CARE ABOUT NUMBER OF FLOATING
;PLACES
MOVEI TC,B.SIG ;SIGNIFICANCE ON PATTERN CODE
PUSHJ PP,BISSTO ;STORE IT
SKIPE BISFLT ;IS THERE A FLOAT CHARACTER?
AOS BISCNT ;YES- COUNT IT
JRST POPTC ;RESTORE TC AND RETURN
SIGOFF: ;TURN SIGNIFICANCE OFF IF NOT ALREADY OFF
SKIPN BISSIG ;IS IT OFF
POPJ PP, ;YES - RETURN
PUSH PP,TC ;NO - SAVE REGISTER
SETZB TC,BISSIG ;TURN OFF FLAG
EXCH TC,BISCNT ;GET COUNT BEFORE TURNING IT OFF AND
;CLEAR COUNTER
MOVEM TC,BISBFS ;SAVE INCASE OF BWZ
MOVEI TC,B.SEP ;SIGNIFICANCE OFF PATTERN CODE
PUSHJ PP,BISSTO ;STORE IT
JRST POPTC ;RESTORE TC AND RETURN
BISSTO: ; STORE TC IN PATTERN LITERAL
IDPB TC,TB ;STORE IN BUFFER REGISTER
TLNN TB,770000 ;IS IT FILLED?
PJRST BMSK2B ;YES - SEND IT TO LITERAL TABLE
POPJ PP, ;NO RETURN
BISGT.: ; RETURN THE CODE FOR THE DECIMAL POINT (IE. ","/".")
PUSH PP,TC ;SAVE
MOVEI TC,"." ;ARE WE REPRESENTING DECIMAL POINTS
CAMN TC,DCPNT. ;BY "." OR "," TODAY
SKIPA TE,[B.MSG!BM..] ; "."
MOVEI TE,B.MSG!BM.COM ; ","
JRST POPTC ;RESTORE TC AND RETURN
BISBWZ: ; DETERMINE IF B HAS REQUESTED BWZ
; AND SKIP RETURN IF SO
PUSH PP,TA ;SAVE REGS
PUSH PP,TB
MOVE TA,ETABLB ;GET B TABLE POINTER
LDB TB,LNKCOD ;GET TABLE TYPE
CAIE TB,TB.DAT ;DATTAB??
JRST BISBZ1 ;NO - FORGET IT
PUSHJ PP,LNKSET ;GET ENTRY ADDRESS
LDB TB,DA.BWZ## ;GET FLAG
SKIPE TB ;BWZ SET??
AOS -2(PP) ;YES, SKIP RETURN
BISBZ1: POP PP,TB ;RESTORE
POP PP,TA
POPJ PP, ;AND RETURN
;TABLES AND CODE PICTURE FOR DOING EDIT INSTR IN LINE
;
;
; CODE LOOKS LIKE:
;
; MOVE 5, [SOURCE BYTE-POINTER]
; MOVE 10, [DEST BYTE-POINTER]
; MOVE 4, [S.BIT,,PATTERN-ADDRESS]
; MOVEI 6, FILL-CHAR
; MOVEI 7, FLOAT-CHAR
; DMOVEM 6, E0+1 ;SET UP SPECIAL MESSAGE CHARS
; MOVEI 6, TRANSLATION TABLE ADDRESS
; HRRM 6, E0 ;SET UP TTA IN E0
; MOVEI 7, 6 ;REGISTER 6 IS THE MARK POINTER
; EXTEND 4, E0 ;DO THE EXTEND
; PUSHJ 17, XTND.E ;ERROR DURING EXTEND OPERATION
; PUSHJ 17, EDIT.B ;TO CHECK FOR EXTRA STUFF (TEMP)
;
;
; CODE THAT GETS GENERATED VARIES IF WE KNOW THAT IT IS
; SUBSCRIPTED, AND THERE IS BWZ OR LEADING SIGN.
; IN THOSE CASES, WE NEED THE BYTE POINTER TO THE BEGINNING
; OF B, AND WE DONT NEED (WANT) TO RECALCULATE IT. SO IF THE
; DESTINATION BYTE POINTER IS NOT A CONSTANT (IS SUBSCRIPTED)
; AC10 GETS SAVED IN A TEMPORARY:
; MOVE AC10, %TEMP ;SAVE BYTE POINTER FOR LATER
; TABLES NEEDED ARE FOR SPACES, DOLLAR SIGNS, ASTERISKS,
; PLUS SIGNS, MINUS SIGNS, AND SPACES FOR ALL THE MODES
; USE HALF WORD TABLES INDEXED BY MODE OF DEST OPERAND.
; ALSO NEED TABLE FOR TRANSLATION TABLES AND E0'S FOR
; THE DIFFERENT MODES. CODE FOR THE LARGE TABLE LOOKUP
; IS DERIVED BY USE OF FOLLOWING FORMULAE:
; CODE = <DEST-MODE> + <SRC-MODE>*3 + <EDIT-TYPE>*9
BISTB0: ;TRANSLATION TABLE ADDRESS IN LEFT HALF
;EFFECTIVE ADDRESS IN RIGHT HALF
;INDEXED BY CODE AS DEFINED ABOVE
XWD ALP.66##, E0.6##
XWD ALP.67##, E0.7##
XWD ALP.69##, E0.9##
XWD ALP.76##, E0.6##
XWD ALP.77##, E0.7##
XWD ALP.79##, E0.9##
XWD ALP.96##, E0.6##
XWD ALP.97##, E0.7##
XWD ALP.99##, E0.9##
XWD NUM.66##, E0.6##
XWD NUM.67##, E0.7##
XWD NUM.69##, E0.9##
XWD NUM.76##, E0.6##
XWD NUM.77##, E0.7##
XWD NUM.79##, E0.9##
XWD NUM.96##, E0.6##
XWD NUM.97##, E0.7##
XWD NUM.99##, E0.9##
BISTB1: ;DOLLAR SIGN IN LEFT HALF
;ASTERISK IN RIGHT HALF
;INDEXED BY MODE OF DEST OPERAND
XWD "$"-40, "*"-40 ;SIXBIT
XWD "$", "*" ;ASCII
XWD DL.9, AST.9 ;EBCDIC
BISTB2: ;PLUS SIGN IN LEFT HALF
;MINUS SIGN IN RIGHT HALF
;INDEXED BY MODE OF DEST OPERAND
XWD "+"-40, "-"-40 ;SIXBIT
XWD "+", "-" ;ASCII
XWD PL.9, MI.9 ;EBCDIC
;GARBAGE IN LEFT HALF
;SPACE IN RIGHT HALF
;INDEXED BY MODE OF DEST OPERAND
EXTERN IFSPCS ;SPACE TABLE IN IFGEN WE SHARE
BISTB3=IFSPCS
BISTB4: ;INSTRUCTION EFFECTIVE ADDRESS
;SAME AS BISTB1 EXCEPT ADDRESS IS GLOBAL+1
;REQUIRED FOR SEGMENTED PROGRAMS AS ADDITIVE GLOBALS WON'T WORK
DMOVM.+AC6,,E0.6.1##
DMOVM.+AC6,,E0.7.1##
DMOVM.+AC6,,E0.9.1##
;GENERATE CODE TO DO THE EDIT IN LINE
; WE KNOW THAT THERE IS INFORMATION IN SOME GLOBALS OF INTEREST
; EDITW2 CONTAINS ADDRESS OF PATTERN LITERAL IN LEFT HALF
; BISFLT CONTAINS ASCII OF THE FLOAT CHARACTER
; BISFIL CONTAINS ASTERISK OR ZERO (ASTERISK FILL OR NOT)
; BISALP CONTAINS 0 IF ALPHABETIC MOVE, 1 IF NUMERIC
BISCAL:
;FIRST CALL ROUTINE TO SET UP ACS 5 AND 10 WITH
; BYTE POINTERS TO THE OPERANDS. WE KNOW THAT
; THE ROUTINE WE ARE CALLING TAKES CARE OF ALL
; THE NASTY SUBSCRIPTING STUFF.
SETOM IBPFLG ;WE WANT INCREMENT BYTE POINTERS
PUSHJ PP, NB2PAR## ;NEW BUILD TWO PARAMETERS
;IF THE DESTINATION OPERAND IS SUBSCRIPTED, PRESERVE
; THE CALCULATED BYTE POINTER TO SAVE US GRIEF.
TSWT FBSUB ;IS B SUBSCRIPTED
JRST DONTSV ;NOPE, SKIP CODE TO SAVE AC
;WE ONLY NEED TO SAVE THE SUBSCRIPTED BYTE POINTER IF
; WE NEED TO DO FIX-UPS AFTER THE INSTRUCTION
; SO IF WE DONT BLANK WITH ZERO, AND WE DONT HAVE TO
; FIX LEADING MINUS, WE DONT SAVE THE AC
SKIPN BISBW0 ;DO WE BLANK WITH ZERO?
SKIPE BISMIN ;DO WE NEED LEADING MINUS
SKIPA ;EITHER WE BWZ OR WE NEED LEADING MINUS
JRST DONTSV ;NO NEED TO SAVE AC10
MOVE CH, [MOVEM.+AC10+ASINC,,AS.MSC] ;
PUSHJ PP, PUTASY ;
MOVEI TE, 1 ;ONLY ONE TEMP NEEDED
PUSHJ PP, GETEMP ;GET THE TEMP INTO EACC
HRRZM EACC, BISDST ;SAVE TEMP ADDR IN DEST
HRRZ CH, EACC ;
PUSHJ PP, PUTASN ;
DONTSV:
;NOW GENERATE THE LITERAL FOR AC4, AND A MOVE TO AC4
MOVE TA, [XWDLIT,,2] ;
PUSHJ PP, STASHP ;IN POOLED AREA
MOVE TA, [S.BIT,,AS.CNB] ;SPECIFY OCTAL CONSTANT
PUSHJ PP, STASHQ ;
MOVE TA, EDITW2 ;GET LIT ADDR OF PATTERN
PUSHJ PP, POOLIT ;
MOVSI CH, MOV+AC4 ;GET INSTRUCTION
PUSHJ PP, PUT.LD ;OUTPUT USING LATEST LITERAL
SKIPN PLITPC ;BUMP LITERAL COUNT IF NECESSARY
AOS ELITPC ;
;NOW SET UP FILL CHARACTER IN AC6. WE NEED TO TO TABLE
; LOOKUP FOR THE PROPER VALUE (MODE OF DEST OPERAND)
HRRZ TA, EMODEB ;GET DEST MODE IN AN AC
SKIPN BISFIL ;SKIP IF NOT BLANK FILL
SKIPA CH, BISTB3(TA) ;GET SPACE IN RH OF CH AND SKIP
HRRZ CH, BISTB1(TA) ;GET ASTERSISK INTO RH OF CH
HRRZ CH, CH ;JUST SAVE RH
CAIN CH, 0 ;IS IT A SIXBIT SPACE?
MOVEI CH, BL.6 ;YES, GET SPECIAL CODE THAT LOOKS
; LIKE NON-ZERO
HRLI CH, MOVEI.+AC6 ;GET INSTR IN LH OF CH
PUSHJ PP, PUTASY ;GENERATE INSTR
;NOW GET THE FLOAT CHARACTER INTO AC7.
; ASSUME TA HAS EMODEB
SKIPN CH, BISFLT ;FIRST, IS THERE A FLOAT CHAR?
JRST FLTCOM ;NO, USE ZERO (GO TO COMMON)
CAIN CH, DOLLAR ;IS THE FLOAT A DOLLAR SIGN?
JRST FLTDOL ;YEP, TABLE LOOK UP AND REJOIN COMMON
;GOT A FLOAT CHARACTER THAT IS NOT DOLLAR SIGN
CAIN TA, D6MODE ;SKIP IF NOT SIXBIT
SUBI CH, 40 ;IF SIXBIT CONVERT ASCII TO SIXBIT
CAIN CH, 0 ;IF ITS SIXBIT SPACE, WE NEED TO
MOVEI CH, BL.6 ; PUT SPECIAL CODE SO EDIT WILL WORK
CAIE TA, D9MODE ;SKIP IF EBCDIC, FOR MORE MODS
JRST FLTCOM ; ITS SIXBIT OR ASCII, GO TO COMMON
CAIE CH, "+" ;YES, EBCDIC, CONVERT IT FROM ASCII
SKIPA CH, [BL.9] ;GET NINE-BIT SPACE
MOVEI CH, PL.9 ;GET NINE-BIT PLUSS
SKIPA ;SKIP AROUND DOLLAR LOOKUP
FLTDOL: HLRZ CH, BISTB1(TA) ;GET THE CORRECT DOLLAR SIGN
FLTCOM: HRLI CH, MOVEI.+AC7 ;SET UP LH OF CH
PUSHJ PP, PUTASY ;GENERATE INSTRUCTION
;WE ARE DONE WITH ALL THE STUFF THAT ONLY NEEDS THE
; DESTINATION MODE. WE NOW NEED TO GENERATE INSTRUCTIONS
; THAT DEPEND UPON THE MODE OF BOTH OPERANDS.
; SO WE CALCULATE INTO TA THE INDEX INTO THE TABLE (BISTB0)
HRRZ TB, EMODEA ;GET SRC MODE
IMULI TB, 3 ;MULTIPLY BY THREE
ADD TA, TB ;ADD TO DEST MODE
SKIPE BISALP ;SKIP IF ALPHABETIC
ADDI TA, ^D9 ;ADD NINE TO GET TO SECOND HALF
;NOW MOVE THE TWO ACS 6 AND 7 TO THEIR DESTINATION.
; THE DEST IS E0+1 AND E0+2, AS THEY ARE MESSAGE CHARS.
PUSHJ PP, PUTASA ;SECOND OP CODE SET
TSWF FAS3 ;IN NON-RES SECTION?
JRST [MOVE CH,EMODEB ;YES, GET DESTINATION MODE
MOVE CH,BISTB4(CH) ;CANNOT USE ADDITIVE GLOBALS
PUSHJ PP,PUT.EX ;GENERATE LESS OBVIOUS EXTERNAL
JRST SETE0]
MOVSI CH, DMOVM.+AC6+ASINC ;
HRR CH, BISTB0(TA) ;GET ADDR OF E0 INTO RH OF CH
PUSHJ PP, PUT.EX ;GENERATE INSTR FOR EXTERNAL
MOVEI CH, 1 ;NOW WE GENERATE THE PLUS 1
PUSHJ PP, PUTASN ;
;WE ONLY HAVE TO MOVE THE TRANSLATION TABLE ADDRESS TO
; THE PROPER E0, SO GET THAT ADDRESS INTO AC6
SETE0:
IFE TOPS20,<
TSWT FREENT ;NO INDIRECT IF /R
>
IFN TOPS20,<
SKIPN RENSW## ;NO INDIRECT IF /R
>
SKIPA CH, [MOV+AC6,,0] ;GET THE OTS ADDRESS
MOVSI CH, MOVEI.+AC6 ;SET UP INSTR PART OF CODE
HLR CH, BISTB0(TA) ;SET UP ADDR PART
PUSHJ PP, PUT.EX ;GENERATE INSTRUCTION
;NOW MOVE AC6 TO E0.
PUSHJ PP, PUTASA ;SECOND OP CODE SET FOR HRRM
HRRZ CH, BISTB0(TA) ;GET E0 ADDRESS
HRLI CH, HRRM.+AC6 ;SET UP INSTR PART
PUSHJ PP, PUT.EX ;GENERATE INSTRUCTION
REPEAT 0,<
;NOW MOVE THE EDIT INSTR INTO REGISTER 6
; WE HAVE TO GENERATE IT FIRST
MOVE TA, [XTNLIT,,1] ;INSTRUCTION LITERAL
PUSHJ PP, STASHP ;
HRRZ TA, EMODEB ;GET BACK THE MODE
HLRZ TA, BISTB0(TA) ;SET UP ADDR
HRLI TA, (EDIT @) ;SET UP THE INSTRUCTION
PUSHJ PP, POOLIT ;NOT PUT IT IN LITERAL TABLE
HRRZ TA, EMODEB ;RESTORE TA
;NOW MOVE THE LITERAL INTO AC6
MOVSI CH, MOV+AC6 ;PUT INSTR IN LH
PUSHJ PP, PUT.LD ;GENERATE INSTR USING LATEST LITERAL
SKIPN PLITPC ;BUMP LIT COUNT IF NECESSARY
AOS ELITPC ;
;NOW MOVE AC6 TO E0.
HRRZ CH, BISTB0(TA) ;GET E0 ADDRESS
HRLI CH, MOVEM.+AC6 ;SET UP INSTR PART
PUSHJ PP, PUT.EX ;GENERATE INSTRUCTION
>
;NOW SET UP AC7 WITH ADDRESS OF MARK POINTER.
; IN THIS CASE THE MARK POINTER WILL BE AC6
MOVE CH, [MOVEI.+AC7,,6]
PUSHJ PP, PUTASY ;GENERATE INSTRUCTION
;NOW THE EXTEND (OF E0)
PUSHJ PP, PUTASA ;SECOND OP CODE SET
MOVSI CH, XTND.##+AC4 ;GET INSTR
HRR CH, BISTB0(TA) ;GET E0 ADDR
PUSHJ PP, PUT.EX ;GENERATE INSTR
;NOW THE ERROR CALL TO LIBOL IF EXTEND FAILS
PUSHJ PP, PUTASA
MOVE CH, [ERROR.##+AC17,,XTND.E##]
PUSHJ PP, PUT.EX ;
;NOW LOOK AT FLAGS TO SEE IF ANY CLEAN-UP IS NECESSARY AFTER
; THIS EDIT INSTRUCTION.
SKIPN BISBW0 ;SEE IF WE NEED ZERO TEST FOR BLANKING
JRST CHKMIN ;NOPE, CHECK FOR INSERT LEADING MINUS
;FALL THRU TO CODE TO GENERATE BLANK WITH ZERO
; THAT COULD NOT BE HANDLED BY THE EDIT INSTR
;GENERATE CODE TO LOOK AT THE N.BIT OF THE FLAG AC.
; WE KNOW THAT THE DESTINATION OPERAND WANTS TO BE BLANK
; WHEN ZERO, AND THAT THE EDIT INSTRUCTION WAS NOT ABLE TO
; ASSURE THAT ALL THE FIELD WAS BLANKED OUT (IF THE OPERAND
; WAS ZERO). SO WE GENERATE CODE TO CHECK THE FLAG AND
; TO FILL IN THE DESTINATION STRING.
; WE KNOW THAT THE LEADING CHARACTERS (THE ONES WE WANT TO
; OVERWRITE) ARE ALL ASTERISKS OR ZEROS. THERE WAS A CHECK EARLIER
; (SEE BSEN01:) TO PROVE THAT.
; IF THE DESTINATION ITEM WAS SUBSCRIPTED, BISDST CONTAINS
; THE TEMP ADDRESS IN THE GENERATED CODE THAT CONTAINS THE
; BYTE POINTER TO THE DESTINATION ARGUMENT. BISBW0 CONTAINS
; THE NUMBER OF CHARACTERS TO FILL IN FROM THE BEGINNING.
; WE SPECIAL CASE THE ONE AND TWO CHARACTER FILLS, SINCE THE
; CODE IS BETTER USING IDPB'S INSTEAD OF MOVSLJ.
;
; CODE GENERATED IF THERE ARE MORE THAN TWO CHARS:
; TLNE AC4, N.BIT ;TEST FOR NON ZERO
; JRST .+6 ;NON-ZERO, SKIP CODE
; SETZB AC4, AC5 ;ZERO THE SOURCE
; MOVEI AC7, NCHARS ;SET UP THE COUNT OF CHARS
; MOVE AC10, LIT/TEMP ;GET BEGINNING OF DST STR
; EXTEND AC4, [MOVSLJ
; FILL-CHAR] ;DO EXTEND, FILLING
; PUSHJ PP, XTND.E ;ERROR CALL
;
; CODE GENERATED IF THE DESTINATION IS SUBSCRIPTED:
; TLNE AC4, N.BIT ;TEST FOR NON ZERO
; JRST .+2+BISBW0 ;SKIP THE BLANKING CODE
; MOVEI AC4, FILL-CHAR ;SET UP FILL, ZERO AC4 LH
; IDPB AC4, %TEMP ;DEPOSIT THE CHARS
; <OPTIONAL SECOND IDPB>
;
; CODE GENERATED IF THE DEST STRING IS NOT SUBSCRIPTED AND
; THERE IS ONLY ONE CHAR:
; TLNE AC4, N.BIT ;TEST FOR NON-ZERO
; JRST .+3 ;SKIP BLANKING CODE
; MOVEI AC4, FILL-CHAR ;SET UP FILL, ZERO LH OF AC4
; DPB AC4, LIT ;FILL THE DEST
;
; CODE GENERATED IF DEST STR NOT SUB AND 2 CHARS:
; TLNE AC4, N.BIT ;TEST FOR NON-ZERO
; JRST .+5 ;SKIP BLANKING CODE
; MOVEI AC4, FILL-CHAR ;SET UP FILL, ZERO LH OF AC4
; MOVE AC5, LIT ;GET DEST BYTE POINTER
; IDPB AC4, AC5 ;STORE FIRST BLANK
; IDPB AC4, AC5 ;STORE SECOND
;GENERATE THE TEST INSTRUCTION OF THE N.BIT
MOVE CH, [TLNE.+AC4+ASINC,,AS.CNB] ;SET UP INSTR
PUSHJ PP, PUTASY ;
MOVEI CH, N.BIT ;SET UP RH OF INSTR
PUSHJ PP, PUTASN ;
;GENERATE THE JRST AROUND THE MOVSLJ
MOVE CH, [JRST.+ASINC,,AS.MSC] ;
PUSHJ PP, PUTASY ;
;TEST THE SIZE TO DETERMINE HOW MUCH TO JRST
MOVE CH, BISBW0 ;GET SIZE INTO REGISTER
CAIGE CH, 3 ;FOR THREE AND MORE, NORMAL
JRST ONETWO ;SPECIAL CASE FOR ONE OR TWO BYTES
MOVEI CH, AS.DOT+6 ;WE WANT JRST .+6
PUSHJ PP, PUTASN ;
;ZERO THE SOURCE
MOVE CH, [SETZB.+AC4,,5] ;
PUSHJ PP, PUTASY ;
;SET UP COUNT OF DEST
MOVSI CH, MOVEI.+AC7 ;SET UP INSTR AND AC
HRR CH, BISBW0 ;GET THE COUNT OF CHARS
PUSHJ PP, PUTASY ;GENERATE INSTRUCTION
;GET THE BYTE POINTER INTO AC10
; TEST TO SEE IF ITS SUBSCRIPTED. IF NOT, USE POOLED
; LITERAL ALREADY GENERATED, ELSE USE TEMP.
TSWF FBSUB ;TEST TO SEE IF B SUBSCRIPTED
JRST YESSUB ;YEP, GO GET OTHER CODE
;GENERATE LITERAL (ALREADY MADE, BUT NO HANDLE. SHOULD USE
; POOLED LITERAL)
MOVE TA, [BYTLIT,,2] ;GENERATE BYTEPOINTER TO A
PUSHJ PP, STASHP ; IN POOLED AREA (FIND IT AGAIN)
PUSHJ PP, MBYTPB ;USE COMMON CODE TO DO WORK
PUSHJ PP, POOL ;CAUSE POOLING ACTION
MOVSI CH, MOV+AC10 ;MOVE TO AC10
PUSHJ PP, PUT.LD ;LAST LITERAL
SKIPN PLITPC ;CHECK THAT IT WAS POOLED
PUSHJ PP, KILL## ; IF NOT WE ARE IN TROUBLE
JRST ONWARD ;SKIP OTHER CODE, GET TO COMMON STUFF
;B IS SUBSCRIPTED, USE THE TEMP.
YESSUB: MOVE CH, [MOV+AC10+ASINC,,AS.MSC] ;
PUSHJ PP, PUTASY ;
MOVE CH, BISDST ;GET THE PLACE IT IS STORED
PUSHJ PP, PUTASN ;
ONWARD:
;NOW THAT THE ACS ARE SET UP, GENERATE THE EXTEND
; FIRST GENERATE THE LITERAL FOR THE EXTEND
MOVE TA, [XTNLIT,,1]
PUSHJ PP, STASHP ;IN THE POOLED LITERAL AREA
MOVSI TA, (MOVSLJ) ;NOW GET THE EXTEND INSTR ITSELF
PUSHJ PP, STASHQ ; INTO THE POOLED AREA
MOVE TA, [OCTLIT,,1] ;NOW OCTAL FOR THE FILL CHAR
PUSHJ PP, STASHP ;
HRRZ TA, EMODEB ;GET DEST MODE
SKIPN BISFIL ;SKIP IF NOT BLANK FILL
SKIPA TA, BISTB3(TA) ;GET SPACE OF DEST OPERAND (AND SKIP)
MOVE TA, BISTB1(TA) ;GET ASTERISK OF DEST OPERAND
HRRZ TA, TA ;CLEAR UP TA
PUSHJ PP, POOLIT ;GENERATE LITERAL
PUSHJ PP, PUTASA ;EXTEND IS IN SECOND OP CODE SET
MOVSI CH, XTND.+AC4 ;NOW THE ACTUAL INSTR
PUSHJ PP, PUT.LD ;USE LAST LITERAL
MOVE TA, ELITPC ;INCREMENT THE LIT COUNT
ADDI TA, 2 ;TWO WORD LITERAL GENERATED
SKIPN PLITPC ; ONLY IF NECESSARY
MOVEM TA, ELITPC ;
;NOW GENERATE THE CALL TO ERROR ROUTINE FOR FAILURES
PUSHJ PP, PUTASA
MOVE CH, [ERROR.+AC17,,XTND.E] ;
PUSHJ PP, PUT.EX ;
;NOW GO TO THE CHECK FOR LEADING MINUS CODE
JRST CHKMIN ;
;SPECIAL CASE ROUTINE FOR GENERATING MOVEI AC4, FILL-CHAR
; ONLY INCLUDED SINCE IT IS USED IN THREE SEPARATE PLACES,
; AND MIGHT AS WELL BE POOLED.
MVI4FL: HRRZ CH, EMODEB ;SET UP DEST MODE FOR TABLE LOOK-UP
SKIPN BISFIL ;SKIP IF NOT BLANK FILL
SKIPA CH, BISTB3(CH) ;GET SPACE OF DEST OPERAND (AND SKIP)
MOVE CH, BISTB1(CH) ;GET ASTERISK OF DEST OPERAND
HRLI CH, MOVEI.+AC4 ;SET UP LH OF CH WITH INSTR
PJRST PUTASY ;GENERATE THE INSTRUCTION
;SPECIAL CASE BLANKING OF LEADING SPACES THAT THE EDIT INSTR COULD
; NOT HANDLE. SEE PREVIOUS PAGES FOR CODE PICTURES.
; WE BELIEVE THAT "CH" CONTAINS NUMBER OF CHARS, AND THAT THE
; JRST HALF OF THE INSTR HAS BEEN GENERATED. WE MERELY NEED TO
; GENERATE AN AS.DOT+N TO PUTASN.
ONETWO: TSWT FBSUB ;CHECK FOR SUBSCRIPTED ITEM
JRST ONE2NS ;ONE-TWO, NOT SUBSCRIPTED
;CH HAS NUMBER OF CHARS, GENERATE THE RH OF THE JRST
ADDI CH, AS.DOT+2 ;ADD FLAGS FIELD AND EXTRA INSTRS
PUSHJ PP, PUTASN ;JRST .+N COMPLETE.
;NOW GENERATE THE MOVE TO AC4 OF THE FILL CHAR.
; REMEMBER THAT WE USE AC4 TO CLEAR OLD FLAG BITS
; SO THAT LEADING MINUS WONT POSSIBLY BE SET
HRRZ CH, EMODEB ;GET DEST MODE
PUSHJ PP, MVI4FL ;GENERATE MOVEI AC4, FILL-CHAR
;NOW GENERATE THE CORRECT NUMBER OF IDPB'S
MOVE TA, BISBW0 ;GET NUMBER OF TIMES TO IDPB
MOVE CH, [IDPB.+AC4+ASINC,,AS.MSC] ;
PUSHJ PP, PUTASY ;
MOVE CH, BISDST ;GET THE TEMP ADDRESS
PUSHJ PP, PUTASN ;
SOJG TA, .-4 ;LOOP FOR SECOND IDPB
;NOW JOIN COMMON CODE LOOKING FOR LEADING MINUS PROBLEMS
JRST CHKMIN
;CODE TO HANDLE NON-SUBSCRIPTED CASE. TWO DIFFERENT CODE
; PICTURES. ONE FOR ONE CHAR, THE OTHER FOR TWO CHARS.
ONE2NS: CAIE CH, 1 ;TEST FOR ONE CHAR CASE
JRST ONE2N2 ;ONETWO NOT SUBSCRIPTED, TWO CHARS
;ONE CHAR. WE NEED TO MERELY GENERATE DPB
; FIRST REMEMBER TO COMPLETE THE JRST .+N
MOVEI CH, AS.DOT+3 ;WE WANT TO SKIP THREE CHARS
PUSHJ PP, PUTASN ;ALL DONE WITH THE JRST
;NOW GET THE FILL CHAR
PUSHJ PP, MVI4FL ;GENERATE MOVEI AC4, FILL-CHAR
;NOW GENERATE LITERAL TO FIRST CHAR OF THE STRING
; IN THE POOLED LITERALS AREA OF GENERATED CODE.
; THEN A DEPOSITE BYTE OF AC4 TO THAT LITERAL.
PUSHJ PP, DPB4LT ;USE POOLED CODE FROM CHKMIN
;NOW GO TO THE CODE TO CHECK ON LEADING MINUS
JRST CHKMIN
;THIS CODE GENERATES NON-SUBSCRIPTED CASE, TWO CHARS
ONE2N2: CAIE CH, 2 ;SPECIAL CASE CHECK
PUSHJ PP, KILL## ; SO WE DONT GET LOST
;FIRST FINISH THE JRST OF .+N FOR THE RIGHT AMOUNT
MOVEI CH, AS.DOT+5 ;WE WANT .+5
PUSHJ PP, PUTASN ;FINISH THE JRST
;NOW GENERATE THE MOVE TO AC4 OF THE FILL CHAR
PUSHJ PP, MVI4FL ;USE COMMON CODE
;NOW GENERATE BYTE POINTER TO BEGINNING OF DEST,
; COMPLAIN IF NOT POOLED (IT BETTER BE)
; AND THEN MOVE IT INTO AC5 (ANY AC WILL DO).
MOVE TA, [BYTLIT,,2] ;GENERATE BYTEPOINTER TO A
PUSHJ PP, STASHP ; IN POOLED AREA (FIND IT AGAIN)
PUSHJ PP, MBYTPB ;USE COMMON CODE TO DO WORK
PUSHJ PP, POOL ;CAUSE POOLING ACTION
MOVSI CH, MOV+AC5 ;MOVE TO AC5
PUSHJ PP, PUT.LD ; USINGLAST LITERAL
SKIPN PLITPC ;CHECK THAT IT WAS POOLED
PUSHJ PP, KILL## ; IF NOT WE ARE IN TROUBLE
;NOW GENERATE THE ILDB'S UP TO TWO.
MOVE TA, BISBW0 ;GET THE COUNT
MOVE CH, [IDPB.+AC4,,5] ;GET THE INSTR
PUSHJ PP, PUTASY ;GENERATE THE INSTRUCTION
SOJG TA, .-1 ;GO BACK FOR SECOND ONE
;NOW FALL THRU THE CHKMIN TO LOOK FOR LEADING MINUS SIGNS
;CODE TO PUT A LEADING MINUS SIGN ON THE DESTINATION OPERAND
; IF IT IS NEGATIVE. WE DETERMINE IF IT WAS NEGATIVE BY LOOKING
; AT THE M.BIT IN THE FLAG AC. IF IT WAS NEGATIVE, WE GENERATE A
; DEPOSIT BYTE TO PLACE THE MINUS SIGN THERE. NOTE THAT
; THE BLANK WITH ZERO IS DONE FIRST AND LEAVES AC4 (IN THE
; GENERATED CODE) ZERO. THUS THE TEST WILL FAIL AND NO
; LEADING SIGN WILL BE REPLACED.
; CODE GENERATED:
; TLNN AC4, M.BIT ;SKIP IF MINUS
; JRST .+3 ;SKIP OVER CODE
; MOVEI AC4, MINUS-SIGN ;GET THE CHARACTER
; DPB AC4, LIT ;PUT CHAR AWAY
;
; THE LAST INSTRUCTION WILL BE DIFFERENT IF THE DESTINATION
; OPERAND WAS SUBSCRIPTED, AS THE SET-UP CODE FOR THE EDIT
; WILL HAVE SAVED THE DESTINATION BYTE POINTER IN A TEMP
; THIS SAVES A SECOND SUBSCRIPT CALCULATION.
; THE CODE WILL LOOK LIKE:
; TLNN AC4, M.BIT ;SKIP IF MINUS
; JRST .+3 ;SKIP OVER CODE
; MOVEI AC4, MINUS-SIGN ;GET THE CHARACTER IN AN AC
; IDPB AC4, TEMP ;STORE MINUS SIGN
CHKMIN: SKIPN BISMIN ;ONLY DO THIS IF NECESSARY
POPJ PP, ;NOT NECESSARY. GO BACK TO CALLER
;GENERATE THE BIT TEST
MOVE CH, [TLNN.+AC4+ASINC,,AS.CNB] ;GET INSTR
PUSHJ PP, PUTASY ;
MOVEI CH, M.BIT ;NOW GET BIT INTO RH OF INSTR
PUSHJ PP, PUTASN ;
;NOW GENERATE THE JRST AROUND THE MINUS-SETTING CODE
MOVE CH, [JRST.+ASINC,,AS.MSC] ;THE INSTR HALF
PUSHJ PP, PUTASY ;
MOVEI CH, AS.DOT+3 ;THE PLACE TO GO IF NO MINUS SIGN
PUSHJ PP, PUTASN ;
;NOW GET THE CHARACTER INTO AC4
MOVSI CH, MOVEI.+AC4 ;SET UP LEFT HALF OF CODE
HRRZ TA, EMODEB ;GET MODE OF DESTINATION
HRR CH, BISTB2(TA) ;GET CORRECT MINUS SIGN
PUSHJ PP, PUTASY ;GENERATE INSTRUCTION
;BEGIN BRANCHING FOR SEPARATE GENERATED CODE DEPENDING
; WHETHER THE SECOND OPERAND WAS SUBSCRIPTED. EITHER
; USE THE TEMP OR GENERATE A LITERAL TO MAKE BETTER CODE.
TSWF FBSUB ;SKIP IF NOT SUBSCRIPTED
JRST BSMNSB ;BIS MINUS SUBSCRIPT SPECIAL CASE
;NORMAL CASE
; THERE IS A LABEL HERE SINCE WE USE THIS EXACT CODE ELSEWHERE
; THE ONLY RESTRICTION IS THAT IT BE DPB AC4, DEST, INTO THE
; FIRST BYTE OF DEST (DPB BYTE POINTER, NOT IDPB)
DPB4LT: MOVE TA, [BYTLIT,,2] ;GENERATE BYTE POINTER TO B IN LITTAB
PUSHJ PP, STASHP ; IN THE POOLED AREA
SETOM MAKBPB## ;WE WANT LDB BYTE POINTER
PUSHJ PP, MBYTPB ;USE COMMON CODE
PUSHJ PP, POOL ;CAUSE POOLING ACTION
MOVSI CH, DPB.+AC4 ;SET UP LH OF INSTR
PUSHJ PP, PUT.LD ;GENERATE INSTR USING LATEST LITERAL
SKIPN PLITPC
AOS ELITPC ;BUMP LITERAL COUNT OF NECESSARY
POPJ PP, ;RETURN TO CALLER (DOBISM)
BSMNSB: ;BIS MINUS SUBSCRIPT SPECIAL CASE
; GENERATE INSTR TO USE TEMP. DONT WORRY ABOUT SAVING IT.
; WE DONT USE IT AGAIN.
MOVE CH, [IDPB.+AC4+ASINC,,AS.MSC] ;SET UP INSTR
PUSHJ PP, PUTASY ;
MOVE CH, BISDST ;CONTAINS TEMP ADDR OF DST BYT PTR
PJRST PUTASN ;
;THATS ALL FOLKS-- NO START ADDRESS
END ;BISGEN.MAC