Trailing-Edge
-
PDP-10 Archives
-
cobol12c
-
movgen.mac
There are 21 other files named movgen.mac in the archive. Click here to see a list.
; UPD ID= 3568 on 6/4/81 at 2:45 PM by NIXON
TITLE MOVGEN FOR COBOL V12C
SUBTTL GENERATORS FOR "MOVE" VERB AL BLACKINGTON/CAM
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
;
;KWS 04-Oct-84 [1546] Fix move of literal 000.0 to pic 999v9
;JSM 19-DEC-83 [1512] At MNXAC2 specify the "FROM" address of
; the MOVN instruction.
;
;JEH 15-DEC-83 [1510] At MLAC1., don't use ac TD, it's needed later
;JEH 28-NOV-83 [1507] Make handling of figurative constants more
; consistent
;JEH 28-NOV-83 [1506] Trigger FIPS Flagger on figurative constant
; extensions
;JEH 10-OCT-83 [1500] Warning if high or low values to numeric field
;JEH 06-Jun-83 [1473] Don't produce truncation warnings on RPW line/pg
; counters
;DMN 24-Feb-83 [1453] Make MSERA. internal.
;DMN 8-Dec-82 [1442] Fix MOVE of Separate Sign Display item to 1-word COMP.
;RLF 18-OCT-82 [1421] MAKES LEFT TRUNCATION IF SIGNED NUMERIC IS MOVED
; TO SMALLER AND RIGHT JUSTIFIED ALPHA FIELD.
;SMI 28-SEP-82 [1410] FIX ILL MEM REF IN PHASE G IF DATA ITEM
; IN LINKAGE SECTION > 100000 CHARACTERS
;RLF 05-AUG-82 [1377] GIVES WARNING ON TRUNCATION
;RJD 28-JUN-82 [1371] Display destination name on truncation warning
;JEH 05-MAY-82 [1353] If literal > max, give error and exit LITD.
;JEH 16-FEB-82 [1341] ELIMINATE EXTRA WARNING ON IMMEDIATE FIELDS
;JEH 12-FEB-82 [1337] GENERATE CODE FOR MOVE OF LITERAL TO 1 CHAR
; EDITED FIELD
;RJD 08-FEB-82 [1336] CONVERT MODES FOR INDEX AND COMP-3 FIELDS
;JEH 05-NOV-81 [1324] NON-BIS MOVE OF FIELD > 3770 FAILS
;JSM 14-OCT-81 [1323] FLAG RIGHT TRUNC ON EDITED ALPHA-NUM FIELDS
;
;V12B ****************
;DMN 9-Jan-81 [1113] COMP-1 to COMP-2 conversion not setting new mode.
;DAW 17-Nov-80 [1075] "?Bad LITAB code" generating numeric literals
;DMN 26-SEP-80 [1056] MAKE INTERNAL COMP-2 TO COMP-1 CONVERSION ROUTINE.
;DAW 31-JUL-80 [1043] ANS68 MOVE NON-NUMERIC TO NUM EDITED
;DAW 31-JUL-80 [1042] FIX COMPUTE ID = ID1 / (10 ** ID-2)
;DMN 11-JUN-80 [1025] ALLOW RANDOM AND ISAM FILES AS SORT INPUT FILES.
;DMN 1-APR-80 [1004] MAKE ASCII & EBCDIC COLLATING SEQUENCES WORK.
;DMN 25-MAR-80 [1000] GENERATE NUL LITERAL FOR MOVE TO BAD DATA-ITEM.
;DMN 31-JAN-80 [766] 1-WORD COMP WITH "ON SIZE ERROR" SOMETIMES MOVES WRONG ACC.
;DMN 30-JAN-80 [764] FIX SPURIOUS ERRORS ON MOVE OF TRAILING SEPARATE SIGN
;DAW 31-OCT-79 [755] FIX BUG IN EDIT 745 - IT BROKE ACCEPT OF
; SMALL NUMERIC ITEMS
;DAW 15-OCT-79 [745] FIX MOVE FROM ACS WITH NON-COMP DEPENDING
; VARIABLE (ANS74 ONLY)
;DMN 21-SEP-79 [736] FIX TYPO IN BISCMP CODE FOR COMP-1 TO COMP-2 CONVERSION
;DMN 7-SEP-79 [731] FIX DIVIDE A BY B WHERE B IS 2-WORD COMP.
;DMN 7-SEP-79 [730] MAKE CUTC2C INTERNAL
;V12A SHIPPED
;DMN 14-AUG-79 [724] FIX ERROR IN EDIT 722.
;DMN 26-JUL-79 [722] COBOL-74 FIX MOVE HIGH/LOW-VALUES WITH PROGRAM COL. SEQ.
;DMN 2-APR-79 [673] MAKE ADJ4C. AND CUTC4 INTERNAL FOR QUAD-ROUNDING
;DAW 19-MAR-79 [664] FIX MULTIPLY WITH 4-WORD INTERMEDIATE PROBLEM
;DAW 6-MAR-79 [654] FIX BAD CODE GENERATED SOMETIMES FOR MOVE OF
; ITEM WITH TWO OR MORE SUBSCRIPTS.
;DMN 26-FEB-79 [636] FIX RANDOM POPJ WITH PROGRAM WITH MANY FATAL ERRORS
;DAW 20-FEB-79 [634] FIX BAD CODE GENERATED FOR STORING A 4-WORD ITEM
;DMN 22-JAN-79 [626] FIX MOVE OF 3 CHAR EBCDIC FIG-CONST (COBOL-68 ONLY)
;DMN 4-JAN-79 [621] GIVE ERROR ON "MOVE ALL" <DIGIT> TO NUMERIC
;DAW 11-OCT-78 [575] FIX "MOVE ALL 'A' TO DISPLAY-ITEM (SUBSCRIPTED)".
;DMN 6-OCT-78 [567] FIX DECIMAL POINT ALLIGNMENT IN QUAD-WORD MULTIPLIES
;DAW 4-OCT-78 [564] FIX BUG IN EDIT 537 - NON-BIS ONLY PROBLEM
;EHM 13-JUN-78 [537] FIX "SUBSCRIPTED MOVE WITH "A" IN ACS!!"
;EHM 12-JUN-78 [536] FIX MOVE OF COMP ITEM TO DISPLAY TO ONLY
;MOVE THE NUMBER OF CHARACTERS IN THE COMP PIC
;V12 SHIPPED
; EHM 11-APR-77 [466] FIX COMPUTE WITH FLOATING DIVIDE IF ANS ROUNDED
;V11 SHIPPED
; 7-APR-76 [424] DONT ATTEMPT TO BUILD LITERAL OF ZERO SIZE
; 2-APR-76 [416] FIX SUBSCRIPTED OR LINKAGE SECTION MOVES
;JC 16/2/76 [371] FIX MOVE "TODAY"
;ACK 21-APR-75 MOVE EBCDIC TO/FROM OTHER FLAVORS OF DISPLAY.
;ACK 22-APR-75 START ON EBCDIC FIGURATIVE CONSTANTS.
;DBT 4/20/75 FIX BMASK TO ACCEPT NEW MASK FORMAT FROM
; PSCAN WITH REPEAT FIELDS
;DBT 5/5/75 GENERATE BIS PATTERNS FOR EDIT.B ROUTINE
;********************
;**; EDIT 303 FIX MOVES OF NUMERIC LITERALS
;**; EDIT 301 FIX MOVE OF SINGLE-WORD LITERAL TO2-WORD COMP
;**; EDIT 167 FIXES LITERAL TABLE OVERFLOW PROBLEM BY CALCULATING THE
; LITERAL SIZE AND STORING IT INTO THE HEADER WORD BEOFORE
; THE HEADER WORD IS STASHED INTO LITERAL TABLE.
;**; EDIT 160 GIVE APPLICABLE TRUNCATION WARNINGS FOR MOVES TO EDITTED ITEMS
;**; EDIT 147 FIXES MOVE ALL TO SUBSCRITPED ITEM.
TWOSEG
.COPYRIGHT ;Put COPYRIGHT statement in .REL file.
RELOC 400000
SALL
ENTRY MOVGEN ;ENTERED WHEN MOVE VERB SEEN BY PHASE E
INTERNAL MOVGN. ;GENERATE A MOVE FOR A SINGLE PAIR OF OPERANDS
INTERNAL MXX. ;MOVE AFTER OPERANDS SET UP
INTERNAL MDD. ;MOVE DISPLAY TO DISPLAY
INTERNAL MDC. ;MOVE DISPLAY TO COMP
INTERNAL M1C1C. ;MOVE 1-WORD COMP TO 1-WORD COMP
INTERNAL M1C2C. ;MOVE 1-WORD COMP TO 2-WORD COMP
INTERNAL M1CD. ;MOVE 1-WORD COMP TO DISPLAY
INTERNAL M2C1C. ;MOVE 2-WORD COMP TO 1-WORD COMP
INTERNAL M2C2C. ;MOVE 2-WORD COMP TO 2-WORD COMP
INTERNAL M2CD. ;MOVE 2-WORD COMP TO DISPLAY
INTERNAL MXTMP. ;MOVE AN ITEM TO A TEMP FOR "DISPLAY"
INTERNAL MXAC. ;MOVE SOMETHING TO AC'S
INTERNAL MNXAC. ;MOVE NEGATIVE OF SOMETHING TO AC'S
INTERNAL MDAC. ;MOVE DISPLAY ITEM TO AC'S
INTERNAL M1CAC. ;MOVE 1-WORD COMP ITEM TO AC'S
INTERNAL M2CAC. ;MOVE 2-WORD COMP ITEM TO AC'S
INTERNAL MFPAC. ;MOVE FLOATING POINT ITEM TO AC'S
INTERNAL MXFPA. ;MOVE SOMETHING TO AC'S & CONVERT TO COMP-1
INTERNAL MXF2A. ;MOVE SOMETHING TO AC'S & CONVERT TO COMP-2
INTERNAL MACX. ;MOVE SOMETHING FROM THE AC'S
INTERNAL ADJDP. ;ADJUST DECIMAL PLACES OF A COMP ITEM
INTERNAL ADJDPA ;SAVE AMOUNT OF ADJUSTMENT FOR FUTURE REFERENCE
INTERNAL ADJ1C. ;ADJUST DECIMAL PLACES OF 1-WORD COMP
INTERNAL ADJ2C. ;ADJUST DECIMAL PLACES OF 2-WORD COMP
INTERNAL CC1C2. ;CONVERT A 1-WORD COMP (IN AC'S) TO 2-WORD COMP
INTERNAL CCXFP. ;CONVERT COMP TO FLOATING-POINT
INTERNAL CCXF2. ;CONVERT COMP TO D.P. FLOATING-POINT (COMP-2)
INTERNAL CFPCX. ;CONVERT FLOATING POINT TO 2-WORD COMP
INTERNAL ADJLIT ;ADJUST LITERAL TO MATCH DECIMAL PLACES IN "B"
INTERNAL MSFP%L ;CREATE A COMP-1 LITERAL, PUT IT INTO %LIT
INTERNAL MSF2%L ;CREATE A COMP-2 LITERAL, PUT IT INTO %LIT
INTERNAL LITD. ;CREATE A NON-NUMERIC DISPLAY LITERAL
INTERNAL LITN. ;CREATE A NUMERIC DISPLAY LITERAL
INTERNAL LITN.A ;CREATE A NUMERIC DISPLAY LITERAL AFTER SCANL EXECUTED
INTERNAL MLVD. ;[1025] MOVE LOW-VALUES TO SOMETHING
INTERNAL MSX. ;MOVE SPACES TO SOMETHING
INTERNAL MZC1. ;MOVE ZEROES TO 1-WORD COMP
INTERNAL MZC2. ;MOVE ZEROES TO 2-WORD COMP
IFN BIS,<
INTERNAL ADJ4C.,CUTC4,CUTC2C ;[730] [673]
>
INTERNAL CF2FP. ;[1056] CONVERT COMP-2 TO COMP-1
INTERN MSERA. ;[1453] GIVE TRUNCATION WARNING MESSAGE
EXTERNAL CURSIZ ;SIZE OF LITERAL
EXTERNAL CMNGEN ;COMMON ROUTINES
EXTERNAL KILL,BADEOP
EXTERNAL PUTASY,PUTASN,PUTAS1
EXTERNAL SETOPA,SETOPB,SETOPN,GETEMP,CONVNL,CONVFP,CONVF2
EXTERNAL STASHP,STASHQ,POOLIT,PVALIT,PVLIT2
EXTERNAL AZRJ.,ASRJ.,AQRJ.,SZERO.,SQUOT.,FPLOV.
EXTERNAL M.IA,M.IB,SCANL,GENFPL,GENF2L,BMPEOP,DPDIV.,ADJSL.,SWAPAB
EXTERNAL LNKSET,XPNLIT,WARN,FATAL,WARNAD,OPNFAT,OPNWRN,OPFAT,NOTNUM
EXTERNAL FORCX0,NEGATL,SUBSCR,BYTE.A,BYTE.B,BYTE.C
EXTERNAL SUBSCA,SUBSCB,SUBSCE,GETTAG,PUTTAG,B1PAR,B2PAR
EXTERNAL PUTEMP,SWAPEM
EXTERNAL PUT.A,PUT.AA,PUT.B,PUT.BA,PUT.L,PUT.LA,PUT.LB,PUT.LC,PUT.LD
EXTERNAL PUT.P,PUT.PA,PUT.PC,PUT.XA,PUT.XB
EXTERNAL BISALP,BISINI,BSTRAN,BSEND
EXTERNAL DA.LKS,DA.ARG,DA.RBE,DA.SON,DA.NOC
EXTERNAL CPOPJ1,CPOPJ
EXTERNAL DEPCKK,DEPTSA,DEPTSB
IFN ANS74,<
EXTERNAL COLSEQ,COHVLV,SLVAL.,SHVAL.,ESHIVL,ESLOVL,EELOW ;[722]
EXTERNAL AHRJ.,ALRJ.,EAHRJ,EALRJ ;[722]
>
;ENTRY POINT FROM COBOLE FOR "MOVE" VERB.
;SET UP THE OPERAND PARAMETERS, AND CALL "MOVGN." UNTIL ALL OPERANDS ARE USED UP.
; IF THERE ARE MORE THAN 2 OPERANDS, WE MUST MOVE "A" TO A TEMP
;BEFORE DOING ANY OTHER MOVES! THEN MAKE %TEMP THE "A" OPERAND
; FOR THE MOVES. (THIS WAS CLARIFIED IN THE ANS74 STANDARD - ANS68
;STANDARD DOESN'T SPECIFY EITHER WAY.
MOVGEN: MOVE EACA,EOPNXT
CAMN EACA,EOPLOC ;ANY OPERANDS?
JRST BADEOP ;NO--ERROR
MOVEM W1,OPLINE ;SAVE OPERATOR'S LN&CP
HRRZ TA,EOPLOC ;SET "CUREOP" TO FIRST OPERAND
ADDI TA,1
MOVEM TA,CUREOP
IFN ANS74,<
SETOM EDEBDA## ;POSSIBLE DEBUG CODE WANTED
HLLZS EDEBDA ;BUT ONLY IF DB.ARO IS ON (-1,,0 IS FLAG)
>
;SEE IF MORE THAN 2 OPERANDS.. IF SO, MOVE "A" TO A TEMP.
SETZ TC, ;TC= COUNT OF "B" OPERANDS
CHKM2O: PUSHJ PP,BMPEOP ;GET ANOTHER OPERAND
TRNA ; NO MORE, SEE HOW MANY THERE WERE
AOJA TC,CHKM2O ;COUNT THEM
JUMPE TC,NOMVS ;IF NO "B" OPERANDS AT ALL, COMPLAIN
HRRZ TA,EOPLOC ;SET "CUREOP" UP AGAIN
ADDI TA,1
MOVEM TA,CUREOP
CAIN TC,1 ;JUST 1 "B" OPERAND? (USUAL CASE)
JRST MOVGN0 ;YES
;MORE THAN ONE DESTINATION. MOVE "A" TO A TEMP AND MAKE IT THE NEW "A".
HRRZ TC,TA ;SETUP "A" OPERAND
PUSHJ PP,SETOPA ; RETURN ONE LEVEL DOWN IF ERRORS
; (BACK TO PHASE E DRIVER)
; IF "A" IS A FIG. CONST OR LITERAL, DON'T HAVE TO DO IT.
HRRZ TE,EMODEA ;GET MODE
CAIE TE,FCMODE ;FIG. CONST?
CAIN TE,LTMODE ; OR LITERAL?
JRST MOVGN0 ;YES, DO IT THE OLD WAY
IFN ANS68,<
; CHECK FOR TALLY. AND DON'T MOVE TO A TEMP FIRST IF IT IS.
; (NOT ONLY IS THERE NO NEED FOR IT, BUT SINCE ETABLA IS 0
; FOR TALLY IT GETS A "BAD TABLE-LINK"!)
HRRZ TE,EBASEA ;CHECK FOR TALLY.
CAIN TE,TALLY.## ;IS IT?
JRST MOVGN0 ;YES, DON'T MOVE TO A TEMP FIRST
>;END IFN ANS68
; WE WILL SETUP %TEMP TO LOOK JUST LIKE A DATA ITEM WITH THE
;EXACT SAME PARAMETERS AS "A". IF "A" IS NUMERIC WE WILL DO
;A NUMERIC MOVE TO %TEMP, IF ALPHANUMERIC, AN ALPHANUMERIC
;MOVE, IF EDITED, AN ALPHANUMERIC MOVE.
; SET "OPERND" TO BE A,,A
HRRZ TC,EOPLOC
ADDI TC,1
HRL TC,TC
MOVEM TC,OPERND
PUSHJ PP,MAT.TP ;** MOVE IT TO %TEMP **
POPJ PP, ;ERROR.. JUST RETURN
;NOW "A" OPERAND POINTS TO THE %TEMP, "B" POINTS TO ORIGINAL "A"
MOVE TE,[EBASEA,,ESAVTT] ;SAVE AWAY 'A' PARAMETERS
BLT TE,ESAVTX ; IN THE TEMP SAVE AREA.
SETOM AINTEM ;REMEMBER 'A' IS IN %TEMP
MOVGN0: PUSHJ PP,BMPEOP ;GET NEXT "B" OPERAND
JRST MOVGDN ;NO MORE--QUIT
IFN ANS74,<
SETOM EDEBDB## ;POSSIBLE DEBUG CODE WANTED
>
HRRZ TA,EOPLOC ;RESET "TA" TO "A" OPERAND
ADDI TA,1
HRRZ TC,CUREOP ;SET "TC" TO "B" OPERAND
PUSHJ PP,MOVGN. ;DO A SINGLE MOVE
HRRZ TE,OPERND ;MAKE SURE CUREOP IS RIGHT
MOVEM TE,CUREOP
IFN ANS74,<
PUSHJ PP,CDEBAB## ;COPY DEBUG CODE IF REQUIRED
>
JRST MOVGN0 ;LOOP UNTIL DONE
MOVGDN: SETZM AINTEM ;CLEAR 'A' IN %TEMP
IFN ANS74,<
PJRST GDEBV## ;GO GENERATE DEBUG CODE IF REQUIRED
>
IFN ANS68,<
POPJ PP,
>
;HERE IF NO DESTINATIONS
NOMVS: OUTSTR [ASCIZ/?No "B" operands in MOVE
/]
POPJ PP, ;COMPLAIN, BUT KEEP COMPILING
;SET UP THE NEXT MOVE
MOVGN.: SWOFF FEOFF1 ;TURN OFF SOME FLAGS
HRL TA,TC ;SET "OPERND" AS <XWD A-OP,B-OP>
MOVSM TA,OPERND
;SET UP "B" OPERAND
PUSHJ PP,SETOPB
HRRZ TE,EMODEB ;IS IT
CAIE TE,FCMODE ; FIG. CONST.
CAIN TE,LTMODE ; OR LITERAL?
JRST [OUTSTR [ASCIZ /Literal B operand in MOVE.
/]
POPJ PP,] ;YES-OOPS.
MOVE TA,ETABLB
LDB TE,LNKCOD
CAIE TE,TB.DAT
JRST MOVGN4
PUSHJ PP,LNKSET
LDB TE,DA.JST ;IS IT
SKIPN TE ; JUSTIFIED RIGHT?
TDCA TD,TD ;NO--BIT 0 _ 0
HRLZI TD,1B18 ;YES--BIT 0 _ 1
IORM TD,EMODEB
LDB TE,DA.EDT ;IS IT EDITED
LDB TD,DA.BWZ ; OR 'BLANK
IORI TE,(TD) ; WHEN ZERO'?
JUMPE TE,MOVGN4
MOVEI TD,EDMODE ;YES--SET NEW MODE
HRRM TD,EMODEB
LDB TE,DA.CLA ;IS IT
CAIN TE,2 ; NUMERIC?
SWON FBNUM ;YES
;SET UP NEXT MOVE (CONT'D).
;SET UP "A" OPERAND PARAMETERS
MOVGN4: HLRZ TC,OPERND ;GET ADDRESS OF "A"
PUSHJ PP,SETOPA
SKIPN AINTEM ;IS "A" IN %TEMP?
JRST MOVG4A ;NO
MOVE TA,[ESAVTT,,EBASEA] ; USE SAVED PARAMETERS
BLT TA,EBASAX
SWOFF FASUB; ;NOT SUBSCRIPTED IF IN %TEMP
MOVG4A: MOVE TA,ETABLA ;IS IT A DATA-ITEM?
LDB TE,LNKCOD
CAIE TE,TB.DAT
JRST MOVGN5 ;NO
PUSHJ PP,LNKSET
LDB TE,DA.LPC## ;[1473] Is source a RPW line/page ctr?
JUMPE TE,MOVG4B ;[1473] No
MOVE TE,ESIZEB ;[1473] Yes, don't want a truncation warning
CAIGE TE,^D10 ;[1473] but don't make it larger
MOVEM TE,ESIZEA ;[1473]
MOVG4B: LDB TE,DA.EDT ;IS IT
JUMPE TE,MOVGN5 ; EDITED?
LDB TE,DA.EXS ;YES--USE EXTERNAL SIZE
MOVEM TE,ESIZEA
SETZM EDPLA ;IGNORE DECIMAL PLACES
;MOVE ANYTHING TO ANYTHING
;"A" AND "B" PARAMETERS HAVE BEEN SET UP
MOVGN5: SETZM EAC
SWOFF FEOFF2 ;TURN OFF SOME FLAGS
IFN ANS74,<
PUSHJ PP,GRPMOV ;SEE IF ITS A GROUP MOVE
>
HRRZ TA,EMODEA ;IS "A" A LITERAL?
CAIN TA,LTMODE
JRST MXX. ;YES
CAIN TA,FCMODE ;NO--FIG. CONST?
JRST MXX.6 ;YES
;CHECK FOR VALIDITY OF MOVE
MOVEI LN,EBASEB
PUSHJ PP,MOVG5A
MOVEI TB,1
LSH TB,0(TC)
MOVEI LN,EBASEA
PUSHJ PP,MOVG5A
TDNE TB,CLASST(TC)
JRST NOTNUM
CAIE TB,4 ;WAS 'B' NUMERIC?
SKIPG EDPLA ;NO--DOES 'A' HAVE DECIMAL PLACES?
JRST MOVGN7 ;NO--ALL IS WELL
CAIN TB,100 ;WAS 'B' NUMERIC-EDITED?
JRST MOVGN7 ;YES--THAT'S OK TOO
IFN ANS74,<
MOVE TA,EBASEB ;[FCCTS NC105]
PUSHJ PP,LNKSET
LDB TE,DA.SON ;SEE IF GROUP MOVE
JUMPN TE,MOVGN7 ;YES, SO ITS OK
>
HLRZ TC,OPERND ;SETUP CUREOP SO 'A' OPERAND
MOVEM TC,CUREOP ; GETS POINTED AT
JRST NODPL ;DECIMAL PLACES TO NON-NUMERIC--ERROR
MOVG5A:
IFN ANS68,<
HRRZ TA,EBASEX(LN)
CAIN TA,TALLY.##
JRST MOVG5B
>
MOVE TA,ETABLX(LN)
PUSHJ PP,LNKSET
LDB TC,DA.CLA
LDB TE,DA.EDT
SKIPE TE
IORI TC,4
POPJ PP,
IFN ANS68,<
MOVG5B: MOVEI TC,2
POPJ PP,
>
;SEE IF A GROUP MOVE - IF SO MAKE IT ALPHANUMERIC
IFN ANS74,<
GRPMOV: MOVE TA,ETABLA
LDB TE,LNKCOD
CAIE TE,TB.DAT
POPJ PP, ;NOT A DATANAME
PUSHJ PP,LNKSET
LDB TD,DA.SON ;SEE IF GROUP ITEM
MOVE TA,ETABLB
LDB TE,LNKCOD
CAIN TE,TB.DAT
SKIPN TA,EBASEB
POPJ PP,
PUSHJ PP,LNKSET
LDB TE,DA.SON ;SAME FOR "B"
XOR TE,TD ;SEE IF BOTH THE SAME TYPE
JUMPE TE,CPOPJ ;YES, GRP - GRP, OR ELIM - ELIM
SETZM EDPLB ;FIX UP "B"
LDB TD,DA.EXS## ;USE EXTERNAL SIZE
MOVEM TD,ESIZEB
LDB TD,DA.USG## ;GET USAGE
SUBI TD,1
CAIN TD,IXMODE ;[1336] INDEX MODE?
MOVEI TD,D1MODE ;[1336] YES -- SET IT TO 1-WORD COMP
CAIN TD,%US.C3-1 ;[1336] COMP-3 MODE?
MOVEI TD,C3MODE ;[1336] YES -- USE INDEX'S SLOT
HRRM TD,EMODEB ;RESET IT TO SIXBIT,ASCII OR EBCDIC ONLY
MOVE TA,ETABLA ;SETUP POINTER AGAIN
PUSHJ PP,LNKSET
SETZM EDPLA ;FIXUP "A"
LDB TD,DA.EXS## ;USE EXTERNAL SIZE
MOVEM TD,ESIZEA
LDB TD,DA.USG## ;GET USAGE
SUBI TD,1
CAIN TD,IXMODE ;[1336] INDEX MODE?
MOVEI TD,D1MODE ;[1336] YES -- SET IT TO 1-WORD COMP
CAIN TD,%US.C3-1 ;[1336] COMP-3 MODE?
MOVEI TD,C3MODE ;[1336] YES -- USE INDEX'S SLOT
MOVEM TD,EMODEA ;RESET IT TO SIXBIT,ASCII OR EBCDIC ONLY
SWOFF FBNUM ;TURN OFF NUMERIC FLAG
POPJ PP,
>
;SET UP NEXT MOVE (CONT'D).
;SEE IF A ZERO WILL RESULT
MOVGN7: HRRZ TE,EMODEA ;IS EITHER "A" OR "B" COMP-1?
HRRZ TD,EMODEB
CAIE TE,FPMODE
CAIN TD,FPMODE
JRST MXX. ;YES--NO CHECK
CAIE TE,F2MODE ;OR COMP-2
CAIN TD,F2MODE
JRST MXX. ;YES--NO CHECK
SKIPN EDPLA ;DOES "A" HAVE ANY DECIMAL PLACES?
JRST MOVGN8 ;NO
SKIPE EDPLB ;YES--DOES "B"?
JRST MXX. ;YES
MOVE TE,ESIZEA ;NO--DOES "A" HAVE ANY INTEGRAL PLACES?
CAMLE TE,EDPLA
JRST MXX. ;YES
JRST MOVGN9 ;NO--RESULT HAS TO BE ZERO
MOVGN8: MOVE TE,ESIZEB ;DOES "B" HAVE ANY INTEGRAL PLACES?
CAMLE TE,EDPLB
JRST MXX. ;YES--OK
;RESULT WILL ALWAYS BE ZERO
MOVGN9: HRRZ TA,EMODEB
ROT TA,-1
TLNE TA,1B18
SKIPA TA,MZTAB(TA)
MOVS TA,MZTAB(TA)
MOVE TE,ESIZEB
MOVEM TE,ESIZEZ
PUSHJ PP,(TA)
JRST NOSIZ.
;MOVE ANYTHING TO ANYTHING
;DISPATCH TO SOME ROUTINE
MXX.: PUSHJ PP,EXMAB## ;PUT "A" AND "B" SUBSCRIPTS INTO %TEMP
; IF NECESSARY
HRRZ TA,EMODEA
CAIN TA,FCMODE
JRST MXX.6
HRRZ TB,EMODEB
CAIGE TB,LTMODE
CAILE TA,LTMODE
JRST BADCOD
LSH TA,2 ;ENTRANCE ADDRESS IS MOVT.(4*EMODEA+EMODEB/2)
ROT TB,-1
ADDI TA,(TB)
TLNE TB,1B18
SKIPA TC,MOVT.(TA)
MOVS TC,MOVT.(TA)
JRST (TC)
;A-OPERAND IS A FIGURATIVE CONSTANT.
MXX.6: HRRZ TA,EMODEB
CAILE TA,7 ;LEGAL MODE?
JRST BADCOD ;NO--TROUBLE
IFN FT68274,<
MOVE TE,EFLAGA ;GET WHAT "A" IS
CAIN TE,5 ;IS IT LOW-VALUES?
PUSHJ PP,TSTKEY ;YES, SEE IF IT IS SOME KIND OF FILE KEY
HRRZ TA,EMODEB
>
ROT TA,-1
MOVE TE,EFLAGA
ADD TA,FCTAB(TE)
MXX.6A: TLZE TA,1B18 ;WAS MODE ODD?
SKIPA TC,0(TA) ;YES--USE RIGHT-HALF
MOVS TC,0(TA) ;NO--USE LEFT-HALF
MOVE TA,ESIZEB
MOVEM TA,ESIZEZ
IFN ANS74,<
SKIPE FLGSW## ;[1506] IF FIPS NEEDED
JRST MXX.6B ;[1506] PERFORM FOLLOWING TESTS
>; END ANS74
MOVE TA,EFLAGA ;[1500] GET THE TYPE OF FIG CON.
CAIL TA,3 ;[1507][1500] 3 = QUOTE., 4 = HIVAL.
CAIL TA,6 ;[1507][1500] 5 = LOVAL.
JRST (TC)
MXX.6B: HRRZ TA,EBASEB ;[1506][1500] IS DESTINATION A DATAB ITEM?
LDB TB,LNKCOD ;[1500]
CAIE TB,CD.DAT ;[1500]
JRST (TC) ;[1500] NO, ERROR CAUGHT ELSEWHERE
PUSHJ PP,LNKSET ;[1500]
LDB TB,DA.CLA ;[1500] GET ITS CLASS
CAIE TB,%CL.NUM ;[1500] IT'S NOT NUMERIC, SO
JRST (TC) ;[1500] CONTINUE WITH 'MOVE' INSTRUCTION
LDB TB,DA.USG ;[1500] GET ITS USAGE
HRRZ TA,EFLAGA ;[1506] AND TYPE OF FC
CAIN TA,3 ;[1507] IS IT QUOTE.?
JRST BADFIG ;[1507] YES, NOT IN NUMERIC FIELDS
IFN ANS74,<
CAIG TB,DSMODE ;[1506] IF "B" (DEST) IS DISPLAY MODE, NUMERIC
CAIN TA,2 ;[1506] AND "A" IS NOT ZERO
JRST MXX.6C ;[1506]
SKIPN FLGSW## ;[1506] AND FIPS FLAGGING
JRST MXX.6C ;[1506]
PUSH PP,TC ;[1506] SAVE ROUTINE ADDRESS
MOVE TC,CUREOP ;[1506] GET "B" OPERAND ADDRESS
MOVE TC,(TC) ;[1506] GET FIRST WORD OF OPERAND PAIR
LDB LN,TCLN ;[1506] LOAD LINE NBR
LDB CP,TCCP ;[1506] LOAD CP
MOVEI TA,%LV.NS ;[1506] SET NON-STANDARD FLAGGING
PUSHJ PP,FLG.ES## ;[1506] CALL FLAGGER ROUTINE
POP PP,TC ;[1506] RESTORE TC
HRRZ TA,EFLAGA ;[1506] RESTORE TA
MXX.6C: CAIE TA,4 ;[1506] IF FIGURE CONSTANT IS HI-VALUES
CAIN TA,5 ;[1506] OR LOW-VALUES
SKIPA ;[1506] SKIP
JRST (TC) ;[1506]
>; END ANS74
MXX.6D: HRRZI DW,E.657 ;[1506][1500] GENERAL TYPE WARNING
CAIE TA,4 ;[1500] HIGH-VALUES?
JRST MXX.6E ;[1506][1500] NO
HRRZI DW,E.655 ;[1500] YES
CAILE TB,%US.DS ;[1500] AND NON-DISPLAY?
HRRZI DW,E.656 ;[1500] YES
MXX.6E: PUSH PP,TC ;[1506][1500] SAVE TC
PUSHJ PP,OPNWRN ;[1500] PRINT OUT WARNING
POP PP,TC ;[1500] RESTORE TC
JRST (TC) ;[1500] CONTINUE ON
;TABLE OF ENTRANCE POINTS TO "MOVE" ROUTINES.
MOVT.: XWD MDD.,MDD. ;S-S,S-A
XWD MDD.,MDC. ;S-E,S-1C
XWD MDC.,MDC.1 ;S-2C,S-F
XWD MDC.,MDED. ;S-C3,S-EDIT
XWD MDD.,MDD. ;A-S,A-A
XWD MDD.,MDC. ;A-E,A-1C
XWD MDC.,MDC.1 ;A-2C,A-FP
XWD MDC.,MDED. ;A-C3,A-EDIT
XWD MDD.,MDD. ;E-S,E-A
XWD MDD.,MDC. ;E-E,E-1C
XWD MDC.,MDC.1 ;E-2C,E-FP
XWD MDC.,MDED. ;E-C3,E-EDIT
XWD M1CD.,M1CD. ;1C-S,1C-A
XWD M1CD.,M1C1C. ;1C-E,1C-1C
XWD M1C2C.,M1CFP. ;1C-2C,1C-FP
XWD M1CC3.,MCED. ;1C-C3,1C-EDIT
XWD M2CD.,M2CD. ;2C-S,2C-A
XWD M2CD.,M2C1C. ;2C-E,2C-1C
XWD M2C2C.,M2CFP. ;2C-2C,2C-FP
XWD M2CC3.,MCED. ;2C-C3,2C-EDIT
XWD MFPD.,MFPD. ;F-S,F-A
XWD MFPD.,MFP1C. ;F-E,FP-1C
XWD MFP2C.,MFPFP. ;FP-2C,FP-FP
XWD MFPC3.,MCED. ;FP-C3,F-EDIT
XWD MC3D.,MC3D. ;C3-S,C3-A
XWD MC3D.,MDC. ;C3-E,C3-1C
XWD MDC.,MDC.1 ;C3-2C,C3-FP
XWD MDC.,MCED. ;C3-C3,C3-EDIT
XWD BADCOD,BADCOD ;CAN'T MOVE FROM EDITED (CHANGED TO SIXBIT OR ASCII)
XWD BADCOD,BADCOD
XWD BADCOD,BADCOD
XWD BADCOD,BADCOD
XWD MLD.,MLD. ;LIT-S,LIT-A
XWD MLD.,ML1C. ;LIT-E,LIT-1C
XWD ML2C.,MLFP. ;LIT-2C,LIT-FP
XWD MLC3.,MLED. ;LIT-C3,LIT-EDIT
;MOVE SOMETHING TO THE AC'S.
;PARAMETERS HAVE ALREADY BEEN SET UP.
MXAC.: HRRZ TE,EBASEA ;IS IT ALREADY
CAIG TE,17 ; IN AC'S?
JRST MXAC.0 ;YES
MXAC.T:: ;COME HERE TO GET TODAY INTO THE AC'S AS A BINARY
; NUMBER, OTHERWISE THE ABOVE CODE WILL PREVENT GETTING
; IT SINCE IT IS ALREADY THERE, BUT IS DISPLAY-6 NOT
; COMP.
HRRZ TE,EMODEA ;NO--IS TYPE
CAILE TE,F2MODE ; IN RANGE?
JRST BADCOD ;NO
PUSHJ PP,@MXAC.1(TE)
MXAC.0: SWON FASIGN;
SWOFF FASUB;
POPJ PP,
MXAC.1: EXP MDAC. ;SIXBIT
EXP MDAC. ;ASCII
EXP MDAC. ;EBCDIC
EXP M1CAC. ;1-WORD COMP
EXP M2CAC. ;2-WORD COMP
EXP MFPAC. ;FLOATING POINT
EXP MC3AC. ;COMP-3.
EXP BADCOD ;EDITED
EXP MLTAC. ;LITERAL
EXP MFCAC. ;FIG. CON.
EXP BADCOD ;4-WORD COMP
EXP MF2AC. ;COMP-2
;"A" IS A FIGURATIVE CONSTANT.
MFCAC.: HRRZ TE,EFLAGA
CAIN TE,ZERO
JRST BADCOD
MXAC.3: SWON FALWY0 ;AC'S ARE ZERO
MOVSI CH,SETZB. ;GENERATE
HRR CH,EAC ; <SETZB AC,AC+1>
DPB CH,CHAC
AOJA CH,PUTASY
;MOVE SOMETHING FROM AC'S.
;PARAMETERS HAVE ALREADY BEEN SET UP.
MACX.: TSWF FALWY0 ;ARE AC'S ZERO?
JRST MACX.1 ;YES
TSWT FBSUB ;SKIP IF "B" IS SUBSCRIPTED
JRST MACX00 ;NO
SETOM ONLYEX## ;YES--GET SUBSCRIPTS INTO %TEMP IF NECESSARY
SETOM IBPFLG##
PUSHJ PP,SUBSCB## ;THIS ALLOWS US TO USE AC'S 4 AND 5 BEFORE
SETZM ONLYEX## ;THE SUBSCR CALL
SETZM IBPFLG##
MACX00: HRRZ TE,EMODEA
MACX01: SUBI TE,D1MODE
IMULI TE,F2MODE+1
MACX.0: ADD TE,EMODEB
CAIGE TE,<C3MODE-D1MODE+1>*<F2MODE+1> ;IS IT IN FIRST SET?
JUMPGE TE,@MACX.T(TE)
SUBI TE,<D4MODE-C3MODE-1>*<F2MODE+1> ;NO, IS IT IN SECOND SET?
CAIGE TE,<F2MODE-D1MODE-D4MODE+C3MODE+2>*<F2MODE+1>
JUMPGE TE,@MACX.T(TE)
JRST BADCOD ;NO
MACX.T: EXP MACD. ;1C-S
EXP MACD. ;1C-A
EXP MACD. ;1C-E
EXP MAC1C. ;1C-1C
EXP M1C2CA ;1C-2C
EXP MACFP. ;1C-FP
EXP M1CC3A ;1C-C3
EXP MACE. ;1C-ED
EXP BADCOD ;1C-LT
EXP BADCOD ;1C-FG
EXP BADCOD ;1C-4C
EXP MACF2. ;1C-F2
EXP MACD. ;2C-S
EXP MACD. ;2C-A
EXP MACD. ;2C-E
EXP M2C1CC ;2C-1C
EXP MAC2C. ;2C-2C
EXP MACFP. ;2C-FP
EXP M2CC3A ;2C-C3
EXP MACE. ;2C-ED
EXP BADCOD ;2C-LT
EXP BADCOD ;2C-FG
EXP BADCOD ;2C-4C
EXP MACF2. ;2C-F2
EXP MACFD. ;FP-S
EXP MACFD. ;FP-A
EXP MACFD. ;FP-E
EXP MFP1CA ;FP-1C
EXP MFP2CA ;FP-2C
EXP MAC1C2 ;FP-FP
EXP MFPC3A ;FP-C3
EXP MACE. ;FP-ED
EXP BADCOD ;FP-LT
EXP BADCOD ;FP-FG
EXP BADCOD ;FP-4C
EXP MAFPF2 ;FP-F2
EXP MACD. ;C3-S
EXP MACD. ;C3-A
EXP MACD. ;C3-E
EXP MACX.2 ;C3-1C
EXP MACX.2 ;C3-2C
EXP MACFP. ;C3-FP
EXP MACX.2 ;C3-C3
EXP MACE. ;C3-ED
EXP BADCOD ;C3-LT
EXP BADCOD ;C3-FG
EXP BADCOD ;C3-4C
EXP BADCOD ;C3-F2
EXP MACD. ;4C-S
EXP MACD. ;4C-A
EXP MACD. ;4C-E
EXP M2C1CC ;4C-1C
EXP MAC2C. ;4C-2C
EXP MACFP. ;4C-FP
EXP M2CC3A ;4C-C3
EXP MACE. ;4C-ED
EXP BADCOD ;4C-LT
EXP BADCOD ;4C-FG
EXP MAC44. ;4C-4C
EXP MACF2. ;4C-F2
EXP MACFD. ;F2-S
EXP MACFD. ;F2-A
EXP MACFD. ;F2-E
EXP MFP1CA ;F2-1C
EXP MFP2CA ;F2-2C
EXP MAF2FP ;F2-FP
EXP MFPC3A ;F2-C3
EXP MACE. ;F2-ED
EXP BADCOD ;F2-LT
EXP BADCOD ;F2-FG
EXP BADCOD ;F2-4C
EXP MACF2. ;F2-F2
MACX.1: HRRZ TA,EMODEB
CAILE TA,7
JRST BADCOD
ROT TA,-1
ADDI TA,MZTAB
JRST MXX.6A
;MOVE THE (FORMERLY) COMP-3 ITEM IN THE AC'S TO A COMP ITEM.
MACX.2: MOVE TE, ESIZEA ;IS IT ONE OR TWO WORDS?
CAIG TE, ^D10
TDZA TE, TE ;ONE WORD - PRETEND IT'S COMP-1.
MOVEI TE, 1 ;TWO WORDS - PRETEND IT'S COMP-2.
JRST MACX.0 ;GO DISPATCH.
;GET NEGATIVE OF "A" INTO THE AC'S
MNXAC.: HRRZ TE,EMODEA
CAIG TE,F2MODE ;IS MODE WITHIN RANGE?
JUMPGE TE,@MNXACT(TE)
JRST BADCOD
MNXACT: EXP MNXAC1 ;SIXBIT
EXP MNXAC1 ;ASCII
EXP MNXAC1 ;EBCDIC
EXP MN1CAC ;1-WORD COMP
EXP MN2CAC ;2-WORD COMP
EXP MNFPAC ;COMP-1
EXP MNXAC1 ;COMP-3
EXP BADCOD ;EDITED
EXP MNLTAC ;LITERAL
EXP BADCOD ;FIG. CON.
EXP BADCOD ;4-WORD COMP
EXP MNF2AC ;COMP-2
MNXAC1: PUSHJ PP,MXAC.
HRRZ TE,EMODEA
CAIE TE,D1MODE
CAIN TE,FPMODE
JRST MNXAC2
IFE BIS,<
MOVSI CH,NEG.##
JRST MNXAC3
>
IFN BIS,<
PUSHJ PP,PUTASA
MOVSI CH,DMOVN.##
PUSHJ PP,PUT.XA ;[1131]
JRST MNXAC8 ;[1131]
>
MNXAC2: MOVSI CH,MOVN.
HRR CH,EAC ;[1512] Specify FROM address of MOVN.
MNXAC3: PUSHJ PP,PUT.XA
JRST MNXAC9
MNFPAC:
MN1CAC: TSWT FASIGN;
JRST MNXAC1
PUSHJ PP,SUBSCA
MOVSI CH,MOVN.
PUSHJ PP,PUT.AA
JRST MNXAC9
MNF2AC:
MN2CAC: TSWT FASIGN;
JRST MNXAC1
PUSHJ PP,SUBSCA
IFE BIS,<
MOVSI CH,NEG.
>
IFN BIS,<
PUSHJ PP,PUTASA
MOVSI CH,DMOVN.
>
PUSHJ PP,PUT.A
IFN BIS,< ;[1131] GENERATE CODE TO SET SIGN BIT
MNXAC8: MOVSI CH,SKPGE. ;[1131] IN AC+1 SAME AS SIGN BIT IN
HRR CH,EAC ;[1131] AC AFTER "DMOVN"
PUSHJ PP,PUTASY ;[1131] "SKIPGE 0,EAC"
MOVE CH,[TLO.+ASINC,,AS.CNB] ;[1131]
PUSHJ PP,PUT.XB ;[1131]
MOVEI CH,400000 ;[1131]
PUSHJ PP,PUTASN ;[1131] "TLO EAC+1,400000"
> ;[1131]
MNXAC9: SWON FASIGN;
SWOFF FASUB;
POPJ PP,
BADCOD: MOVEI DW,E.276
JRST OPFAT
;MOVE A LITERAL TO AC'S.
;IF LITERAL HAS FEWER DECIMAL PLACES THAN "B", ADJUST LITERAL.
MLTAC.: HRRZ TE,EMODEB
CAIN TE,FPMODE
JRST MLTAC6
CAIN TE,F2MODE
JRST MLTAC8
MOVEI LN,EBASEA
PUSHJ PP,CONVNL
TSWF FERROR;
POPJ PP,
JUMPN TD,MLTAC1 ;IF LITERAL IS
JUMPN TC,MLTAC1 ; ZERO,
SWON FALWY0 ;NO CODE GENERATED
POPJ PP,
MLTAC1: HRRZ TE,EMODEB
CAIE TE,LTMODE
CAIN TE,FCMODE
JRST MLTAC4
MOVE TE,EDPLB
SUB TE,EDPLA
MOVEI LN,EBASEA
PUSHJ PP,ADJSL.
MOVE TE,ESIZEB
MLTAC5: CAILE TE,^D10
JRST MLTAC2
JUMPN TD,MLTAC2
MOVEI TE,D1MODE
MOVEM TE,EMODEA
MOVSI CH,MOV##
TSWF FLNEG;
MOVSI CH,MOVN.
JRST PUT.LA
;MOVE LITERAL TO AC'S (CONT'D).
;LITERAL HAS A SIZE GREATER THAN 10 DIGITS
MLTAC2: TSWF FLNEG;
PUSHJ PP,NEGATL
MLTAC3: SKIPN TD
JUMPE TC,MXAC.3
MOVE TA,[XWD D2LIT,2]
PUSHJ PP,STASHP
MOVE TA,TD
PUSHJ PP,STASHQ
MOVE TA,TC
PUSHJ PP,POOLIT
SKIPE TE,PLITPC ;DID WE POOL?
JRST .+4 ;YES
MOVEI TE,2
EXCH TE,ELITPC
ADDM TE,ELITPC
IORI TE,AS.LIT
MOVEM TE,EINCRA
HRRZI TE,AS.MSC
MOVEM TE,EBASEA
MOVEI TE,D2MODE
MOVEM TE,EMODEA
JRST M2CAC.
MLTAC4: MOVE TE,ESIZEA
JRST MLTAC5
;MOVE LITERAL TO AC'S (CONT'D).
;FLOATING POINT REQUIRED
MLTAC6: PUSHJ PP,MSFP%L
MLTAC7: MOVEI TE,FPMODE
MOVEM TE,EMODEA
MOVE CH,[XWD MOV+ASINC,AS.MSC]
PUSHJ PP,PUT.XA
MOVEI CH,(TC)
JRST PUTASN
MLTAC8: PUSHJ PP,MSF2%L
MLTAC9: MOVEI TE,F2MODE
MOVEM TE,EMODEA
PUSHJ PP,PUTASA
MOVE CH,[XWD DMOVE.##+ASINC,AS.MSC]
PUSHJ PP,PUT.XA
MOVEI CH,(TC)
JRST PUTASN
;MOVE NEGATIVE OF A LITERAL TO THE AC'S.
MNLTAC: HRRZ TE,EMODEB
CAIN TE,FPMODE
JRST MNLAC3
CAIN TE,F2MODE
JRST MNLAC4
MOVEI LN,EBASEA
PUSHJ PP,CONVNL
TSWF FERROR;
POPJ PP,
MOVE TE,EDPLA
SUB TE,EDPLB
MOVEI LN,EBASEA
PUSHJ PP,ADJSL.
JUMPN TD,MNLAC2
MOVEI TE,D1MODE
MOVEM TE,EMODEA
MOVSI CH,MOVN.
TSWF FLNEG;
MOVSI CH,MOV
JRST PUT.LA
MNLAC2: TSWTZ FLNEG;
PUSHJ PP,NEGATL
JRST MLTAC3
MNLAC3: PUSHJ PP,CONVFP
TSWF FLNEG;
TLO TC,17B21
PUSHJ PP,MFP%L1
JRST MLTAC7
MNLAC4: PUSHJ PP,CONVF2
TSWF FLNEG;
MOVE TC,C2MANT
TLO TC,17B21
PUSHJ PP,MFP%L1
JRST MLTAC9
;MOVE AN ITEM TO TEMPORARY FOR USE BY "DISPLAY".
;ENTER WITH "TC" POINTING TO OPERAND.
;EXIT WITH "TA" CONTAINING ADDRESS OF RESULT IN RH, INCREMENT IN LH.
; TB HAS RESIDUE IN BITS 0-5, SIZE IN BITS 6-17, "AS.CNB" IN RH.
MXTMP.: SETZM EAC
SWOFF FEOFF1 ;TURN OFF MOST FLAGS
PUSHJ PP,SETOPA
TLNE TB,GNLIT ;LITERAL?
JRST MXTM25 ;YES
MOVEM TC,CUROPP ;SAVE OPERAND POINTER INCASE WE NEED IT
MOVE TE,[XWD EBASEA,EBASEB];SET "B" = "A"
BLT TE,EBASBX
MOVEI TE,D7MODE
MOVEM TE,EMODEB
IFN ANS68,<
MOVE TA,EBASEA ;Check for TALLY
CAIN TA,TALLY. ; (ETABLA is zero).
JRST MXTMP4 ;We know that it is numeric.
>
MOVE TA,ETABLA ;MUST BE A REGULAR DATA ITEM
PUSHJ PP,LNKSET ;LOOK AT DATAB ENTRY
IFN ANS74,<
LDB TE,DA.BWZ ;IF ITEM IS "BLANK WHEN ZERO"
JUMPN TE,MXTMP0 ; MAKE IT NUMERIC-EDITED
>
TSWF FANUM ;IS "A" NUMERIC?
JRST MXTMP4 ;YES
LDB TE,DA.EDT ;IF ITEM IS EDITED
JUMPE TE,MXTMP1
MXTMP0: LDB TE,DA.EXS ; USE
MOVEM TE,ESIZEA ; EXTERNAL
MOVEM TE,ESIZEB ; SIZE
MXTMP1: MOVE TE,ESIZEA
MOVEM TE,ELITLO
HRRZ TE,EMODEA ;IS IT ASCII?
CAIN TE,D7MODE
JRST MXTMP2 ;YES
CAIE TE,D6MODE ;SIXBIT
JRST MXTMP3 ;NO
MOVEM TE,EMODEB ;YES, SET "B" SIXBIT ALSO
MXTMP2: MOVE TA,EBASEA ;YES--EXIT
HRL TA,EINCRA
MOVE TB,ESIZEA
ROT TB,-^D10
LSH TB,-2
HLR TB,ERESA
ROT TB,-6
HRRI TB,AS.CNB
SETZM CUROPP ;CLEAR OPERAND POINTER
POPJ PP,
;MOVE ITEM TO TEMP FOR DISPLAY (CONT'D).
;INPUT FIELD IS NON-ASCII, NON-NUMERIC
MXTMP3: MOVE TE,ESIZEB ;GET SIZE OF "B" IN WORDS
ADDI TE,4
IDIVI TE,5
PUSHJ PP,GETEMP ;GET SOME %TEMP LOCATIONS
MOVEM EACC,EINCRB ;SET "B" INCREMENT
MOVE TA,[XWD ^D36,AS.MSC];SET "B" BASE AND RESIDUE
MOVEM TA,EBASEB
HRL TA,EACC ;SET UP RETURNED DATA
MOVEM TA,ELITHI
PUSHJ PP,MXX. ;GENERATE MOVE
SWOFF FASUB ;NEW 'A' IS NOT SUBSCRIPTED
MOVE TA,ELITHI ;GET BASE AND INCREMENT
HRLZ TB,ELITLO ;GET SIZE
TLO TB,^D36B<^D18+5>
HRRI TB,AS.CNB
SETZM CUROPP ;CLEAR POINTER TO OPERAND
POPJ PP,
;MOVE SOMETHING TO TEMPORARY FOR DISPLAY (CONT'D).
;ITEM IS NUMERIC, AND THEREFORE MUST BE EDITED.
MXTMP4: SWON FBSIGN!FBNUM ;"B" IS ALWAYS SIGNED AND NUMERIC
SKIPL EDPLA ;NEGATIVE DECIMAL PLACES?
JRST MXTMP5 ;NO
MOVM TE,EDPLA ;YES--NEW "B" SIZE IS OLD SIZE - DEC. PL.
ADD TE,ESIZEA
MOVEM TE,ESIZEB
SETZM TE,EDPLB
JRST MXTMP9
MXTMP5: MOVE TE,ESIZEA ;NEGATIVE INTEGRAL PLACES?
SUB TE,EDPLA
JUMPGE TE,MXTMP9
MOVE TE,EDPLA ;YES--NEW SIZE IS NUMBER OF DECIMAL PLACES
MOVEM TE,ESIZEB
MXTMP9: MOVEI TE,D6MODE ;NO
MOVEM TE,EMODEB
MOVE TE,ESIZEB
ADDI TE,5
IDIVI TE,6
PUSHJ PP,GETEMP
MOVEM EACC,EINCRB
MOVE TE,[XWD ^D36,AS.MSC]
MOVEM TE,EBASEB
MOVE TE,[XWD EBASEB,ESAVEA] ;SAVE "B" PARAMETERS
BLT TE,ESAVAX
PUSHJ PP,MXX. ;MOVE ITEM TO A TEMP
MOVE TE,[XWD ESAVEA,EBASEA]
BLT TE,EBASAX
MOVE TE,[XWD ESAVEA,EBASEB]
BLT TE,EBASBX
SWOFF FASUB ;NEW 'A' IN TEMP IS NOT SUBSCRIPTED
IFN ANS74,<
; IF THERE ARE NO DECIMAL PLACES, AND A SEPARATE SIGN, OUTPUT AS IS
SKIPLE EDPLB ;ANY DECIMAL PLACES?
JRST MXTM10 ; YES, HAVE TO EDIT
TSWF FASIGN ;NO, IF DISPLAYED ITEM IS UNSIGNED,
SKIPGE EFLAGB ; ALSO SEPARATE SIGN
JRST [MOVSI CH,(1B2) ;DON'T HAVE TO EDIT!
IORM CH,EFLAGB ; BUT HAVE TO CALL A SEPARATE OUTPUT ROUTINE,
JRST MXTMP2] ;TO NOT OUTPUT LEADING ZEROES
>;END IFN ANS74
;MOVE SOMETHING TO TEMP FOR DISPLAY (CONT'D).
;IT IS (OR HAS BEEN CONVERTED TO) DISPLAY USAGE.
MXTM10:
SETZM EBASEB
MOVE TE,[XWD 440000,AS.CNB]
MOVEM TE,EDITW1 ;LEAVE LH OF MASK WORD FOR EDIT GENERATOR
MOVE TB,[POINT 4,MSKTMP##] ;BUILD MASK IN TEMP AREA
;THIS TAKES A LITTLE MORE TIME
;BUT FACILITATES LOCALITY OF BIS
IFN ANS68,< ;THE OLD WAY - MAKE A NUMERIC EDITED ITEM, INSERT COMMAS,
;DECIMAL POINTS TO TRY AND MAKE IT NICE AND READABLE
MOVE TC,ESIZEB
SUB TC,EDPLB
JUMPE TC,MXT11B
MOVEI CH,CODES ;PRETEND THERE IS ONLY ONE INTEGER
CAIE TC,1 ;IS THAT TRUE?
AOSA EBASEB ;NO--LEAVE ROOM FOR SIGN
PUSHJ PP,MXTM20 ;YES--JAM "INSERT SIGN"
MOVEI CH,CODEM ;SET UP FOR "FLOAT SIGN"
MXTM11: SOJLE TC,MXT11A ;ONLY ONE LEFT?
PUSHJ PP,MXTM20 ;NO--PUT OUT "-"
MOVE TE,TC
IDIVI TE,3
JUMPN TD,MXTM11
MOVEI CH,CODEC
PUSHJ PP,MXTM20
MOVEI CH,CODEM
JRST MXTM11
MXT11A: MOVEI CH,CODE9 ;USE "9" FOR LAST INTEGRAL PLACE
PUSHJ PP,MXTM20
JRST MXTM12
MXT11B: MOVEI CH,CODES ;NO INTEGRAL PLACES--USE "INSERT SIGN"
PUSHJ PP,MXTM20
MXTM12: SKIPN TC,EDPLB
JRST MXTM13
MOVEI CH,CODEP
PUSHJ PP,MXTM20
MOVEI CH,CODE9
PUSHJ PP,MXTM20
SOJG TC,.-1
>;END IFN ANS68
IFN ANS74,<
; EITHER THERE WERE DECIMAL PLACES, OR IMBEDDED SIGN, OR BOTH
TSWT FASIGN ; SIGNED?
JRST .+3 ;NO
SKIPL EFLAGB ; SEPARATE?
JRST IMBSGN ;NO, IMBEDDED SIGN (PHOOEY)
MOVSI CH,(1B2) ;BIT 2 IN FLAG WORD IS TURNED ON
; IF WE HAVE TO WORRY ABOUT LEADING ZEROES
IORM CH,EFLAGB
SWOFF FBNUM ;MAKE IT NON-NUMERIC
MOVEI CH,CODEX ; ASSUME LEADING SIGN
MOVSI TE,LDN.SN ;THIS BIT IS ON IF TRUE
TDZE TE,EFLAGB
PUSHJ PP,MXTM20 ;YES, ONE FOR THE SIGN CHARACTER
MOVE TC,ESIZEB
SUB TC,EDPLB ;TC= # DIGITS BEFORE POINT + 1
TSWT FASIGN ;SIGNED?
ADDI TC,1 ;NO, SO NEED ONE MORE DIGIT BEFORE POINT
MOVEI CH,CODEX
MXTM21: SOJLE TC,MXTM22 ;JUMP WHEN ALL HAVE BEEN COPIED
PUSHJ PP,MXTM20
JRST MXTM21
MXTM22: MOVEI CH,CODEP
PUSHJ PP,MXTM20 ;OUTPUT DECIMAL POINT
MOVE TC,EDPLB
MOVEI CH,CODEX ;DIGITS AFTER POINT
PUSHJ PP,MXTM20
SOJG TC,.-1
;OUTPUT TRAILING SIGN IF NECESSARY
TSWT FASIGN ;SIGNED?
JRST MXTM13 ;NO
MOVSI TE,LDN.SN
TDZN TE,EFLAGB ;SKIP IF LEADING SIGN
PUSHJ PP,MXTM20 ;NO, TRAILING
JRST MXTM13
;IMBEDDED SIGN. POSSIBLE DECIMAL PLACES, TOO.
IMBSGN: MOVE TC,ESIZEB
SUB TC,EDPLB
JUMPE TC,MXT74B
MOVEI CH,CODES ;SEE CODE AT MXTM10+FEW
CAIE TC,1
AOSA EBASEB ;MORE THAN 1 INTEGER
PUSHJ PP,MXTM20 ; "INSERT SIGN"
MOVEI CH,CODEM ;"FLOAT SIGN"
MXTM74: SOJLE TC,MXT74A ;ONLY ONE LEFT?
PUSHJ PP,MXTM20 ; NO, INSERT SIGN
JRST MXTM74 ;LOOP FOR ALL DIGITS
MXT74A: MOVEI CH,CODE9 ;LAST INTEGRAL PLACE
PUSHJ PP,MXTM20
JRST MXT74C
MXT74B: MOVEI CH,CODES ;NO INTEGRAL PLACES--USE "INSERT SIGN"
PUSHJ PP,MXTM20
;JUST DECIMAL PLACES LEFT
MXT74C: SKIPN TC,EDPLB
JRST MXTM13
MOVEI CH,CODEP
PUSHJ PP,MXTM20 ;DECIMAL POINT
MOVEI CH,CODE9
PUSHJ PP,MXTM20
SOJG TC,.-1
; FALL INTO MXTM13
>;END IFN ANS74
;MOVE SOMETHING TO TEMP FOR DISPLAY (CONT'D).
;MASK HAS BEEN CREATED FOR NUMERIC ITEM--FINISH UP.
MXTM13: MOVEI CH,17
IDPB CH,TB
MOVSI TA,OCTLIT
PUSHJ PP,STASHP
HRRZM TE,CURLIT
MOVE TC,[POINT 4,MSKTMP] ;INITIALIZE POINTER TO MASK
PUSHJ PP,BMASK0
MOVE TE,[XWD AS.CNB,^D36B23+1B24]
ADD TE,EBASEB
MOVSM TE,ELITLO
MOVE TE,EBASEB ;GET NEW SIZE
ADDI TE,4
IDIVI TE,5
PUSHJ PP,GETEMP
MOVEM EACC,EINCRB
HRLI EACC,AS.MSC
PUSH PP,EACC
HRRI EACC,^D36
MOVSM EACC,EBASEB
IFN ANS74,<
MOVSI TE,(1B2) ;KEEP IT SIXBIT IF WE ARE GOING TO
; WORRY ABOUT LEADING ZEROES
TDZN TE,EFLAGB ;IF FLAG WAS ON, SETS TE TO "D6MODE" AND SKIPS
>;END IFN ANS74
MOVEI TE,D7MODE
MOVEM TE,EMODEB
PUSHJ PP,MDED.5 ;GO BUILD THE BYTE POINTERS.
POP PP,TA
MOVSS TA
MOVE TB,ELITLO
LDB TE,[POINT 10,TB,17]
MOVEM TE,ESIZEA
SETZM CUROPP ;CLEAR OPERAND POINTER
POPJ PP, ;RETURN FROM MXTMP.
MXTM20: IDPB CH,TB
AOS EBASEB
POPJ PP,
;MOVE SOMETHING TO TEMP FOR DISPLAY (CONT'D).
;ITEM IS A LITERAL. IT HAD BETTER BE "TODAY".
MXTM25: TLNE TB,GNFIGC
TLNN TB,GNTODY
JRST MXTM27
MOVE TE,[XWD TODAYB,EBASEB]
BLT TE,EBASBX
IFN ANS74,<
LDB TE,[POINT 3,TB,7] ;GET INDEX
MOVE TE,[EXP ^D12,6,5,^D8](TE) ;TODAY, DATE, DAY, TIME
MOVEM TE,EBASEB+2 ;RESET SIZE
PUSH PP,TE ;SAVE IT
>
SWOFF FBNUM!FBSIGN!FBSUB
MOVEI TE,3
PUSHJ PP,GETEMP
HRRZM EACC,EINCRB
PUSH PP,EACC
PUSHJ PP,MTD.
POP PP,TA
MOVSS TA
HRRI TA,AS.MSC
MOVE TB,[XWD 440014,AS.CNB]
IFN ANS68,<
MOVEI TE,^D12
MOVEM TE,ESIZEA
>
IFN ANS74,<
POP PP,ESIZEA
>
POPJ PP,
;TROUBLE WITH OPERAND. IT WAS A LITERAL.
MXTM27: OUTSTR [ASCIZ /Literal operand for "MXTMP."
/]
JRST KILL
;"B" PARAMETERS FOR "TODAY"
TODAYB: XWD ^D36,AS.MSC
Z
DEC 12
EXP D7MODE
Z
Z
;ROUTINE TO MOVE ANYTHING (ALMOST) TO A TEMP.
COMMENT \
ENTER WITH (OPERND) = XWD A-OP,B-OP. WHERE A-OP IS THE
ADDRESS, IN EOPTAB, OF THE THING TO BE MOVED AND B-OP IS THE ADDRESS,
ALSO IN EOPTAB, OF AN ITEM WHICH THE THING SHOULD LOOK LIKE ONCE IT
GETS THERE (EG SIZE, DECIMAL POSITIONS, ETC.) NOTE THAT IT WILL NOT
GENERATE AN EDITED MOVE TO TEMP HOWEVER.
UPON EXIT EBASEA, ERESA, ETC. WILL BE SET UP FOR THE THING
IN TEMP AND EBASEB, ERESB, ETC. WILL BE SET UP FOR WHAT WAS THE
ORIGIONAL B-OP.
THIS ROUTINE TAKES THE NON SKIP RETURN ON ERRORS WHICH ARE
EITHER THE B-OP IS A LITERAL OR IT IS EDITED AND NOT IN DATAB.
THIS ROUTINE ALSO DESTROYES PRACTICALY EVERYTHING. THE
ONLY THINGS GUARENTEED TO BE PRESERVED ARE THE STACK, EOPTAB AND
OPERND.
\
MAT.TP::
SWOFF FEOFF1; ;TURN OFF MOST FLAGS.
HLRZ TC, OPERND ;SEE WHERE THE A-OP IS.
PUSHJ PP, SETOPA ;GO SET IT UP.
HRRZ TC, OPERND ;DITTO FOR THE B-OP.
PUSHJ PP, SETOPB
MOVE TA, ETABLA
PUSHJ PP, LNKSET ;IF 'A' IS EDITED, USE EXTERNAL SIZE
LDB TE, DA.EDT
JUMPE TE, MAT.T1 ;NO
LDB TE, DA.EXS
MOVEM TE, ESIZEA ;SET SIZES OF 'A' AND 'B'
MOVEM TE, ESIZEB
TRNA
MAT.T1: MOVE TE, ESIZEB ;GET B'S SIZE
HRRZ TA, EMODEB ; AND MODE.
XCT MAT.T3(TA) ;SEE HOW MUCH TEMP WE NEED.
MOVEM TA, EMODEB ;MAKE SURE B ISN'T EDITED.
PUSHJ PP, GETEMP ;GO GET SOME TEMP.
MOVEM EACC, EINCRB ;MAKE B POINT AT THE TEMP.
MOVE TA, [XWD ^D36,AS.MSC]
MOVEM TA, EBASEB
PUSH PP,EACC ;SAVE THAT STUFF FOR LATER
PUSH PP, TA
SWOFF FBSUB; ;MAKE SURE B ISN'T SUBSCRIPTED.
;FAKE UP FLAGS SO ALL OF IT GETS MOVED, WITH AS LITTLE CONVERSION
; AS POSSIBLE
HRRZ TE, EMODEA ;IF MODE IS
CAIE TE, D1MODE ;COMP OR COMP-1
CAIN TE, FPMODE
JRST DOMXX ;DON'T HAVE TO WORRY ABOUT SIGN
CAIE TE, C3MODE ;PRESERVE SIGN IF COMP-3 ALSO
CAIN TE, D2MODE ;OR DOUBLE-WORD COMP
JRST DOMXX
CAIE TE, D4MODE ;OR 4-WORD COMP
CAIN TE, F2MODE ;OR COMP-2
JRST DOMXX
SWOFF FANUM!FASIGN!FBNUM!FBSIGN ; DO AN ALPHANUMERIC MOVE
DOMXX: PUSHJ PP, MXX. ;GO GENERATE THE MOVE.
HRRZ TC, OPERND ;SET UP THE A OP AND B OP FOR RETURN
MOVEI LN,EBASEA ;[636] NOTE, WE CANNOT USE SETOPA
PUSHJ PP,SETOPN ;[636] AS IT POPS OFF 1 RETURN ON ERRORS FOUND
MOVE TE, [XWD EBASEA,EBASEB]
BLT TE, EBASBX
POP PP, EBASEA ;MAKE A POINT AT THE TEMP
POP PP, TA ; THIS TIME.
HRRZM TA, EINCRA
TSWT FERROR ;[636] IF ERROR JUST RETURN
AOS (PP) ;[636] ELSE TAKE THE SKIP RETURN.
POPJ PP, ;[636]
;XCT TABLE FOR FIGURING OUT THE ITEM'S SIZE IN WORDS.
MAT.T3: PUSHJ PP, MAT.T5 ;DISPLAY-6.
PUSHJ PP, MAT.T5 ;DISPLAY-7.
PUSHJ PP, MAT.T5 ;DISPLAY-9
MOVEI TE, 1 ;1 WORD COMP.
MOVEI TE, 2 ;2 WORD COMP.
MOVEI TE, 1 ;COMP-1.
PUSHJ PP, MAT.T7 ;COMP-3.
PUSHJ PP, MAT.T9 ;EDITED.
POPJ PP, ;LITERAL - ERROR.
POPJ PP, ;FIG. CON. - ERROR.
MOVEI TE, 4 ;4-WORD COMP - CANNOT HAPPEN
MOVEI TE, 2 ;COMP-2
MOVEI TE, 1 ;IMMEDIATE - CANNOT HAPPEN
;FIGURE OUT THE SIZE OF A DISPLAY ITEM IN WORDS.
MAT.T5: IDIV TE, BYTE.W(TA) ;(TE) = NUMBER OF WORDS NEEDED.
JUMPE TD, CPOPJ ;IF THERE ISN'T ANYTHING LEFT
; OVER, RETURN.
AOJA TE, CPOPJ ;OTHERWISE WE NEED ANOTHER WORD.
;FIGURE OUT THE SIZE OF A COMP-3 ITEM IN WORDS.
MAT.T7: ADDI TE, 2+<2*3> ;ONE FOR THE SIGN AND ONE TO
; FORCE ROUNDING UP ON NINE
; BIT BYTES THEN 6 MORE TO
; FORCE ROUNDING UP ON WORDS.
LSH TE, -<1+2> ;DIVIDE BY 8 TO GIVE THE
; NUMBER OF WORDS NEEDED.
POPJ PP, ;AND RETURN.
;FIGURE OUT THE SIZE OF AN EDITED ITEM IN WORDS AND SEE WHAT IT'S
; USAGE IS.
MAT.T9: HRRZ TA, EBASEB ;SEE WHERE IT'S AT.
LDB TB, LNKCOD##
CAIE TB, CD.DAT ;DATAB?
JRST [POP PP,(PP) ;[636] NO, TAKE OFF ONE RETURN.
POPJ PP,] ;AND TAKE THE NON-SKIP RETURN.
ANDI TA, LMASKB## ;GET THE OFFSET.
ADD TA, DATLOC ;FORM THE ADDRESS.
LDB TE, DA.INS## ;USE THE INTERNAL SIZE.
LDB TA, DA.USG## ;GET ITS USAGE.
HRRZI TA, -1(TA) ;TURN IT INTO A MODE.
CAIN TA, IXMODE## ;INDEX BECOMES COMP.
MOVEI TA, D1MODE##
CAIN TA, EDMODE## ;COMP-3 IS A SPECIAL CASE.
MOVEI TA, C3MODE##
XCT MAT.T3(TA) ;FIGURE OUT THE SIZE.
POPJ PP, ;AND RETURN.
;MOVE HIGH VALUES TO A COMP-3 FIELD.
MHVC3.: PUSHJ PP, C3HVL.## ;GO BUILD THE LITERAL
; OCT 231231231231
; OCT 231231231231
; OCT 231231231237
JRST MZC3.I ;GO ALTER A AND B.
;MOVE LOW VALUES TO A COMP-3 FIELD.
MLVC3.: TSWT FBSIGN; ;IS B SIGNED?
JRST MZC3. ;NO, USE ZEROES THEN.
PUSHJ PP, C3LVL.## ;GO BUILD THE LITERAL
; OCT 231231231231
; OCT 231231231231
; OCT 231231231233
TRNA ;GO ALTER A AND B.
;MOVE ZEROES TO A COMP-3 FIELD.
MZC3.: PUSHJ PP, C3ZRO.## ;GO BUILD THE LITERAL
; OCT 0
; OCT 0
; OCT 17
MZC3.I: HRRZ TE, ESIZEB ;TURN B INTO A DISPLAY-9 ITEM.
ADDI TE, 2
LSH TE, -1
MOVEM TE, ESIZEB
MOVEI TD, D9MODE##
MOVEM TD, EMODEB
SETZM EDPLB
SWOFF FBNUM!FBSIGN;
MOVE TD, [XWD EBASEB,EBASEA] ;MAKE A LOOK LIKE B,
BLT TD, EBASAX ; BUT POINT AT THE LITERAL.
SWOFF FANUM!FASIGN!FASUB;
SUBI TE, ^D12
MOVMS TE
IDIVI TE, 4
ADDI EACC, (TE)
HRRZM EACC, EINCRA
SUBI TD, 4
MOVMS TD
IMULI TD, ^D9
HRLI TD, AS.MSC
MOVSM TD, EBASEA
;FALL INTO MDD.
;GENERATE CODE TO MOVE FROM EBCDIC/ASCII/SIXBIT TO EBCDIC/ASCII/SIXBIT
; FOR UNEDITED FIELDS
MDD.: TSWF FBNUM ;IS RECEIVING FIELD NUMERIC?
JRST MNN. ;YES
IFN ANS74,< ;SEE NAVY TEST NC105
TSWC FANUM!FASIGN ;NO
TSWTC FANUM!FASIGN ;IS SENDING FIELD SIGNED NUMERIC
JRST [MOVE TA,ETABLA ;YES
LDB TE,LNKCOD ;GET TYPE
CAIE TE,TB.DAT ;IS IT A DATA-ITEM?
JRST .+1 ;NO
JRST MSDD.] ;YES, STRIP SIGN
>
MOVE TE,EMODEA ;[1341] IF "A" IS AN IMMEDITATE,
CAIN TE,IMMODE ;[1341] ALREADY WARNED IN LITD.3
JRST MDD.3 ;[1341]
MOVE TE,ESIZEB ;ARE OPERANDS THE SAME SIZE?
CAMN TE,ESIZEA
JRST MDD.3 ;YES
CAML TE,ESIZEA ;NO--"A" < "B"?
JRST MDD.5 ;YES
;SIZE OF "A" OPERAND IS GREATER THAN SIZE OF "B" OPERAND
HRRZ TC,OPERND ;[1371] MAKE SURE "B" OPERAND
MOVEM TC,CUREOP ;[1371] IS IN CUREOP
SKIPGE EMODEB ;IS "B" RIGHT JUSTIFIED?
JRST MDD.1 ;YES
PUSHJ PP,RTERA. ;NO--WRITE "RIGHT TRUNCATION" DIAG
JRST MDD.3
MDD.1: PUSHJ PP,LTERA. ;YES--WRITE "LEFT TRUNCATION" DIAG
MOVE TE,ESIZEA ;PUT DIFFERENCE IN SIZES INTO "TE"
SUB TE,ESIZEB
PUSHJ PP,M.IA ;RESET "A" TO DROP HIGH-ORDER BYTES
;SIZE OF THE TWO OPERANDS ARE EQUAL
MDD.3: MOVE TE,ESIZEB
MOVEM TE,ESIZEZ
PUSHJ PP,DEPCKK ;DOES EITHER OPERAND HAVE DEPENDING ITEMS?
JRST GMOVE. ;NO--GENERATE NORMAL CODE
JRST MDDDEP ;YES-- DEPENDING ITEM CODE
;SIZE OF "A" OPERAND IS LESS THAN SIZE OF "B" OPERAND.
MDD.5: SKIPGE EMODEB ;IS ITEM RIGHT JUSTIFIED?
JRST MDD.7 ;YES
MOVE TE,ESIZEA ;NO
MOVEM TE,ESIZEZ
PUSHJ PP,DEPCKK ;DOES EITHER OP HAVE DEPENDING ITEMS?
CAIA
JRST MDDDEP ;MOVE DEPENDING ITEM...
PUSHJ PP,GMOVE. ;GENERATE CODE TO MOVE "A" TO FIRST PART OF "B"
MOVE TE,ESIZEB ;PUT DIFFERENCE IN SIZES INTO "ESIZEZ"
SUB TE,ESIZEA
MOVEM TE,ESIZEZ
MOVE TC,EMODEB ;GENERATE CODE TO MOVE SPACES TO THE REST OF "B"
SKIPL EDPLA ;IF NO "P" IN "A"
JRST @MSX.(TC) ; AND RETURN
;"A" CONTAINS "P" IN ITS PICTURE. THE "P" MUST BE FILLED WITH ZEROS. THE REST WITH SPACES.
MOVN TE,EDPLA ;GET THE NO. OF ZEROS REQUIRED
CAML TE,ESIZEZ ;ENOUGH TO FILL "B"?
JRST @MZX.(TC) ;YES, DO IT
EXCH TE,ESIZEZ ;NO, FILL WITH ZEROS FIRST
SUB TE,ESIZEZ ;THEN THIS MANY SPACES
PUSH PP,TE
PUSHJ PP,@MZX.(TC) ;FIRST THE ZEROS
MOVN TE,EDPLA ;ACCOUNT FOR THE ZEROS
PUSHJ PP,M.IB ;BY ADVANCING BY THE NO. OF BYTES
POP PP,ESIZEZ
MOVE TC,EMODEB
JRST @MSX.(TC) ;FINALLY THE SPACES
;GENERATE CODE TO MOVE FROM ASCII/SIXBIT TO ASCII/SIXBIT FOR
; UNEDITED FIELDS (CONT'D).
;SIZE OF "A" IS LESS THAN SIZE OF "B", AND "B" IS JUSTIFIED RIGHT.
MDD.7: MOVE TE,ESIZEB ;DIFFERENCE OF SIZES IS PUT INTO "ESIZEZ"
SUB TE,ESIZEA
MOVEM TE,ESIZEZ
MOVE TC,EMODEB ;GENERATE CODE TO MOVE SPACES TO FIRST PART OF "B"
PUSHJ PP,@MSX.(TC)
MOVE TE,ESIZEB ;RESET "B" TO START AFTER THE SPACES
SUB TE,ESIZEA
PUSHJ PP,M.IB
MOVE TE,ESIZEA ;GENERATE CODE FOR
MOVEM TE,ESIZEZ ; THE REST OF THE MOVE
MOVEM TE,ESIZEB ;[***] RESET "B" INCASE IN LINKAGE SECTION
PUSHJ PP,DEPCKK ;ANY DEPENDENT ITEMS?
JRST GMOVE. ;NO
JRST MDDDEP ;YES.
;GENERATE CODE TO MOVE A SIGNED NUMERIC DISPLAY TO ALPHAMUNERIC DISPLAY
;NOTE THE SIGN MUST BE STRIPPED BUT THE MOVE IS ALPHANUMERIC
;IF THE NUMERIC FIELD HAS A SEPARATE SIGN THEN THE SIGN IS IGNORED
;AND THE DATA MOVED VIA AN ALPANUMERIC MOVE
;IF FIELDS ARE SAME SIZE JUST USE NUMERIC MOVE
;IF NOT USE NUMERIC MOVE TO SAME SIZE TEMP
;THEN ALPHANUMERIC MOVE TO DESTINATION
MSDD.:
IFN ANS74,<
SKIPGE EFLAGA ;SEPARARE SIGN?
SKIPE EDPLA ;YES, BUT NOT IF "P SHIFTED
CAIA ;TO BAD, DO IT THE HARD WAY
JRST MSDD.S ;YES
>
MOVE TE,ESIZEA
SUB TE,ESIZEB
IFN ANS74,<
SKIPGE EFLAGA ;SEPARATE SIGN
SUBI TE,1 ;YES, DON'T COUNT IT
>
JUMPE TE,MNN. ;EQUAL, JUST USE NUMERIC MOVE
MOVE TE,[EBASEA,,EBASEB] ;SET "B" TO "A"
BLT TE,EBASBX
SWOFF FBSUB ;TURN OFF SUBSCRIPTING
IFN ANS74,<
SKIPGE EFLAGA ;SEE IF SEPARATE SIGN
SOS ESIZEB ;YES, "B" IS 1 CHAR LESS
SETZM EFLAGB ;NOT SEPARATE IN ANY CASE
>
MOVN TE,EDPLB ;P SHIFTED?
SKIPG TE
TDZA TE,TE ;NO
SETZM EDPLB ;NOT ANYMORE
ADDB TE,ESIZEB ;GET SIZE (SET IF CHANGED)
MOVE TA,EMODEA ;GET MODE
PUSHJ PP,MAT.T5 ;SEE HOW MANY WORDS
PUSHJ PP,GETEMP ;GET SOME %TEMP LOCATIONS
SWON FBNUM ;MAKE "B" NUMERIC
SWOFF FBSIGN ;BUT NOT SIGNED
MOVEM EACC,EINCRB ;SET "B" INCREMENT
MOVE TA,[^D36,,AS.MSC] ;SET "B" BASE AND RESIDUE
MOVEM TA,EBASEB
HRL TA,EACC ;SET UP RETURNED DATA
MOVEM TA,ELITHI
PUSHJ PP,MXX. ;GENERATE MOVE
SWOFF FASUB!FANUM!FASIGN!FBNUM ;NEW 'A' IS NOT SUBSCRIPTED, NUMERIC OR SIGNED
MOVE TE,[EBASEB,,EBASEA] ;SET "A" TO BE "B"
BLT TE,EBASAX
HRRZ TC,OPERND
PUSHJ PP,SETOPB ;SETUP "B" AGAIN
MOVE TA,ETABLB ;[1421]
PUSHJ PP,LNKSET ;[1421]
LDB TE,DA.JST ;[1421] IS IT
SKIPN TE ;[1421] JUSTIFIED RIGHT?
TDCA TD,TD ;[1421] NO
HRLZI TD,1B18 ;[1421] YES
IORM TD,EMODEB ;[1421]
LDB TE,DA.EDT ;[1421] IS IT EDITED
LDB TD,DA.BWZ ;[1421] OR 'BLANK WHEN ZERO"
IORI TE,(TD) ;[1421]
JUMPE TE,MXX. ;[1421] NO
MOVEI TD,EDMODE ;[1421] YES,SET NEW MODE
HRRM TD,EMODEB ;[1421] SET UP EMODEB AGAIN,
JRST MXX. ;AND DO REST OF MOVE
;GENERATE CODE TO MOVE A NUMERIC DISPLAY TO A NUMERIC DISPLAY
MNN.: PUSHJ PP,MDAC. ;CONVERT TO BINARY
JRST MACD. ;CONVERT BACK TO DISPLAY
;MOVE SEPARATE SIGNED NUMERIC FIELD TO ALPHANUMERIC FIELD
;JUST REMOVE THE SIGN
;IF TRAILING MAKE SIZE ONE LESS
;IF LEADING BYPASS SIGN
IFN ANS74,<
INTERN MSDD.S
MSDD.S: SWOFF FANUM ;TURN OFF "A" NUMERIC
SOS ESIZEA ;SIZE IS ONE LESS
MOVE TE,EFLAGA ;GET FLAGS FOR "A"
TLNN TE,LDN.SN ;LEADING?
JRST MDD. ;NO, OK AS IS
HRRZ TE,EMODEA
HLRZ TC,ERESA ;GET BYTE DISPLACEMENT
SUB TC,BYTE.S(TE) ;ADVANCE 1 BYTE
JUMPGE TC,MSDDS1 ;OK, STILL IN SAME WORD
AOS EINCRA ;NO, MOVE TO NEXT WORD
MOVEI TC,44 ;AND START AT FRONT
MSDDS1: HRLM TC,ERESA ;RESET BYTE RESIDUE
JRST MDD.
>
;GENERATE CODE TO MOVE A DISPLAY FIELD TO A COMP, COMP-1 OR COMP-3 FIELD
MDC.: HRRZ TE,EMODEB ;IS "B" COMP-1?
CAIE TE,FPMODE
CAIN TE,F2MODE ;OR COMP-2?
JRST MDC.1 ;YES
MOVE TE,ESIZEB ;DO WE HAVE TO TRUNCATE HIGH PLACES?
SUB TE,EDPLB
SUB TE,ESIZEA
ADD TE,EDPLA
IFN ANS74,<
SKIPGE CH,EFLAGA ;[1442] SEPARATE SIGN?
ADDI TE,1 ;YES, ACCOUNT FOR IT
>
JUMPGE TE,MDC.1 ;NO IF JUMP
IFN ANS74,<
TLNN CH,LDN.SN ;[1442] IS IT LEADING SIGN?
JRST MDC.0 ;[1442] NO, ITS OK TO TRUNCATE FROM LEFT
ADD TE,ESIZEA ;[1442] CHECK TO SEE IF ANYTHING LEFT IN "A"
JUMPLE TE,MDC.2 ;[1442] NO, MOVE ZERO TO "B"
JRST MDC.1 ;[1442] GET ALL OF NUMBER
MDC.0:> ;[1442]
ADDM TE,ESIZEA ;YES--RESET SIZE OF "A"
MOVNS TE ;RESET OTHER PARAMETERS OF "A"
PUSHJ PP,M.IA
PUSHJ PP,MSERA. ;PUT OUT WARNING DIAG
MOVE TE,ESIZEA ;ANYTHING LEFT IN "A"?
JUMPLE TE,MDC.2 ;NO IF JUMP
MDC.1: TSWT FBSIGN; ;IS "B" SIGNED?
SWOFF FASIGN; ;NO--PRETEND "A" ISN'T
PUSHJ PP,MDAC. ;GENERATE CODE TO GET "A" INTO AC'S
HRRZ TE,EMODEB ;IS "B" A 2-WORD COMP?
CAIN TE,D2MODE
JRST MAC2C. ;YES--STASH AC'S INTO 2-WORD COMP AND RETURN
CAIN TE,D1MODE ;ONE WORD COMP?
JRST MAC1C. ;YES.
CAIN TE,FPMODE ;HOW ABOUT COMP-1?
JRST MACFP. ;YES.
CAIN TE,F2MODE ;HOW ABOUT COMP-2?
JRST MACF2. ;YES.
JRST MACC3. ;MUST BE COMP-3.
;"A" WAS CUT TO ZERO SIZE
MDC.2: HRRZ TE, EMODEB ;IS B COMP-3?
CAIN TE, C3MODE
JRST MDC.3 ;YES, GO MOVE ZEROES TO MEMORY.
PUSHJ PP,GENM16 ;GENERATE <SETZM EBASEB+EINCRB>
AOS EINCRB ;KICK UP INCREMENT
HRRZ TE,EMODEB ;IS "B" A 2-WORD COMP?
CAIE TE,D1MODE
PUSHJ PP,GENM16 ;YES--GENERATE <SETZM EBASEB+EINCRB>
JRST NOSIZ. ;WRITE DIAG AND LEAVE
MDC.3: PUSHJ PP, MZC3. ;GO CLEAR THE COMP-3 ITEM.
PJRST NOSIZ. ;GO COMPLAIN AND RETURN.
;GENERATE CODE TO MOVE TO AN EDITED FIELD.
; THE FOLLOWING TEMPS ARE USED
;
;EDITW1 XWD 440000+FLT&SGN CHARS, AS.CNB
;
;EDITW2 XWD MASK/PATTERN ADDRESS, AS.MSC
;
;EDITW3 XWD UUO CODE , ADDRESS OF POINTERS
MCED.:
MDED.:
; 24-JUN-80: The following instruction (SKIPE) fixes a problem with
; MOVE ZERO to <item with no size> ; e.g. PIC $/ .
; Code would be generated to do a numeric move to a TEMP with
; size zero, which would cause a LIBOL runtime error.
SKIPE ESIZEB ;SKIP IF RESULT HAS NO SIZE.
PUSHJ PP,SETED ;MOVE TO TEMP IF NECESSARY
MDED.1: MOVE TA,ETABLB
PUSHJ PP,LNKSET
LDB TA,DA.USG
SUBI TA,1
MOVEM TA,EMODEB
HRRZ TE,EMODEA ;IS 'A' STILL IMMODE?
CAIN TE,IMMODE
PUSHJ PP,IMMLIT ;YES, STORE IN LITTAB
PUSHJ PP,BMASK ;GENERATE THE MASK OR PATTERN
MDED.5:
;*****EDIT HERE-- THREE LINES INSERTED (THE IFN BIS)*****/MFTT
IFN BIS,<
PJRST BISCAL## ;GENERATE CALL TO EDIT.B AND RETURN
>
IFE BIS,< ;DON'T WORRY ABOUT SIGNS IF BIS
TSWF FASIGN;
TSWT FBSIGN;
>
JRST MDEU.
;IF BOTH ARE SIGNED, FALL INTO MDES.
;GENERATE CODE TO MOVE DISPLAY FIELD TO EDITED FIELD (CONT'D).
;BOTH RECEIVING AND SENDING FIELDS ARE SIGNED
MDES.: PUSH PP,SW ;SAVE PRESENT SETTING OF SWITCHES
MOVE TE,[XWD EBASEA,ESAVMA] ;SAVE "A" PARAMETERS
BLT TE,ESVMAX
MOVE TE,ESIZEA ;KICK PARAMATERS UP TO SIGN
SUBI TE,1
PUSHJ PP,M.IA
HRRZ TE,EMODEA
HRLZ TE,BYTE.S(TE)
MOVNS TE
ADDM TE,ERESA
TSWT FASUB ;IS "A" SUBSCRIPTED?
TSWF FBSUB ;NO--IS "B"?
JRST MDES.2 ;ONE OR THE OTHER IS SUBSCRIPTED
MOVE TA,[XWD BYTLIT,6]
PUSHJ PP,STASHP
MOVEI TE,3
MOVEM TE,EDITW3 ;INCREMENT TO ELITPC IF WE FAIL
PUSHJ PP,MBYTPA##
MDES.1: MOVE TE,[XWD ESAVMA,EBASEA] ;RESTORE ORIGINAL "A"
BLT TE,EBASAX
MOVSI CH,EDIT.S+ASINC
POP PP,SW ;RESTORE ORIGINAL SWITCHES
JRST MDEU.2
MDES.2: HRRZI EACC,3
PUSHJ PP,MDEU11
MOVEI EACD,1(EACC)
PUSHJ PP,SUBSCA
TSWF FASUB;
JRST MDES.3
PUSHJ PP,BYTE.A
PUSHJ PP,MDEU.9
JRST MDES.1
MDES.3: MOVE CH,MOVSAC
PUSHJ PP,PUTASY
HRRZ CH,EDITW3
PUSHJ PP,PUTASN
MOVSI CH,AS.BYT
PUSHJ PP,PUTAS1
MOVEI CH,0
PUSHJ PP,PUTAS1
JRST MDES.1
;GENERATE CODE TO MOVE A DISPLAY FIELD TO AN UNSIGNED EDITED FIELD
MDEU.: TSWT FASUB;
TSWF FBSUB;
JRST MDEU.0
MOVE TA,[XWD BYTLIT,4]
PUSHJ PP,STASHP
MOVEI TE,2
MOVEM TE,EDITW3 ;INCREMENT TO ELITPC IF WE FAIL
JRST MDEU.1
MDEU.0: MOVEI EACC,2
PUSHJ PP,MDEU11
MOVEI EACD,(EACC)
MDEU.1: MOVSI CH,EDIT.U+ASINC
MDEU.2: HLLM CH,EDITW3
HRRZ EACC,EDITW3
ANDI EACC,700000 ;ARE PARAMETERS IN IMPPAR?
CAIN EACC,AS.PAR
JRST MDEU.4 ;YES
PUSHJ PP,MBYTPA ;PUT POINTER TO "A" IN LITAB
HRRZ TA,EBASEB
PUSHJ PP,STASHQ
PUSHJ PP,MDEU12
MOVE TA,SUBCON
ROT TA,-14
HLR TA,ERESB
ROT TA,-6
HRR TA,EINCRB
PUSHJ PP,POOLIT
PUSHJ PP,MDEU10 ;SET PC IN EDITW3
MDEU.3:
IFN BIS,<
PJRST BISCAL## ;GENERATE CALL TO EDIT.B AND RETURN
>
IFE BIS,<
;GENERATE CALL TO EDIT.S OR EDIT.U
MOVE CH,EDITW3 ;PUT OUT UUO CALL
HRRI CH,AS.MSC
PUSHJ PP,PUTASY
HRRZ CH,EDITW3
PUSHJ PP,PUTASN
MOVE CH,[XWD AS.XWD,1] ;PUT OUT THE XWD FOLLOWING THE UUO
PUSHJ PP,PUTASY
MOVE CH,EDITW1
PUSHJ PP,PUTASN
MOVE CH,EDITW2
JRST PUTASN
>
;GENERATE CODE TO MOVE DISPLAY TO EDITED (CONT'D).
;EITHER "A" OR "B" IS SUBSCRIPTED -- IMPPAR BEING USED
MDEU.4: PUSHJ PP,SUBSCA
TSWF FASUB;
JRST MDEU.5
PUSHJ PP,BYTE.A
PUSHJ PP,MDEU.9
JRST MDEU.6
MDEU.5: PUSHJ PP,MDEU.8
MDEU.6: ADDI EACD,1
PUSHJ PP,MDEU12
PUSHJ PP,SUBSCE
TSWF FBSUB;
JRST MDEU.7
HRRZ CH,EBASEB
HRLI CH,AS.BYT
PUSHJ PP,PUTAS1
MOVE CH,SUBCON
ANDI CH,7777
ROT CH,-14
HLR CH,ERESB
ROT CH,-6
HRR CH,EINCRB
PUSHJ PP,PUTAS1
JRST MDEU.3
MDEU.7: PUSHJ PP,MDEU.8
JRST MDEU.3
MDEU.8: MOVE CH,MOVSAC
PUSHJ PP,PUTASY
HRRZ CH,EACD
PUSHJ PP,PUTASN
MOVE CH,[XWD AS.OCT,1]
PUSHJ PP,PUTAS1
MOVEI CH,0
JRST PUTAS1
MDEU.9: HRRZ CH,TB
HRLI CH,AS.BYT
PUSHJ PP,PUTAS1
MOVS CH,TB
HLL CH,TA
JRST PUTAS1
MDEU10: SKIPE TE,PLITPC ;POOLED?
JRST MDEU1A ;YES
HRRZ TE,EDITW3 ;NO, GET SIZE
EXCH TE,ELITPC
ADDM TE,ELITPC
MDEU1A: IORI TE,AS.LIT
HRRM TE,EDITW3
POPJ PP,
MDEU11: EXCH EACC,EAS1PC
ADDM EACC,EAS1PC
IORI EACC,AS.PAR
MOVEM EACC,EDITW3
POPJ PP,
MDEU12: HRRZ TE,EMODEB
MOVE TB,BYTE.S(TE) ;GET BYTE SIZE
LSH TB,6 ;MOVE TO PROPER POSITION
MOVE TA,ETABLB
LDB TE,LNKCOD
IFE BIS,< ;FORGET THIS IF GENERATING BIS
CAIE TE,TB.DAT
JRST MDEU13
PUSHJ PP,LNKSET
LDB TE,DA.BWZ
SKIPE TE
IORI TB,40
>
MDEU13: MOVEM TB,SUBCON
POPJ PP,
;ROUTINE TO STICK THE IMMEDIATE MODE VALUE IN 'A' IN A LITERAL
; (I.E. WE CHANGED OUR MIND.. USE A LITERAL ANYWAY).
;GETS CHARACTER FROM EBASEA. USES MODE IN EMODEB.
IMMLIT: HRRZ TC,EMODEB ;GET MODE OF "B"
CAILE TC,DSMODE
HALT . ;** CAN'T HAPPEN (I HOPE) **
MOVEM TC,EMODEA ;SET NEW MODE OF 'A'
HRL TA,D.LTCD##(TC) ;SELECT THE APPROPRIATE LITAB CODE.
HRRI TA,1 ;1 WORD IN THIS LITERAL
PUSHJ PP,STASHP ; STORE HEADER WORD
SETZ TA, ;WILL GET A LEFT JUSTIFIED CHARACTER IN TA
HRRZ TE,EBASEA ;CHARACTER VALUE
HRRZ TC,EMODEB ;GET MODE OF 'B' AGAIN
DPB TE,IMLPT(TC) ;STORE CHAR LEFT JUSTIFIED
PUSHJ PP,POOLIT ;STICK IN LITTAB
SKIPN TE,PLITPC ;GET LITERAL PC
HRRZ TE,ELITPC
IORI TE,AS.LIT
HRRM TE,EINCRA
SKIPN PLITPC
AOS ELITPC ;BUMP LITERAL PC
MOVE TA,[^D36,,AS.MSC] ;NEW EBASEA
MOVEM TA,EBASEA
POPJ PP, ;RETURN
IMLPT: POINT 6,TA,5 ;SIXBIT
POINT 7,TA,6 ;ASCII
POINT 9,TA,8 ;EBCDIC
;MOVE A 1-WORD COMP OR INDEX TO A 1-WORD COMP OR INDEX
M1C1C.: PUSHJ PP,M1CAC. ;GENERATE CODE TO MOVE FROM "A" TO AC'S
JRST MAC1C. ;GENERATE CODE TO MOVE FROM AC'S TO "B", AND RETURN
;MOVE A 1-WORD COMP OR INDEX TO A 2-WORD COMP
M1C2C.: PUSHJ PP, M1CS01 ;GO GENERATE CODE TO PICK UP
; THE COMP ITEM.
M1C2CA: PUSHJ PP, M1CS02 ;CUT DOWN SIZE AND ADJUST
; DECIMAL PLACES.
HRRZ TE,EMODEA. ;STILL ONE WORD?
CAIN TE,D1MODE
PUSHJ PP,CC1C2. ;YES--CONVERT TO TWO WORDS
JRST MAC2C. ;GENERATE MOVE FROM AC'S AND RETURN
;MOVE A 1-WORD COMP TO A DISPLAY FIELD
M1CD.: TSWT FBSIGN; ;IS "B" SIGNED?
SWOFF FASIGN; ;NO--PRETEND "A" ISN'T
TSWF FANUM ;[536] MOVING NUMERIC
TSWF FBNUM ;[536] TO NON-NUMERIC?
JRST M1CD.1 ;[536] NO
MOVE TE,ESIZEA ;[536] YES, SMALLER FIELD
CAML TE,ESIZEB ;[536] TO A LARGER FIELD?
JRST M1CD.1 ;[536] NO, DO IT OLD WAY
;[536] MOVE COMP FIELD TO EQUAL SIZED TEMP FIELD, THEN MOVE THAT TO "B"
PUSH PP,EBASEB ;[536] SAVE THE
PUSH PP,EINCRB ;[536] IMPORTANT
PUSH PP,ESIZEB ;[536] "B" ITEMS
MOVEM TE,ESIZEB ;[536] SET "B" SIZE SAME AS "A"
PUSH PP,SW ;[536] SAVE CURRENT "B" SWITCHES
SWOFF FBSUB ;[536] %TEMP IS NOT SUBSCRIPTED
MOVE TC,EMODEB ;[536] GET DISPLAY MODE OF "B"
ADD TE,BYTE.W(TC) ;[536] FIND OUT HOW
SUBI TE,1 ;[536] MANY WORDS WE NEED
IDIV TE,BYTE.W(TC) ;[536] IN %TEMP
PUSHJ PP,GETEMP ;[536] SET UP
MOVEM EACC,EINCRB ;[536] THE %TEMP
MOVE TE,[XWD ^D36,AS.MSC] ;[536]
MOVEM TE,EBASEB ;[536] FOR FIRST MOVE
PUSHJ PP,M1CAC. ;[536] DO A NUMERIC MOVE TO
PUSHJ PP,MACD. ;[536] THE TEMP ITEM.
;[536] NOW MOVE THE TEMP ITEM TO "B"
POP PP,SW ;[536] RESTORE SW TO GET OLD "B"
SWOFF FASUB!FANUM ;[536] MAKE "A" MATCH THE TEMP ITEM
MOVE TE,[EBASEB,,EBASEA] ;[536] SET UP
BLT TE,EBASAX ;[536] DO MOVE
POP PP,ESIZEB ;[536] RESTORE THE
POP PP,EINCRB ;[536] "B" ITEMS FROM
POP PP,EBASEB ;[536] THE STACK
JRST MDD.
M1CD.1: PUSHJ PP,M1CAC. ;YES--GENERATE CODE TO MOVE TO AC'S
TSWT FANUM ;[NC105] IS "A" NUMERIC?
JRST MACE. ;[NC105] SPECIAL HACK FOR ALPHANUMERIC-EDITED
JRST MACD. ;GENERATE CODE TO CONVERT, AND RETURN
;MOVE A 1-WORD COMP TO COMP-1
M1CFP.: PUSHJ PP,MXFPA.
JRST MACFP.
;MOVE A 1-WORD COMP TO COMP-3.
M1CC3.: PUSHJ PP, M1CS01 ;GO GENERATE CODE TO PICK UP
; THE COMP ITEM.
M1CC3A: PUSHJ PP, M1CS02 ;CUT DOWN SIZE AND ADJUST
; DECIMAL PLACES.
PJRST MACC3. ;GO GENERATE CODE TO STORE THE
; AC'S AND RETURN.
;SUBROUTINE TO GENERATE CODE TO GET A 1 WORD COMP ITEM INTO THE AC'S.
M1CS01: TSWT FBSIGN; ;IS B SIGNED?
SWOFF FASIGN; ;NO, THEN PRETEND A ISN'T EITHER.
PUSHJ PP, M1CAC. ;GENERATE CODE TO PICK UP THE
; COMP ITEM.
AOS (PP) ;DON'T BOTHER RETURNING, JUST
; SKIP OVER THE PUSHJ P,M1CS02
; WHEN WE RETURN AND FALL INTO
; M1CS02.
;SUBROUTINE TO GENERATE CODE TO FIX UP THE ITEM IN THE AC'S.
M1CS02: PUSHJ PP, CUTC1 ;CUT DOWN THE SIZE IF NECESSARY.
JFCL ;DON'T CARE IF WE DIDN'T
; GENERATE ANY CODE.
PJRST ADJ1C. ;GO ADJUST DECIMAL PLACES AND RETURN.
;MOVE 2-WORD COMP TO A 1-WORD COMP OR INDEX.
M2C1C.: PUSHJ PP, M2CS01 ;GO GENERATE CODE TO
; PICK UP THE ITEM.
M2C1CC: PUSHJ PP, M2CS02 ;CUT DOWN THE SIZE FNA ADJUST
; THE DECIMAL PLACE.
MOVEI TE,D1MODE
EXCH TE,EMODEA
HRRZS TE
CAIE TE,D1MODE
AOS EAC
JRST MAC1C2
;MOVE 2-WORD COMP TO A 2-WORD COMP.
M2C2C.: TSWT FBSIGN ;IS "B" SIGNED?
SWOFF FASIGN ;NO--PRETEND "A" ISN'T EITHER
PUSHJ PP,M2CAC. ;GENERATE MOVE TO AC'S
JRST MAC2C. ;GENERATE MOVE FROM AC'S AND RETURN
;MOVE A 2-WORD COMP TO A DISPLAY FIELD
M2CD.: TSWT FBSIGN; ;IS "B" SIGNED?
SWOFF FASIGN; ;NO--PRETEND "A" ISN'T
PUSHJ PP,M2CAC. ;GENERATE MOVE TO AC'S
JRST MACD. ;CONVERT AND RETURN
;MOVE A 2-WORD COMP TO COMP-1
M2CFP.: PUSHJ PP,MXFPA.
JRST MACFP.
;MOVE A 2 WORD COMP ITEM TO A COMP-3 ITEM.
M2CC3.: PUSHJ PP, M2CS01 ;GO GENERATE CODE TO
; PICK UP THE ITEM.
M2CC3A: PUSHJ PP, M2CS02 ;CUT DOWN SIZE AND ADJUST
; THE DECIMAL POINT.
MOVE TE, EMODEA## ;IF A IS A ONE WORD COMP,
CAIE TE, D2MODE## ; GO GENERATE CODE TO STORE
PJRST MACC3. ; AC'S AND RETURN.
MOVE TE, ESIZEB ;DO WE EXPECT A ONE OR TWO
CAIG TE, ^D10 ; WORD COMP?
AOSA EAC ;ONE, RESULT IS IN THE NEXT AC THEN.
PJRST MACC3C ;GO GENERATE CODE TO STORE AC'S
PJRST MACC3I ; AND RETURN.
;SUBROUTINE TO GENERATE CODE TO GET A 2 WORD COMP ITEM INTO THE AC'S.
M2CS01: TSWT FBSIGN; ;IF B ISN'T SIGNED,
SWOFF FASIGN; ; PRETEND A ISN'T EITHER.
PUSHJ PP, M2CAC. ;GO GENERATE CODE TO PICK UP
; THE COMP ITEM.
AOS (PP) ;DON'T BOTHER RETURNING. JUST
; SKIP OVER THE PUSHJ PP,M1CS02
; WHEN WE RETURN AND FALL INTO
; M1CS02.
;SUBROUTINE TO GENERATE CODE TO FIX UP THE ITEM IN THE AC'S.
M2CS02: PUSHJ PP, CUTC2 ;CUT DOWN INTEGRAL PLACES.
JFCL ;DON'T CARE WHETHER OR NOT
; CODE WAS GENERATED.
PJRST ADJDP. ;GO ADJUST DECIMAL PLACES AND RETURN.
;MOVE A FLOATING POINT FIELD TO A 1-WORD COMP
MFP1C.: PUSHJ PP,MFPAC.
MFP1CA: PUSHJ PP,CFPCX.
PUSHJ PP,MFPS01
PJRST MAC1C2
;MOVE A FLOATING POINT FIELD TO A 2-WORD COMP
MFP2C.: PUSHJ PP,MFPAC.
MFP2CA: PUSHJ PP,CFPCX.
JRST MAC2C1
;MOVE A FLOATING POINT FIELD TO A FLOATING POINT FIELD
MFPFP.: PUSHJ PP,MFPAC.
JRST MAC1C2
;MOVE A FLOATING POINT FIELD TO A DISPLAY FIELD
MFPD.: PUSHJ PP,MFPAC.
JRST MACFD.
;MOVE A COMP-1 ITEM TO A COMP-3 ITEM.
MFPC3.: PUSHJ PP, MFPAC. ;GENERATE CODE TO PICK UP THE
; COMP-1 ITEM.
MFPC3A: PUSHJ PP, CFPCX. ;TURN IT INTO A 2 WORD COMP ITEM.
MOVE TC, ESIZEB ;IF B HAS MORE THAN 10
CAILE TC, ^D10 ; DECIMAL PLACES,
PJRST MACC3I ; GO GENERATE CODE TO STORE THE
; ITEM AND RETURN.
PUSHJ PP, MFPS02 ;OTHERWISE MAKE IT INTO A
; 1 WORD COMP ITEM.
PJRST MACC3I ;GO GENERATE CODE TO STORE IT
; AND RETURN.
;SUBROUTINE TO TURN A 2 WORD COMP ITEM INTO A 1 WORD COMP ITEM.
MFPS01: MOVE TC, ESIZEB
MFPS02: MOVSI CH, DIV.21
MOVEI TE, 2
EXCH TE, EAC
ADDM TE, EAC
DPB TE, CHAC
PUSHJ PP, PUT.PC
MOVEI TE, D1MODE ;CHANGE THE MODE.
MOVEM TE, EMODEA
POPJ PP,
;MOVE A COMP-3 ITEM TO A DISPLAY ITEM.
MC3D.: TSWT FBSIGN; ;IS B SIGNED?
SWOFF FASIGN; ;NO, THEN PRETEND A ISN'T.
PUSHJ PP, MC3AC. ;GET THE COMP-3 ITEM INTO
; THE AC'S.
PJRST MACD. ;STORE THE AC'S AND RETURN.
;GENERATE CODE TO MOVE ZEROES TO SIXBIT FIELD
MZS.:
IFN ANS74,<
SKIPGE EFLAGB ;MOVING TO ITEM WITH A SEPARATE SIGN?
JRST MLD.ZS ;YES, FAKE A "MOVE 0 TO.."
>;END IFN ANS74
MOVE TB,ESIZEB ;SEE HOW BIG LITERAL IS
CAIG TB,3 ;BIGGER THAN IMMEDIATE MODE?
JRST [MOVEI TB,'000' ;NO
JRST MZS.I]
MOVE TE,ESIZEB ;[1546]Get right size
MOVEM TE,ESIZEZ ;[1546]
PUSHJ PP,SZERO. ;CREATE ZERO LITERAL
MOVE EACD,ESZERO ;ADDRESS LITERAL PUT INTO EACD
JRST MZS.0
MZS.I: SETZM ECONLJ
PUSHJ PP,GENM5I ;GENERATE HRRZI
JRST MZS.1
;GENERATE CODE TO MOVE QUOTES TO SIXBIT FIELD.
MQS.: MOVE TB,ESIZEB ;SEE HOW BIG LITERAL IS
CAIG TB,3 ;BIGGER THAN IMMEDIATE MODE?
JRST [MOVEI TB,'"""' ;NO
JRST MZS.I]
PUSHJ PP,SQUOT. ;CREATE QUOTE LITERAL
MOVE EACD,ESQUOT ;ADDRESS OF LITERAL PUT INTO EACD
; JRST MZS.0
;FOR BOTH ZERO AND QUOTE
MZS.0: SETZM ECONLJ ;CLEAR "CONSTANT IN AC" INDICATOR
PUSHJ PP,GENM05 ;GENERATE CODE TO PICK UP CONSTANT
MZS.1: TSWF FBSUB ;IS THE FIELD SUBSCRIPTED?
JRST MZS.7 ;YES
PUSH PP,EINCRB
HLRZ TE,ERESB ;NO--START IN BIT 0?
CAIE TE,^D36
JRST MZS.5 ;NO
MOVE TE,ESIZEZ ;YES
MZS.2: MOVE TD,EMODEB ;SEE WHAT B LOOKS LIKE.
IDIV TE,BYTE.W##(TD) ;"TE"_NUMBER OF WORDS, "TD"_REMAINDER
MOVEM TE,EWORDB
MOVEM TD,EREMAN
MZS.3: JUMPLE TE,MZS.4 ;AT LEAST ONE FULL WORD LEFT?
MOVE CH,ECONLJ
TLZ CH,177037+ASINC ;CLEAR ALL BUT AC
TLO CH,MOVEM.
PUSHJ PP,PUT.B
AOS EINCRB ;INCREMENT THE INCREMENT
SOS TE,EWORDB ;DECREMENT WORD COUNT
CAIG TE,2 ;AT LEAST 2 FULL WORDS LEFT?
JRST MZS.3 ;NO--LOOP
PUSHJ PP,GENM01 ;GENERATE <MOVE 4,[XWD EBASEB+EINCRB-1,EBASEB+EINCRB]
; BLT 4,EBASEB+EINCRB+EWORDB-1>
MOVE TE,EWORDB
ADDM TE,EINCRB
MZS.4: SKIPN TC,EREMAN ;ANYTHING LEFT?
JRST MLVD.9
MOVEI TB,^D36 ;YES--GENERATE A BYTE POINTER TO REMAINING CHARACTERS
MOVE TD,EMODEB ;SEE WHAT B LOOKS LIKE.
IMUL TC,BYTE.S##(TD)
CAIN TC,22 ;IS IT HALF WORD?
JRST MZS.4B ;YES, USE HRLM
MZS.4A: PUSHJ PP,GENM06
PUSHJ PP,GENM07 ;GENERATE "DPB"
JRST MLVD.9 ;RETURN
MZS.4B: PUSHJ PP,PUTASA
MOVE CH,ECONLJ
TLZ CH,177037+ASINC ;CLEAR ALL BUT AC
TLO CH,HRLM.
PUSHJ PP,PUT.B
JRST MLVD.9
;FIELD DOES NOT START IN BIT 0.
MZS.5: HLRZ TB,ERESB
MOVE TC,ESIZEZ ;NUMBER OF BITS GOES INTO
MOVE TD,EMODEB ; "TC"
IMUL TC,BYTE.S##(TD)
SUB TE,TC ;DOES FIELD GO THRU WORD BOUNDARY?
JUMPGE TE,MZS.4A
MZS.6: MOVE TC,TB ;YES
PUSHJ PP,GENM06 ;GENERATE BYTE POINTER
PUSHJ PP,GENM07 ;GENERATE "DPB"
AOS EINCRB ;INCREMENT THE INCREMENT
HLRZ TE,ERESB ;DECREMENT THE SIZE
MOVE TD,EMODEB
IDIV TE,NBYT.S##(TD)
ADD TE,ESIZEZ
JRST MZS.2 ;LOOP
;GENERATE CODE TO MOVE ZEROES TO AN EBCDIC FIELD.
MZE.:
IFN ANS74,<
SKIPGE EFLAGB ;SEP. SIGN?
JRST MLD.ZS ;YES, DO IT NUMERICALLY
>;END IFN ANS74
MOVE TB,ESIZEB ;SEE HOW BIG LITERAL IS
CAIG TB,2 ;[626] BIGGER THAN IMMEDIATE MODE?
JRST [MOVEI TB,360360 ;NO
JRST MZS.I]
MOVE TE,ESIZEB ;[1546]Get right size
MOVEM TE,ESIZEZ ;[1546]
PUSHJ PP, EZERO.## ;GO CREATE A LITERAL OF EBCDIC
; ZEROES.
MOVE EACD, EEZERO## ;GET ITS LITAB ADDRESS.
JRST MZS.0 ;GO GENERATE THE MOVE.
;GENERATE CODE TO MOVE HIGH VALUES TO AN EBCDIC FIELD.
MHVE.: MOVE TB,ESIZEB ;SEE HOW BIG LITERAL IS
CAIG TB,2 ;[626] BIGGER THAN IMMEDIATE MODE?
JRST [MOVEI TB,377377 ;NO
IFN ANS74,<
SKIPG COLSEQ ;[1004] [722] PROG. COL. SEQ. = ALPHABET-NAME?
JRST MZS.I ;[722] NO
HRRZ TB,COHVLV+2 ;[722] GET EBCDIC HIGH-VALUE
IMULI TB,1001 ;[722] 2 CHARACTERS
>
JRST MZS.I]
PUSHJ PP, EHVLS.## ;GO CREATE A LITERAL OF EBCDIC
; HIGH VALUES.
MOVE EACD, EEHIGH## ;GET ITS LITAB ADDRESS.
JRST MZS.0 ;GO GENERATE THE MOVE.
;GENERATE CODE TO MOVE SPACES TO AN EBCDIC FIELD.
MSE.: MOVE TB,ESIZEB ;SEE HOW BIG LITERAL IS
CAIG TB,2 ;[626] BIGGER THAN IMMEDIATE MODE?
JRST [MOVEI TB,100100 ;NO
JRST MZS.I]
PUSHJ PP, ESPAC.## ;GO CREATE A LITERAL OF EBCDIC
; SPACES.
MOVE EACD, EESPCE## ;GET ITS LITAB ADDRESS.
JRST MZS.0 ;GO GENERATE THE MOVE.
;GENERATE CODE TO MOVE QUOTES TO AN EBCDIC FIELD.
MQE.: MOVE TB,ESIZEB ;SEE HOW BIG LITERAL IS
CAIG TB,2 ;[626] BIGGER THAN IMMEDIATE MODE?
JRST [MOVEI TB,177177 ;NO
JRST MZS.I]
PUSHJ PP, EQUOT.## ;GO CREATE A LITERAL OF EBCDIC
; QUOTES.
MOVE EACD, EEQUOT## ;GET ITS LITAB ADDRESS.
JRST MZS.0 ;GO GENERATE THE MOVE.
;MOVE FIG. CONST. TO SUBSCRIPTED DISPLAY FIELD
MZS.7: MOVE TE, EMODEB## ;SINCE WE ARE ONLY GOING TO HAVE
MOVE TE, BYTE.S##(TE) ; A ONE WORD PARAM, MAKE SUBSCR
LSH TE, 6 ; PUT THE BYTE SIZE IN THE FIELD
; SIZE FIELD OF THE PARM, THUS
; MAKING A BYTE POINTER OUT OF
; IT.
MZS.8: MOVEM TE,SUBCON ;SET CONSTANT FOR "SUBSCR"
MOVEI DT,ESAVSB ;TELL "SUBSCR" WE ARE PLAYING WITH "B"
HRRZ TE,OPERND
MOVEM TE,CUREOP
SETOM IBPFLG## ;WE WANT THE IDPB BP, ALWAYS
PUSHJ PP,SUBSCR
JRST MZS.10 ;LITERAL SUBSCRIPT
MZS.8A: MOVE TE,ESIZEZ ;AT LEAST 4 CHARACTERS?
CAIG TE,3
JRST MZS.9 ;NO
HRRZ CH,ESIZEZ ;[1410] GET SIZE
CAILE CH,77777 ;[1410] SMALL ?
SKIPA CH,[MOVEI.+AC1+ASINC,,AS.CNB] ;[1410] NO, SAVE SIZE FOR MOVE
HRLI CH,MOVEI.+AC1 ;[1410] YES, MOVE SIZE TO RH SIDE
PUSHJ PP,PUTASY ;[1410] GENERATE "MOVEI 1,SIZE"
HRRZ CH,ESIZEZ ;[1410] GET SIZE
CAILE CH,77777 ;[1410] UPDATE SIZE FOR MOVE ?
PUSHJ PP,PUTASN ;[1410] YES
;[1410] MOVSI CH,MOVEI.+AC1 ; YES--GENERATE <MOVEI 1,<SIZE>>
;[1410] HRR CH,ESIZEZ ;
;[1410] PUSHJ PP,PUTASY ;
PUSHJ PP,GETTAG ;GET A TAG
MOVEM CH,EWORDB
PUSHJ PP,PUTTAG ;WRITE IT OUT
MZS.9: MOVE CH,[XWD IDPB.+KAC,SXR]
PUSHJ PP,PUTASY
SOSG TE,ESIZEZ ;AT LEAST 1 CHARACTER LEFT?
POPJ PP, ;NO--RETURN
CAIG TE,2 ;YES--MORE THAN 2?
JRST MZS.9 ;NO--LOOP
MOVSI CH,SOJG.+AC1 ;YES--GENERATE <SOJG 1,.-1>
HRR CH,EWORDB
LDB TA,[POINT 3,CH,20] ;GET ADDRESS TYPE
CAIE TA,AC.TAG## ;A TAG?
JRST PUTASY ;NO
LDB TA,[POINT 15,CH,35] ;YES--REFERENCE IT
PUSHJ PP,REFTAG##
JRST PUTASY
;SUBSCRIPT WAS LITERAL
MZS.10: MOVE TB,TE
MOVE TA,[XWD XWDLIT,2]
PUSHJ PP,STASHP
MOVE TA,TB
HRRI TA,AS.CNB
PUSHJ PP,STASHQ
MOVE TA,EBASEB
HRL TA,TB
PUSHJ PP,POOLIT
MOVSI CH,MOV+SAC
PUSHJ PP,PUT.LD
SKIPN PLITPC
AOS ELITPC
JRST MZS.8A
;GENERATE CODE TO MOVE HIGH-VALUES TO ASCII OR SIXBIT FIELD
MHVS.:
IFN ANS74,<
SKIPG COLSEQ ;[1004] [722] PROG. COL. SEQ. = ALPHABET-NAME?
JRST MHVD. ;[722] NO
HRRZ TB,COHVLV ;[722] YES, GET HIGHEST CHARACTER
CAIN TB,77 ;[722] SAME AS NORMAL ONE?
JRST MHVD. ;[722] YES, USE NORMAL CODE
MOVE TE,ESIZEB ;[722] SEE HOW BIG LITERAL IS
CAIG TE,3 ;[722] BIGGER THAN IMMEDIATE MODE?
JRST [IMULI TB,10101 ;[722] THREE CHARS.
JRST MZS.I] ;[722]
PUSHJ PP,SHVAL. ;[722] CREATE HIGH-VALUE LITERAL
MOVE EACD,ESHIVL ;[722] ADDRESS OF LITERAL PUT INTO EACD
JRST MZS.0 ;[722]
>
MHVA.:
IFN ANS74,<
SKIPG COLSEQ ;[722] PROG. COL. SEQ. = ALPHABET-NAME?
JRST MHVD. ;[722] NO
HRRZ TB,COHVLV+1 ;[722] YES, GET HIGHEST CHARACTER
CAIN TB,177 ;[722] SAME AS NORMAL ONE?
JRST MHVD. ;[722] YES, USE NORMAL CODE
TSWF FBSUB ;[722] IS IT SUBSCRIPTED?
JRST [MOVSI CH,HRRZI.+KAC ;[722] YES
HRR CH,TB ;[722]
JRST MQA.2] ;[722]
IMULI TB,201 ;[722] FORM 2 CHARACTERS
PUSHJ PP,MQZSA. ;[722] SEE IF IT CAN BE IMMEDIATE MODE
PUSHJ PP,AHRJ. ;[722] CREATE THE LOW-VALUE LITERAL
MOVE EACD,EAHRJ ;[722] EACD_ADDRESS OF LITERAL
JRST MSZA. ;[722]
>
MHVD.: MOVSI TE,ORCAM.+AC4 ;SET "WE'RE DOING HIGH-VALUE"
TSWT FBSUB ;IS FIELD SUBSCRIPTED?
JRST MLVD.0 ;NO
SKIPA CH,[XWD HRRZI.+KAC,177] ;YES
MHVD.1: MOVSI CH,HRRZI.+KAC
PUSHJ PP,PUTASY
HRRZ TC,EMODEB
MOVE TE,BYTE.S(TC)
LSH TE,6
JRST MZS.8
;[722] GENERATE CODE TO MOVE LOW-VALUES TO SIXBIT, ASCII OR EBCDIC FIELDS
MLVS.:
IFN ANS74,<
SKIPG COLSEQ ;[1004] [722] PROG. COL. SEQ. = ALPHABET-NAME?
JRST MLVD. ;[724] [722] NO
HRRZ TB,COHVLV+3 ;[722] YES, GET LOWEST CHARACTER
JUMPE TB,MLVD. ;[722] JUMP IF SAME AS NORMAL ONE
MOVE TE,ESIZEB ;[722] SEE HOW BIG LITERAL IS
CAIG TE,3 ;[722] BIGGER THAN IMMEDIATE MODE?
JRST [IMULI TB,10101 ;[722] THREE CHARS.
JRST MZS.I] ;[722]
PUSHJ PP,SLVAL. ;[722] CREATE LOW-VALUE LITERAL
MOVE EACD,ESLOVL ;[722] ADDRESS OF LITERAL PUT INTO EACD
JRST MZS.0 ;[722]
>
MLVA.:
IFN ANS74,<
SKIPG COLSEQ ;[1004] [722] PROG. COL. SEQ. = ALPHABET-NAME?
JRST MLVD. ;[722] NO
HRRZ TB,COHVLV+4 ;[722] YES, GET LOWEST CHARACTER
JUMPE TB,MLVD. ;[722] JUMP IF SAME AS NORMAL ONE
TSWF FBSUB ;[722] IS IT SUBSCRIPTED?
JRST [MOVSI CH,HRRZI.+KAC ;[722] YES
HRR CH,TB ;[722]
JRST MQA.2] ;[722]
IMULI TB,201 ;[722] FORM 2 CHARACTERS
PUSHJ PP,MQZSA. ;[722] SEE IF IT CAN BE IMMEDIATE MODE
PUSHJ PP,ALRJ. ;[722] CREATE THE LOW-VALUE LITERAL
MOVE EACD,EALRJ ;[722] EACD_ADDRESS OF LITERAL
JRST MSZA. ;[722]
>
MLVE.:
IFN ANS74,<
SKIPG COLSEQ ;[1004] [722] PROG. COL. SEQ. = ALPHABET-NAME?
JRST MLVD. ;[722] NO
HRRZ TB,COHVLV+5 ;[722] YES, GET LOWEST CHARACTER
JUMPE TB,MLVD. ;[722] JUMP IF SAME AS NORMAL ONE
MOVE TE,ESIZEB ;[722] SEE HOW BIG LITERAL IS
CAIG TE,2 ;[722] BIGGER THAN IMMEDIATE MODE?
JRST [IMULI TB,1001 ;[722] THREE CHARS.
JRST MZS.I] ;[722]
PUSHJ PP,ELVLS.## ;[722] GO CREATE A LITERAL OF EBCDIC LOW VALUES.
MOVE EACD,EELOW## ;[722] GET ITS LITAB ADDRESS.
JRST MZS.0 ;[722] GO GENERATE THE MOVE.
>
;GENERATE CODE TO MOVE SPACES TO SIXBIT, OR
; LOW-VALUES TO A SIXBIT, ASCII OR EBCDIC FIELD.
MLVD.: MOVSI TE,ANDM.+AC4 ;SET "WE'RE DOING LOW-VALUE"
TSWF FBSUB ;IS FIELD SUBSCRIPTED?
JRST MHVD.1 ;YES
MLVD.0: PUSH PP,EINCRB
MOVEM TE,EMOVHL
MOVE TC,EMODEB ;SAVE MOVE IN "TC"
HLRZ TE,ERESB ;START IN BIT 0?
CAIE TE,^D36
JRST MLVD.5 ;NO
MOVE TE,ESIZEZ ;YES
MLVD.1: IDIV TE,BYTE.W(TC) ;"TE"_NUMBER OF WORDS, "TD"_REMAINDER
MOVEM TE,EWORDB
MOVEM TD,EREMAN
MLVD.2: JUMPLE TE,MLVD.3 ;AT LEAST ONE FULL WORD?
MOVS TD,EMOVHL ;YES--GENERATING HIGH-VALUES?
CAIN TD,ORCAM.+AC4
JRST .+3
PUSHJ PP,GENM16 ;NO--GENERATE <SETZM EBASEB+EINCRB>
SKIPA
PUSHJ PP,GENM17 ;YES--GENERATE <SETOM EBASEB+EINCRB>
AOS EINCRB ;INCREMENT THE INCREMENT
SOS TE,EWORDB ;DECREMENT WORD COUNT
CAIG TE,2 ;AT LEAST TWO FULL WORDS LEFT?
JRST MLVD.2 ;NO--LOOP
PUSHJ PP,GENM01 ;GENERATE <MOVE 4,[XWD EBASEB+EINCRB-1,EBASEB+EINCRB]
; BLT 4,EBASEB+EINCRB+EWORDB-1>
MOVE TE,EWORDB
ADDM TE,EINCRB
MLVD.3: SKIPN TD,EREMAN ;ANYTHING LEFT?
JRST MLVD.9 ;NO--RETURN
MOVEI TE,^D36 ;YES--RESIDUE MUST BE 36
IMUL TD,BYTE.S(TC) ;GET NUMBER OF BITS TO RIGHT OF FIELD
SUB TE,TD
PUSHJ PP,BITSR. ;GENERATE MASK OF ONES IN RIGHT
MOVE TB,EMASK
CAIN TB,-1 ;TEST FOR HALF-WORD
JRST MLVD4A ;IT IS, USE HALF-WORD INST
MLVD.4: MOVSI TA,OCTLIT ;GENERATE <MOVE 4,[EMASK]>
PUSHJ PP,GENM09
MOVE CH,EMOVHL ;GENERATE THE INSTRUCTION
PUSHJ PP,PUT.B
JRST MLVD.9 ;RETURN
MLVD4A: PUSHJ PP,PUTASA
MOVS CH,EMOVHL
ANDI CH,177000
CAIE CH,ORCAM.
SKIPA CH,[HRRZS.##,,0]
MOVSI CH,HRROS.##
PUSHJ PP,PUT.B
JRST MLVD.9
;GENERATE CODE TO MOVE HIGH/LOW-VALUES TO ASCII/SIXBIT (CONT'D).
;FIELD DOESN'T START IN BIT0.
MLVD.5: PUSHJ PP,BITSL. ;GENERATE MASK OF BITS TO LEFT OF FIELD
MOVE TD,ESIZEZ ;DOES FIELD GO UP TO/THRU RIGHT-HAND WORD BOUNDARY?
IMUL TD,BYTE.S(TC)
HLRZ TE,ERESB
SUB TE,TD
CAIG TE,1
JRST MLVD.6 ;YES
PUSH PP,EMASK ;SAVE THE MASK GENERATED SO FAR
PUSHJ PP,BITSR. ;GENERATE MASK OF BITS IN RIGHT
POP PP,TB ;CREATE THE
IOR TB,EMASK ; TOTAL MASK
JRST MLVD.4 ;GO BACK
MLVD.6: MOVE TB,EMASK ;GENERATE <MOVE 4,[EMASK]>
CAMN TB,[-1,,0] ;LEFT HALF-WORD?
JRST MLVD6A ;YES
CAIN TB,-1 ;RIGHT HALF-WORD
JRST MLVD6B ;YES
MOVSI TA,10
PUSHJ PP,GENM09
MOVE CH,EMOVHL ;GENERATE "ANDM" OR "ORCAM"
MLVD6C: PUSHJ PP,PUT.B
HLRZ TE,ERESB ;GET NEW SIZE INTO "TE"
IDIV TE,NBYT.S##(TC)
ADD TE,ESIZEZ
AOS EINCRB ;INCREMENT THE INCREMENT
JUMPG TE,MLVD.1 ;ANYTHING LEFT? IF SO, GO BACK
MLVD.9: POP PP,EINCRB ;RESTORE ORIGINAL INCREMENT
POPJ PP, ;NO--RETURN
MLVD6A: PUSHJ PP,PUTASA
MOVS CH,EMOVHL
ANDI CH,177000
CAIE CH,ORCAM.
SKIPA CH,[HLLZS.##,,0]
MOVSI CH,HLLOS.##
JRST MLVD6C
MLVD6B: PUSHJ PP,PUTASA
MOVS CH,EMOVHL
ANDI CH,177000
CAIE CH,ORCAM.
SKIPA CH,[HRRZS.##,,0]
MOVSI CH,HRROS.##
JRST MLVD6C
;GENERATE CODING TO MOVE ZEROES TO 1-WORD COMP, FLOATING POINT, OR INDEX
MZC1.: PUSHJ PP,SUBSCB ;DO ANY SUBSCRIPTING
JRST GENM16 ;GENERATE <SETZM B> AND LEAVE
;MOVE -1 TO A 1-WORD COMP
MZC11.: PUSHJ PP,SUBSCB ;DO ANY SUBSCRIPTING
JRST GENM17 ;GENERATE <SETOM B> AND LEAVE
;GENERATE CODING TO MOVE ZEROES TO 2-WORD COMP.
MZC2.: PUSHJ PP,SUBSCB ;DO ANY SUBSCRIPTING
PUSHJ PP,GENM16 ;GENERATE <SETZM B>
AOS EINCRB
JRST GENM16 ;GENERATE <SETZM B+1> AND RETURN
;GENERATE CODE TO MOVE HIGH-VALUES TO 1-WORD COMP, INDEX OR FLOATING-POINT.
MHVC1.: PUSHJ PP,SUBSCB ;DO ANY SUBSCRIPTING
PUSHJ PP,GENM19 ;GENERATE <HRLOI 4,377777>
JRST GENM08 ;GENERATE <MOVEM 4,B> AND RETURN
;GENERATE CODING TO MOVE HIGH-VALUES TO 2-WORD COMP.
MHVC2.: PUSHJ PP,MHVC1. ;GENERATE <HRLOI 4,377777
; MOVEM 4,B>
AOS EINCRB
JRST GENM08 ;GENERATE <MOVEM 4,B+1> AND RETURN
;GENERATE CODE TO MOVE LOW-VALUES TO 1-WORD COMP
MLVC1.: PUSHJ PP,SUBSCB ;DO ANY SUBSCRIPTING
MOVSI TB,1B18 ;GENERATE <HRLZI 4,400000>
PUSHJ PP,GENM10
JRST GENM08 ;GENERATE <MOVEM 4,B>
;GENERATE CODE TO MOVE LOW-VALUES TO 2-WORD COMP.
MLVC2.: PUSHJ PP,MLVC1. ;MOVE LOW-VALUES TO HI-ORDER WORD
AOS EINCRB
JRST GENM08 ;MOVE LOW-VALUES TO LOW-ORDER WORD, AND RETURN
;GENERATE CODE TO MOVE LOW-VALUES TO A FLOATING POINT FIELD
MLVFP.: PUSHJ PP,SUBSCB ;DO ANY SUBSCRIPTING
PUSHJ PP,FPLOV.
MOVE CH,[XWD MOV+ASINC,AS.MSC]
PUSHJ PP,PUT.XA
HRRZ CH,EFPLOV
PUSHJ PP,PUTASN
MOVSI CH,MOVEM.
JRST PUT.BA
;GENERATE CODE TO MOVE QUOTES TO ASCII FIELD
MQA.: TSWF FBSUB ;IS IT SUBSCRIPTED?
JRST MQA.1 ;YES
MOVEI TB,""""""
PUSHJ PP,MQZSA. ;SEE IF IT CAN BE IMMEDIATE MODE
PUSHJ PP,AQRJ. ;CREATE THE QUOTE LITERAL
MOVE EACD,EAQRJ ;EACD_ADDRESS OF LITERAL
JRST MSZA.
MQA.1: MOVE CH,[XWD HRRZI.+KAC,42]
MQA.2: PUSHJ PP,PUTASY
MOVEI TE,700
JRST MZS.8
;GENERATE CODE TO MOVE ZEROES TO AN ASCII FIELD
MZA.:
IFN ANS74,<
SKIPGE EFLAGB ;SEP. SIGN?
JRST MLD.ZS ;YES, DO IT NUMERICALLY
>;END IFN ANS74
TSWF FBSUB ;IS IT SUBSCRIPTED?
JRST MZA.1 ;YES
MOVE TE,ESIZEB ;[1546]Get the right size
MOVEM TE,ESIZEZ ;[1546]
MOVEI TB,"00"
PUSHJ PP,MQZSA. ;SEE IF IT CAN BE IMMEDIATE MODE
PUSHJ PP,AZRJ. ;CREATE THE ZERO LITERAL
MOVE EACD,EAZRJ ;EACD_ADDRESS OF LITERAL
JRST MSZA.
MZA.1: MOVE CH,[XWD HRRZI.+KAC,"0"]
JRST MQA.2
;GENERATE CODE TO MOVE SPACES TO AN ASCII FIELD
MSA.: TSWF FBSUB;
JRST MSA.1
MOVEI TB," "
PUSHJ PP,MQZSA. ;SEE IF IT CAN BE IMMEDIATE MODE
PUSHJ PP,ASRJ. ;CREATE THE SPACE LITERAL
MOVE EACD,EASRJ ;EACD_ADDRESS OF LITERAL
JRST MSZA.
MSA.1: MOVE CH,[XWD HRRZI.+KAC," "]
JRST MQA.2
;HERE TO SEE IF "B" IS SPECIAL
;EITHER IN TWO WORDS OR THE RIGHTMOST BYTES
MQZSA.: MOVE TE,ESIZEB ;SEE HOW BIG LITERAL IS
SOJE TE,MQZSA1 ;1 CHARACTER IS ALWAYS OK
SOJN TE,CPOPJ ;GREATER THAN 2 ALWAYS FAILS
HLRZ TE,ERESB
CAIN TE,10 ;START IN LAST BYTE?
POPJ PP, ;YES, JUST GIVE UP
MQZSA1: POP PP,TE ;POP OFF RETURN
JRST MZS.I ;DEPOSIT THE BYTES
;GENERATE CODE TO MOVE SOME FIG. CONST. TO ASCII FIELD
MSZA.: PUSH PP,EINCRB
SETZM ECONRJ
SETZM ECONLJ
HLRZ TE,ERESB ;START IN BIT 0?
CAIE TE,^D36
JRST MSZA.4 ;NO
MOVE TE,ESIZEZ ;YES
MSZA.1: IDIVI TE,5 ;"TE"_NUMBER OF WORDS, "TD"_REMAINDER
MOVEM TE,EWORDB
MOVEM TD,EREMAN
JUMPE TE,MSZA.3 ;AT LEAST ONE FULL WORD?
PUSHJ PP,GENM05 ;YES--GENERATE CODE TO PICK UP CONSTANT
MSZA.2: MOVSI CH,MOVEM.+AC2
PUSHJ PP,PUT.B
AOS EINCRB ;INCREMENT THE INCREMENT
SOS TE,EWORDB ;DECREMENT NUMBER OF WORDS
CAIG TE,2 ;AT LEAST 2 FULL WORDS LEFT
JRST MSZA.6 ;NO
PUSHJ PP,GENM01 ;YES--GENERATE <MOVE 4,[XWD B,B+1]
; BLT 4,B+EWORDB>
MOVE TE,EWORDB
ADDM TE,EINCRB
MSZA.3: SKIPN EREMAN ;ANYTHING LEFT?
JRST MLVD.9
PUSHJ PP,GENM04 ;YES--GENERATE CODE TO PICK UP CONSTANT
MOVE TC,EREMAN ;GENERATE A BYTE POINTER
IMULI TC,7
MOVEI TB,^D36
PUSHJ PP,GENM06
PUSHJ PP,GENM7A ;GENERATE THE "DPB"
JRST MLVD.9 ;RETURN
;GENERATE CODE TO MOVE ZEROES, SPACES, OR QUOTES
; TO AN ASCII FIELD (CONT'D).
;"B" DOES NOT START AT BIT 0.
MSZA.4: MOVE TD,ESIZEZ ;DOES "B" GO UP TO OR THROUGH WORD BOUNDARY?
IMULI TD,7
SUB TE,TD
CAILE TE,1
JRST MSZA.5 ;NO
MOVEM TE,EWORDB
PUSHJ PP,GENM05 ;GENERATE CODE TO PICK UP CONSTANT
HLRZ TB,ERESB ;GENERATE BYTE POINTER
MOVE TC,TB
PUSHJ PP,GENM06
AOS EINCRB ;INCREMENT THE INCREMENT
PUSHJ PP,GENM07 ;GENERATE "DPB"
SKIPL TE,EWORDB ;ANYTHING AFTER THIS?
JRST MLVD.9 ;NO--RETURN
HLRZ TE,ERESB ;YES--UPDATE SIZE
IDIV TE,BYTEN7
ADD TE,ESIZEZ
JRST MSZA.1 ;LOOP BACK
;FIELD IS WORD CONTAINED
MSZA.5: PUSHJ PP,GENM04 ;GENERATE CODE TO PICK UP CONSTANT
MOVE TC,ESIZEZ ;GENERATE BYTE POINTER
IMULI TC,7
HLRZ TB,ERESB
PUSHJ PP,GENM06
PUSHJ PP,GENM7A ;GENERATE THE "DPB"
JRST MLVD.9 ;RETURN
MSZA.6: SKIPN TE,EWORDB ;ANY FULL WORDS LEFT?
JRST MSZA.3 ;NO
JRST MSZA.2 ;YES
;MOVE ZEROES TO AN EDITED FIELD
MZED.: PUSHJ PP,MCHED.
MOVEI TE,MZS.
MZED.1: PUSH PP,SW
SWOFF FBSUB;
PUSHJ PP,(TE)
POP PP,SW
MFCED.: MOVE TE,[XWD ESAVMA,EBASEA]
BLT TE,EBASBX
SWOFF FASIGN!FASUB;
JRST MDED.1
;MOVE SPACES TO AN EDITED FIELD
MSED.: PUSHJ PP,MCHED.
MOVEI TE,MLVD.
JRST MZED.1
;MOVE QUOTES TO AN EDITED FIELD
MQED.: PUSHJ PP,MCHED.
MOVEI TE,MQS.
JRST MZED.1
;MOVE HIGH-VALUES TO AN EDITED FIELD
MHVED.: MOVEI TE,MHVD.
JRST MLHVED
;MOVE LOW-VALUES TO AN EDITED FIELD
MLVED.: MOVEI TE,MLVD.
MLHVED: PUSH PP,TE
MOVE TA,ETABLB
PUSHJ PP,LNKSET
LDB TE,DA.USG
PUSHJ PP,@[EXP MCHED.,MLHED7,MLHED9]-1(TE)
POP PP,TE
JRST MZED.1
MLHED7: MOVE TE,[XWD EBASEB,ESAVMB]
BLT TE,ESVMBX
MOVEI TE,D7MODE
MOVEM TE,EMODEB
MOVE TE,[XWD ^D36,AS.MSC]
MOVEM TE,EBASEB
MOVE TE,ESIZEB
ADDI TE,4
IDIVI TE,5
JRST MCHED1
MLHED9: MOVE TE,[XWD EBASEB,ESAVMB]
BLT TE,ESVMBX
MOVEI TE,D9MODE
MOVEM TE,EMODEB
MOVE TE,[XWD ^D36,AS.MSC]
MOVEM TE,EBASEB
MOVE TE,ESIZEB
ADDI TE,3
IDIVI TE,4
JRST MCHED1
;CHANGE "B" PARAMETERS FROM EDITED TO DISPLAY, IN %TEMP.
MCHED.: MOVE TE,[XWD EBASEB,ESAVMB]
BLT TE,ESVMBX
MOVEI TE,D6MODE
MOVEM TE,EMODEB
MOVE TE,[XWD ^D36,AS.MSC]
MOVEM TE,EBASEB
MOVE TE,ESIZEB
ADDI TE,5
IDIVI TE,6
MCHED1: PUSHJ PP,GETEMP
HRRM EACC,EINCRB
MOVE TE,[XWD EBASEB,ESAVMA]
BLT TE,ESVMAX
POPJ PP,
;MOVE "TODAY" TO AN EDITED FIELD
IFN ANS74,<
MDTED.: MOVEI CH,0 ;DATE
JRST MTED.
MDYED.: MOVEI CH,1 ;DAY
JRST MTED.
MTIED.: MOVEI CH,2 ;TIME
>
MTED.: MOVEI TB,MDED.
JRST MTD.0
;MOVE "TODAY TO A DISPLAY FIELD
IFN ANS74,<
MDTD.: MOVEI CH,0 ;DATE
JRST MTD.
MDYD.: MOVEI CH,1 ;DAY
JRST MTD.
MTID.: MOVEI CH,2 ;TIME
>
MTD.: MOVEI TB,MDD.
MTD.0:
IFN ANS68,<
MOVE CH,[XWD EPJPP,TODAY.##]
>
IFN ANS74,<
PUSH PP,CH
MOVE CH,MTD.T(CH) ;GET WHICH IT IS
>
PUSHJ PP,PUTASY
MOVSI TA,^D36
MOVEM TA,EBASEA
SETZM EINCRA
MTD.1: TSWT FAS3 ;ARE WE IN NON-RESIDENT SEGMENT?
JRST MTD.2 ;NO
IFN ANS68,<
MOVEI TA,TODAY. ;YES--SET EXTAB FLAG FOR "TODAY."
>
IFN ANS74,<
MOVE TA,0(PP)
HRRZ TA,MTD.T(TA)
>
ANDI TA,77777
ADD TA,EXTLOC
MOVSI TE,1B18
IORM TE,1(TA)
MTD.2: SETZM EDPLA
IFN ANS68,<
MOVEI TA,^D12
>
IFN ANS74,<
POP PP,TA
MOVE TA,[EXP 6,5,8,^D12](TA)
>
MOVEM TA,ESIZEA
MOVEI TA,D6MODE
MOVEM TA,EMODEA
SWON FANUM;
SWOFF FASUB!FASIGN;
JRST (TB)
;MOVE "TODAY" TO A NON-DISPLAY FIELD
IFN ANS74,<
MDTC.: MOVEI CH,0 ;DATE
JRST MTC.
MDYC.: MOVEI CH,1 ;DAY
JRST MTC.
MTIC.: MOVEI CH,2 ;TIME
>
MTC.: MOVEI TB,MDC.
JRST MTD.0
IFN ANS74,<
MTD.T: EPJPP,,DATE.##
EPJPP,,DAY.##
EPJPP,,TIME.##
>
;GENERATE CODE TO MOVE A LITERAL TO A DISPLAY FIELD
MLD.:
;SPECIAL CASE CODE TO DETECT THE USER WHO WANTS TO
; DO A "MOVE ZEROS TO FOO" BUT HAS TYPED
; "MOVE 0 TO FOO". WE DETECT THAT THE LITERAL IS
; NUMERIC AND THEN LOOK AT ALL ITS BITS TO BE SURE
; IT IS ALL ZEROS.
IFN ANS74, TSWF FBNUM ;"B" MUST BE NUMERIC FOR THIS
TSWT FANUM ;SKIP WHEN NUMERIC ARG A
JRST MLD.ON ;ONWARD IF NOT NUMERIC LITERAL
MOVE TA, EBASEA ;GET THE ASCII FOR THE LITERAL
PUSHJ PP, LNKSET ;BY CALLING THE ROUTINE
HRLI TA, 440700 ;GENERATE BYTE POINTER AT ADDR
ILDB TB, TA ;GET NUMBER OF BYTES IN LITERAL
SKIPG TB ;TEST TO BE SURE ITS OK
JRST 4, . ;ERROR
ILDB TC, TA ;GET THE BYTE IN THE LITERAL
CAIE TC, 60 ;TEST TO SEE IF ITS A ZERO
JRST MLD.ON ;GO ONWARD IF NOT
SOJG TB, .-3 ;LOOP FOR ALL CHARS IN LITERAL
;ITS ALL ZEROS, SO GO TO THE ZEROS SPECIAL CASE ROUTINE
; FOR THE MODE OF THE DESTINATION.
HRRZ TB, ESIZEB ;LENGTH OF MOVE
MOVEM TB, ESIZEZ ;NEEDS TO BE IN ESIZEZ FOR SOME REASON
HRRZ TB, EMODEB ;GET MODE OF DEST
IFN ANS74,<
HLRZ TC, OPERND ;[1506] GET "A" OPERAND ADDRESS
MOVE TC, (TC) ;[1506] GET FIRST WORD
SKIPE FLGSW ;[1506] NO FLAGGER WANTED
TLNN TC, GNALL ;[1506] IF 'ALL 0', FLAG AS EXTENSION
>;
JRST @MZX.(TB) ;GO TO PROPER ROUTINE
IFN ANS74,<
MOVEI TC, @MZX.(TB) ;[1506] STORE ROUTINE'S ADDRESS
JRST MXX.6B ;[1506] SET UP FOR FLAGGER
>;
;GENERATE CODE TO MOVE A LITERAL TO A DISPLAY FIELD
; KNOWING THAT IT IS NOT THE SPECIAL CASE ZERO.
MLD.ON: MOVEI TE,MDD.
TSWF FANUM ;ARE BOTH "A"
TSWT FBNUM ;AND "B" NUMERIC?
JRST MLD.A ;NO
MOVE TD,ESIZEB ;ONE OR TWO WORDS
CAILE TD,^D10
JRST MLD.A ;FORGET IT
PUSHJ PP,MLAC1. ;GET LIT INTO ACC
TSWF FERROR ;IF ANY ERRORS,
POPJ PP, ;GO AWAY
HRRZ TD,EMODEB ;[1546]Get mode of "B" operand
JUMPE TC,@MZX.(TD) ;[1507][1546] MLAC1. DIDN'T GEN CODE IF LIT = 0
MLD.ZR: MOVEI TE,D1MODE
MOVEM TE,EMODEA ;CHANGE MODE OF "A"
CAMN TC,[-1] ;IF LITERAL WAS -1,
PUSHJ PP,MLAC1D ;GEN "MOVNI AC,1"
JUMPN TC,MACD. ;WRITE IT BACK TO MEMORY
PUSHJ PP,PUTASA
MOVSI CH,SETZ. ;MUST CLEAR AC IF ZERO
PUSHJ PP,PUT.XA
JRST MACD. ;AND WRITE IT TO MEMORY
IFN ANS74,<
; HERE IF "MOVE ZEROES TO DISPLAY-ITEM" WHEN DISPLAY-ITEM HAS A
;SEPARATE SIGN. DO A NUMERIC MOVE.
MLD.ZS: SETZB TC,TD ;FAKE A "0" LITERAL
JRST MLD.ZR
>;END IFN ANS74
MLD.A: PUSH PP,TE
IFE ANS74,< ;SEE NAVY TEST [NC105]
TSWT FANUM ;IS LITERAL NUMERIC?
>
TSWF FBNUM ;NO--IS RECEIVING FIELD NUMERIC?
JRST MLD.1 ;YES
HLRZ TA,OPERND ;IS "ALL" SPECIFIED?
MOVE TD,0(TA)
TLNE TD,GNALL
JRST MLD.2 ;YES
MOVE TE,ESIZEA ;IS LITERAL SMALLER THAN "B"?
CAML TE,ESIZEB
PJRST LITD. ;NO--PUT LITERAL IN LITAB
;THIS WILL TAKE US TO "MDD." OR "MDED."
SKIPGE EMODEB ;IS "B" JUSTIFIED RIGHT?
JRST MLD.3 ;YES
MOVE TE,[XWD EBASEB,ESAVEB] ;SAVE "B" PARAMETERS
BLT TE,ESAVBX
HLRZ TE,ERESB ;GET BYTE RESIDUE
HRRZ TC,EMODEB ;GET MODE OF "B"
IDIV TE,BYTE.S(TC) ;GET NO. OF BYTES LEFT
MOVN TD,TE
ADD TD,BYTE.W(TC) ;NO. USED BY PREVIOUS FIELD
PUSH PP,TD ;SAVE IT
MOVE TE,ESIZEA ;GET A'S SIZE.
ADD TE,TD ;PLUS PREVIOUS FIELD'S LEFTOVERS
IDIV TE,BYTE.W(TC) ;NO. OF FULL WORDS FOR LITERAL
SKIPE TD ; ANY REMAINING CHARS
ADDI TE,1 ; NEEDS 1 MORE WORD
ADDM TE,ESAVEB+EINCRX ;RESET "B" ORIGIN
ADDI TE,2 ;NOT WORTH EFFORT UNLESS AT LEAST 2 FULL WORDS EXTRA
IMUL TE,BYTE.W(TC) ;GET NO. OF CHARACTERS
POP PP,TD ;GET BACK RESIDUE BYTES
SUB TE,TD ;REMOVE SINCE WE DON'T OWN THEM
CAMLE TE,ESIZEB ;IS MODIFIED LIT STILL SMALLER
JRST LITD. ;NO, SO USE OLD CODE
SUB TE,BYTE.W(TC) ;OK, SO REMOVE EXCESS WORDS
SUB TE,BYTE.W(TC) ; ...
MOVEM TE,ESIZEB ;RESET SIZE OF "B" TO MATCH LITERAL
MOVN TE,TE
ADDM TE,ESAVEB+ESIZEX ;RESET "B" SIZE FOR REMAINDER
POP PP,TE ;GET RID OF RETURN PUT ON AT MLD.
PUSHJ PP,LITD. ;CREATE LITERAL
PUSHJ PP,MDD.3 ;CREATE MOVE FOR FIRST PART
IFN ANS74,<
PUSH PP,EDEBDB ;ONLY GENERATE SUBSCRIPT DEBUGGING STUFF ONCE
SETZM EDEBDB
>
;NOW GENERATE MOVE SPACES TO "B"
MOVE TE,[XWD ESAVEB,EBASEB]
BLT TE,EBASBX
MOVEI TE,44
HRLM TE,ERESB ;IS NOW WORD ALIGNED
MOVS TE,[EBASEA,,[0 ;EBASEA
0 ;EINCRA
0 ;ESIZEA
FCMODE ;EMODEA
0 ;EDPLA
0 ;EBYTEA
0 ;ETABLA
1]] ;EFLAGA
BLT TE,EBASAX
IFN ANS68,<
JRST MXX.6 ;MOVE SPACES TO REMAINDER
>
IFN ANS74,<
PUSHJ PP,MXX.6
POP PP,EDEBDB
POPJ PP,
>
;"B" IS RIGHT JUSTIFIED, FILL WITH SPACES FIRST
MLD.3: MOVE TE,[EBASEA,,ESAVEA]
BLT TE,ESAVBX ;SAVE "A" AND "B"
HLRZ TE,ERESB ;GET BYTE RESIDUE
HRRZ TC,EMODEB ;GET MODE OF "B"
IDIV TE,BYTE.S(TC) ;GET NO. OF BYTES LEFT
MOVN TD,TE
ADD TD,BYTE.W(TC) ;NO. USED BY PREVIOUS FIELD
PUSH PP,TD ;SAVE IT
MOVE TE,ESIZEB ;SIZE OF "B"
SUB TE,ESIZEA ;"B" - "A" = SPACES
ADD TE,TD ;PLUS PREVIOUS FIELD'S LEFTOVERS
IDIV TE,BYTE.W(TC) ;NO. OF FULL WORDS FOR LITERAL
ADDM TE,ESAVEB+EINCRX ;RESET "B" ORIGIN
SUBI TE,2 ;NOT WORTH EFFORT UNLESS AT LEAST 2 FULL WORDS EXTRA
IMUL TE,BYTE.W(TC) ;GET NO. OF CHARACTERS
POP PP,TD ;GET BACK RESIDUE BYTES
SUB TE,TD ;REMOVE SINCE WE DON'T OWN THEM
JUMPLE TE,LITD. ;USE OLD CODE IF NOT WORTH THE EFFORT
ADD TE,BYTE.W(TC) ;OK, SO REMOVE EXCESS WORDS
ADD TE,BYTE.W(TC) ; ...
MOVEM TE,ESIZEB ;RESET "B" SIZE FOR FILL
MOVN TE,TE
ADDM TE,ESAVEB+ESIZEX ;RESET SIZE OF "B" TO MATCH LITERAL
MOVS TE,[EBASEA,,[0 ;EBASEA
0 ;EINCRA
0 ;ESIZEA
FCMODE ;EMODEA
0 ;EDPLA
0 ;EBYTEA
0 ;ETABLA
1]] ;EFLAGA
BLT TE,EBASAX
PUSHJ PP,MXX.6 ;FILL WITH SPACES
IFN ANS74,<
PUSH PP,EDEBDB ;ONLY GENERATE SUBSCRIPT DEBUGGING STUFF ONCE
SETZM EDEBDB
>
;NOW GENERATE MOVE OF SECOND PART
MOVE TE,[XWD ESAVEA,EBASEA]
BLT TE,EBASBX
MOVEI TE,44
HRLM TE,ERESB ;IS NOW WORD ALIGNED
IFN ANS68,<
JRST MLD.3 ;DO IT
>
IFN ANS74,<
PUSHJ PP,MLD.3
POP PP,EDEBDB
POPJ PP,
>
MLD.1: PUSHJ PP,LITN. ;GET A NUMERIC LITERAL
TSWF FERROR ;ANY ERRORS?
POP PP,TE ;YES--DON'T GENERATE CODE
POPJ PP,
;MOVE "ALL" LITERAL
;3-MAY-79 /DAW: MOVE ALL "LIT" TO RIGHT-JUSTIFIED ITEM
; SHOULD MOVE THE SAME THING AS MOVE ALL "LIT" TO LEFT-J ITEM.
; THIS WAS CLARIFIED IN ANS74 STANDARD AND APPLIES TO ALL COBOLS.
; OUR COMPILER HAS BEEN DOING IT WRONG UNTIL NOW: NOT TESTED
;BY NAVY OR OUR TEST SYSTEM, THOUGH.. AND NO ONE EVER COMPLAINED.
MLD.2: MOVSI TE,(1B0) ;CLEAR "RIGHT JUSTIFIED" FLAG IF SET
ANDCAM TE,EMODEB ;SO THE SAME THINGS WILL BE MOVED
; IN EITHER CASE.
MOVE TE,ESIZEA ;IS LITERAL SMALLER THAN "B"?
CAML TE,ESIZEB
PJRST LITD. ;NO--PUT LITERAL IN LITAB
;THIS WILL TAKE US TO "MDD." OR "MDED."
POP PP,TE ;GET RID OF RETURN PUT ON AT MLD.
PUSHJ PP,DEPTSB ;SKIP IF "B" HAS A DEPENDING ITEM
CAIA ;NO
JRST MVADEP ;YES, GO TO SPECIAL CODE
PUSH PP,SW ; [147] SAVE SUBCRIPT STATUS OF B PARAM.
MOVE TE,[XWD EBASEB,ESAVEB] ;SAVE "B" PARAMETERS
BLT TE,ESAVBX
MOVE TE,ESIZEA ;RESET SIZE OF "B" TO MATCH LITERAL
MOVEM TE,ESIZEB
PUSH PP,TE ;SAVE SIZE OF LITERAL
PUSHJ PP,LITD. ;CREATE LITERAL
PUSHJ PP,MDD.3 ;CREATE MOVE FOR FIRST PART
POP PP,ESIZEZ ;SIZE OF INITIAL MOVE IN ESIZEZ
MOVE TE,[XWD ESAVEB,EBASEA]
BLT TE,EBASAX
MOVN TB,ESIZEB
ADDM TB,ESIZEA
MOVE TE,[XWD EBASEA,EBASEB]
BLT TE,EBASBX
;GENERATE CODE TO MOVE "ALL LITERAL" (CONT'D).
POP PP,SW ;[147] RETRIEVE SUBSCRIPT STATUS OF 'B'.
TSWF FBSUB ;IF 'B' SUBSCRIPTED,
SWON FASUB ; SO IS NEW 'A'
HRLS OPERND
MOVM TE,TB
PUSHJ PP,M.IB
MOVE TE,ESIZEB
EXCH TE,ESIZEZ
; GENERATE AN ILDB/IDPB/SOJG LOOP.
;CHECK FOR SPECIAL CASE OF SINGLE CHARACTER LITERAL SINCE
;IT IS ALREADY IN AC4
CAIN TE,1 ;IS IT 1 CHARACTER?
JRST MLD.6B ;YES
PUSHJ PP,NB2PAR ;GET BYTE POINTERS INTO ACS 5 AND 10
HRRZ CH,ESIZEZ ;GET SIZE
CAILE CH,77777 ;SMALL?
SKIPA CH,[MOVEI.+AC7+ASINC,,AS.CNB]
HRLI CH,MOVEI.+AC7
PUSHJ PP,PUTASY ;GENERATE "MOVEI AC7,SIZE"
HRRZ CH,ESIZEZ ;
CAILE CH,77777
PUSHJ PP,PUTASN ;
MOVE CH,[ILDB.+AC4,,5] ;GENERATE "ILDB AC4,AC5"
PUSHJ PP,PUTASY ;
MOVE CH,[IDPB.+AC4,,10] ;GENERATE "IDPB AC4,,AC10"
PUSHJ PP,PUTASY ;
MOVE CH,[SOJG.+AC7+ASINC,,AS.MS2]
PUSHJ PP,PUTASY ;GENERATE "SOJG AC7,.-2"
MOVEI CH,AS.DOT+2 ;(AS.MS2 SPECIFIES NEGATIVE INCREMENT)
JRST PUTASN ; AND GO HOME
MLD.6B: PUSHJ PP,NBBPAR ;GET BYTE POINTER TO "B" INTO AC10
HRRZ TD,ESIZEZ ;GET SIZE
CAIG TD,3 ;MORE THAN 3
JRST MLD.6C ;NO, JUST DO INLINE
HRRZ CH,ESIZEZ ;GET SIZE
CAILE CH,77777 ;SMALL?
SKIPA CH,[MOVEI.+AC7+ASINC,,AS.CNB]
HRLI CH,MOVEI.+AC7
PUSHJ PP,PUTASY ;GENERATE "MOVEI AC7,SIZE"
HRRZ CH,ESIZEZ ;
CAILE CH,77777
PUSHJ PP,PUTASN ;
MOVE CH,[IDPB.+AC4,,10] ;[575] GENERATE "IDPB AC4,AC10"
PUSHJ PP,PUTASY ;
MOVE CH,[SOJG.+AC7+ASINC,,AS.MS2]
PUSHJ PP,PUTASY ;"SOJG 7,.-1"
MOVEI CH,AS.DOT+1
JRST PUTASN ;... AND WE'RE DONE
MLD.6C: MOVE CH,[IDPB.+AC4,,10] ;[575] GENERATE "IDPB AC4,AC10"
PUSHJ PP,PUTASY ;
SOJG TD,MLD.6C ;LOOP IF MORE TO DO
POPJ PP,
;HERE FOR "MOVE 'LIT' TO B" WHERE B IS A DEPENDING VARIABLE
; AND MAX SIZE OF B IS GREATER THAN THE LITERAL SIZE
MVADEP: HRRZ TE,ESIZEA ;GET SIZE OF LITERAL
CAIN TE,1 ; IF JUST 1 CHAR,
JRST MVALDS ;DO IT REAL EFFICIENTLY
PUSH PP,ESIZEB ;SAVE REAL SIZE OF B
MOVE TE,ESIZEA
MOVEM TE,ESIZEB ;MAKE A LITERAL WITH NO SPACE FILLER
PUSHJ PP,LITD. ; ** PUT LITERAL INTO LITAB **
POP PP,ESIZEB ; AND RESTORE SIZE OF B
MOVEI TE,7 ;SETUP AC7 = SIZE OF B
PUSHJ PP,SZDPVB## ; (ROUTINE IN CMNGEN)
POPJ PP, ;ERRORS-- FORGET IT
PUSHJ PP,NB2PAR## ;SETUP AC5 & AC10 (BYTE PTRS TO "A" & "B")
HRRZ CH,ESIZEA
HRLI CH,MOVEI.+AC4
PUSHJ PP,PUTASY ;"MOVEI AC4,SIZE OF LITERAL"
MOVEI CH,MVD.AL##
PJRST PUT.PJ ;"PUSHJ PP,MVD.AL" THEN DONE
;HERE FOR "MOVE ALL 'A' TO DEPENDING VARIABLE" (1 CHAR LITERAL)
MVALDS: MOVEI TE,7 ;USE RUNTIME AC 7
PUSHJ PP,SZDPVB## ; SET AC7= SIZE OF "B"
POPJ PP, ; ? ERRORS-- FORGET IT
PUSHJ PP,NBBPAR## ;SETUP AC10 = B PTR
;GEN "MOVEI 4,CHAR" - THE 1 CHAR LITERAL
;GET A CHAR IN THE MODE WE WANT
ILDB CH,EBYTEA ;GET THE CHARACTER IN ASCII
HRRZ TE,EMODEB ;TE= MODE TO CONVERT IT TO
CAIN TE,D6MODE
JRST MVA76 ;CONVERT TO SIXBIT
CAIE TE,D9MODE ;SKIP IF EBCDIC
JRST MVA77 ;GOT CHAR VALUE IN CH
;EBCDIC CHARACTER
MOVEI TE,(CH) ;SET UP FOR VLIT8. CALL
PUSHJ PP,VLIT8.## ;CONVERT THE CHAR
LDB CH,[POINT 9,TE,35] ;GET IT IN CH (THERE MAY BE 2 CHARS.)
JRST MVA77
;MAKE CHAR SIXBIT
MVA76: MOVEI TE,(CH)
PUSHJ PP,VLIT76## ;CONVERT THE CHAR
MOVEI CH,(TE) ;BACK INTO CH
MVA77: HRLI CH,MOVEI.+AC4
PUSHJ PP,PUTASY
MOVE CH,[IDPB.+AC4,,10] ;"IDPB 4,10"
PUSHJ PP,PUTASY
MOVE CH,[SOJG.+AC7+ASINC,,AS.MS2]
PUSHJ PP,PUTASY
MOVEI CH,AS.DOT+1
PJRST PUTASN ;"SOJG 7,.-1" THEN DONE
;MOVE LITERAL TO EDITED FIELD
MLED.: MOVE TA,ETABLB ;RESET MODE
PUSHJ PP,LNKSET
LDB TA,DA.USG
SUBI TA,1
HRRM TA,EMODEB
MOVEI TE,MDED.
JRST MLD.A
;GENERATE CODE TO MOVE A LITERAL TO A 1-WORD COMP
ML1C.: PUSHJ PP,MLAC1.
CAMN TC,[-1] ;IS IT -1?
JRST MZC11. ;YES, GEN A "SETOM"
JUMPN TC,MAC1C.
JRST MZC1.
MLAC1.: MOVEI LN,EBASEA ;[1507]
PUSHJ PP,CONVNL ;[1507] CONVERT THE LITERAL TO BINARY
TSWF FERROR ;[1507] CONTINUE IF NO ERROR
POPJ PP, ;[1507]
SKIPG ESIZEA ;[1507] ANYTHING LEFT IN LITERAL?
JRST MLAC1A ;[1507] NO
TSWF FANUM ;[1507] NO QUOTED LITERALS
JUMPE TC,CPOPJ ;[1507] IF LITERAL = 0, EXIT NOW
HLRZ TA,OPERND ;[621] IS "ALL" SPECIFIED?
MOVE TB,0(TA) ;[1510][621]
TLNE TB,GNALL ;[1510][621]
JRST BADALL## ;[621] YES
PUSHJ PP,ADJLIT
TSWF FERROR ;ANY ERRORS SO FAR?
POPJ PP, ;YES--QUIT
TSWF FBSIGN ;IS "B" SIGNED?
TSWT FLNEG ;YES--IS LITERAL NEGATIVE?
SKIPA TB,TC ;NO
JRST MLAC1B ;NEGATIVE--CHECK FOR -1
MLAC1D: MOVSI TA,D1LIT
JRST GENM39 ;GENERATE CODE TO GET LITERAL INTO AC AND RETURN
MLAC1B: CAIN TC,1 ;-1?
JRST MLAC1C ;YES
MOVN TB,TC ;NO, GET NEGATIVE OF LITERAL
JRST MLAC1D
MLAC1A: PUSHJ PP,NOSIZ.
TDZA TC,TC ;ZERO TC
MLAC1C: SETOB TC,TB ;GET -1 IN BOTH WORDS
POPJ PP, ;RETURN
;GENERATE CODE TO MOVE A LITERAL TO A 2-WORD COMP
ML2C.: PUSHJ PP,MLAC2.
MOVE TE,ESIZEB
MOVEM TE,ESIZEA
MOVE TE,EDPLB
MOVEM TE,EDPLA
CAMN TD,[-1] ;TEST FOR ALL ONES
JRST ML2CA ;YES, GENERATE SETOM
JUMPN TD,MAC2C.
JUMPE TC,MZC2.
PUSHJ PP,SUBSCB ; [301] SUBSCRIPT COMP ITEM IF NECCESSARY
PUSHJ PP,GENM16
JRST MAC2C4
ML2CA: PUSHJ PP,SUBSCB
PUSHJ PP,GENM17
JRST MAC2C4
;GENERATE CODE TO MOVE A LITERAL TO COMP-1
;MAKE SPECIAL CHECK FOR LITERAL 0
MLFP.: PUSHJ PP,CONVFP ;GET LITERAL INTO TC & TD
TRNE FANUM ;[1507] "0" IS NOT ZERO
JUMPE TC,MZC1. ;0 IS SAME AS ZERO
PUSHJ PP,MFP%L0 ;NOT ZERO, GENERATE LITERAL
PUSH PP,TC ;[1507] SAVE LITERAL
HLRZ TA,OPERND ;[1507] GET THE ADDRESS OF SRC OPERAND
MOVE TD,0(TA) ;[1507] GET FIRST WORD
TLNE TD,GNALL ;[1507] WAS 'ALL' SPECIFIED?
PUSHJ PP,BADALL## ;[1507] NOT ALLOWED
POP PP,TC ;[1507] RESTORE LITERAL
PUSHJ PP,MLTAC7
JRST MAC1C2
;GENERATE CODE TO MOVE A LITERAL TO A COMP-3 ITEM.
MLC3.: MOVE TE, ESIZEB ;IF THE COMP-3 ITEM HAS FEWER
CAIG TE, ^D10 ; THAN 10 DIGITS
JRST MLC3.1 ; GO ON.
PUSHJ PP, MLAC2. ;OTHERWISE, GENERATE CODE TO
; MOVE THE LITERAL TO THE AC'S.
CAMN TD,[-1] ;ALL ONES?
JRST .+3 ;MUST SET HIGH ORDER WORD TO -1
JUMPN TD, MACC3. ;IF THE LITERAL IS NOT ZERO GO
; GENERATE CODE TO STORE IT.
JUMPE TC, MZC3. ;IF IT IS ZERO, GO MOVE ZEROES
; INTO IT.
;THE HIGH ORDER WORD IS ZERO OR -1 BUT THE LOW ORDER WORD ISN'T, SO WE
; HAVE TO CLEAR OR SET THE HIGH ORDER WORD.
PUSHJ PP,PUTASA ;SETZ OR SETO - BOTH IN 2ND CODE SET
MOVSI CH,SETZ. ;ASSUME CLEARING HIGH ORDER WORD
SKIPE TD
MOVSI CH,SETO. ;SET IT TO -1
PUSHJ PP,PUT.XA ;GO WRITE OUT "SETX AC,"
PJRST MACC3. ;NOW GO MOVE THE AC'S TO THE
; COMP-3 FIELD.
MLC3.1: PUSHJ PP, MLAC1. ;GENERATE CODE TO MOVE THE
; LITERAL TO ONE AC.
CAMN TC, [-1] ;DID IT RETURN BECAUSE OF -1?
PUSHJ PP, MLAC1D ;YES, GEN "MOVNI AC,1"
JUMPN TC, MACC3. ;IF THE LITERAL IS NOT ZERO GO
; GENERATE CODE TO STORE IT.
JRST MZC3. ;OTHERWISE GO MOVE ZEROES TO
; THE COMP-3 ITEM.
;GENERATE CODE TO MOVE A LITERAL TO 2-WORD AC'S.
MLAC2.: MOVEI LN,EBASEA ;GET LITERAL INTO TD&TC
PUSHJ PP,CONVNL
TSWF FERROR ;ANY ERRORS?
POPJ PP, ;YES--QUIT
PUSHJ PP,ADJLIT ;NO--ADJUST LITERAL TO MATCH "B"
TSWF FERROR ;ANY ERRORS SO FAR?
POPJ PP, ;YES--QUIT
SKIPG ESIZEA ;ANY SIZE LEFT?
JRST ML2C.3
TSWF FBSIGN ;IS "B" SIGNED?
TSWT FLNEG ;YES--IS LITERAL NEGATIVE?
SKIPA ;NO
PUSHJ PP,NEGATL ;YES--NEGATE THE LITERAL
ML2C.1: CAMN TD,[-1] ;IS LITERAL HIGH WORD ALL ONES?
JRST .+3 ;YES
JUMPN TD,ML2C.4 ;IS LITERAL ZERO?
JUMPE TC,CPOPJ ;YES IF JUMP
MOVEM TC,ELITLO ;NO--BUT LEFT HALF IS ZERO OR -1
MOVEM TD,ELITHI
MOVE TB,TC ;GENERATE <MOVE AC+1,[LOW ORDER PART]>
PUSHJ PP,GENM38
MOVE TC,ELITLO
MOVE TD,ELITHI
POPJ PP,
ML2C.3: PUSHJ PP,NOSIZ. ;LITERAL ENDED UP WITH NO SIZE
SETZB TC,TD
POPJ PP,
ML2C.4: MOVE TA,[XWD D2LIT,2] ;STASH AWAY A 2-WORD LITERAL
PUSHJ PP,STASHP
MOVE TA,TD
PUSHJ PP,STASHQ
MOVE TA,TC
PUSHJ PP,POOLIT
SKIPE TE,PLITPC
JRST .+4
MOVEI TE,2 ;SET "A" TO POINT TO THE LITERAL
EXCH TE,ELITPC
ADDM TE,ELITPC
IORI TE,AS.LIT
MOVEM TE,EINCRA
MOVEI TE,AS.MSC
HRRM TE,EBASEA
JRST M2CAC2
;GENERATE CODE TO MOVE A 1-WORD COMPUTATIONAL, COMP-1 OR INDEX ITEM TO
;ACCUMULATOR SPECIFIED IN "EAC", PLUS 1.
MFPAC.:
M1CAC.: PUSHJ PP,SUBSCA ;DO ANY SUBSCRIPTING
MOVSI CH,MOV ;ASSUME "A" IS SIGNED
TSWT FASIGN; ;IS "A" SIGNED?
MOVSI CH,MOVM. ;NO--USE "MOVM"
JRST PUT.AA ;GENERATE CODE AND RETURN
;GENERATE CODE TO MOVE A COMP-1 TO ACCUMULATOR SPECIFIED IN "EAC"
;AND ZERO THE SECOND WORD
MFPAC2: PUSHJ PP,SUBSCA ;DO ANY SUBSCRIPTING
MOVSI CH,MOV ;ASSUME "A" IS SIGNED
TSWT FASIGN; ;IS "A" SIGNED?
MOVSI CH,MOVM. ;NO--USE "MOVM"
PUSHJ PP,PUT.AA ;GENERATE CODE
PUSHJ PP,PUTASA
MOVSI CH,SETZ. ;[736]
MOVEI TD,F2MODE ;[1113] CHANGE MODE FROM COMP-1
MOVEM TD,EMODEA ;[1113] TO COMP-2.
SWOFF FASUB ;[1113] TURN OFF SUBSCRIPT FLAG SINCE IN ACCS.
JRST PUT.XB
;GENERATE CODE TO MOVE A 2-WORD COMPUTATIONAL OR COMP-2 ITEM TO
;ACCUMULATORS SPECIFIED IN "EAC"
MF2AC.:
M2CAC.: PUSHJ PP,SUBSCA ;DO ANY SUBSCRIPTING
TSWT FASIGN; ;IS "A" SIGNED?
JRST M2CAC1 ;NO
M2CAC2:
IFN BIS,<
PUSHJ PP,PUTASA## ;SIGNAL ALTERNATE CODE SET
MOVSI CH,DMOVE.## ;THEN WE CAN DO KI INST
JRST PUT.AA ;ALSO
>
IFE BIS,<
MOVSI CH,MOV ;YES--GENERATE <MOVE AC,EBASEA>
PUSHJ PP,PUT.AA
MOVSI CH,MOV ;GENERATE <MOVE AC+1,EBASEA+1> AND RETURN
MOVE TE,EAC
ADDI TE,1
DPB TE,CHAC
AOS EINCRA
JRST PUT.A
>
M2CAC1:
IFE BIS,<
MOVSI CH,MAG.## ;"A" UNSIGNED--GENERATE <MAG. AC,EBASEA> AND RETURN
JRST PUT.AA
>
IFN BIS,<
PUSHJ PP,PUTASA
MOVSI CH,DMOVE.
PUSHJ PP,PUT.AA
MOVSI CH,SKPGE.##
HRR CH,EAC
PUSHJ PP,PUTASY
PUSHJ PP,PUTASA
MOVSI CH,DMOVN.
HRR CH,EAC
JRST PUT.XA
>
;MOVE A FIELD TO AC'S AND CONVERT TO FLOATING POINT
MXFPA.: HRRZ TE,EMODEA
CAIN TE,FPMODE
JRST MFPAC.
CAIN TE,LTMODE ;A LITERAL?
IFE BIS, JRST MLTAC6 ;YES, GET COMP-1
IFN BIS, JRST MLTAC8 ; OR COMP-2
CAIN TE,F2MODE ;COMP-2?
JRST MF2AC. ;YES
CAILE TE,DSMODE
TSWT FASIGN;
JRST MXFPA4
CAIE TE,C3MODE ;IF IT IS COMP-3
TSWF FASUB ; OR SUBSCRIPTED,
JRST MXFPA4 ; GET IT IN THE AC'S.
MXFPA2: HRRZ TE,EMODEA
MOVEI TD,FPMODE
MOVEM TD,EMODEA
SWON FASIGN!FANUM;
IFE BIS,<
MOVSI CH,FLOT.1
CAIN TE,D2MODE
MOVSI CH,FLOT.2
>
IFN BIS,<
MOVSI CH,FLOT.2
CAIN TE,D2MODE
JRST MXFPA3
PUSHJ PP,PUTASA
MOVSI CH,FLTR.
MXFPA3:>
PUSHJ PP,PUT.AA
SWOFF FASUB;
MOVN TD,EDPLA
JRST GENFPL
MXFPA4: PUSHJ PP,MXAC.
MOVE TE,EAC
MOVEM TE,EBASEA
SETZM EINCRA
JRST MXFPA2
;MOVE A FIELD TO AC'S AND CONVERT TO D.P. FLOATING POINT (COMP-2)
MXF2A.: HRRZ TE,EMODEA
CAIN TE,FPMODE
JRST MFPAC2 ;COMP-1
CAIN TE,F2MODE ;COMP-2?
JRST MF2AC. ;YES
CAIE TE,D1MODE ;1-WORD COMP OR
CAIN TE,D2MODE ;2-WORD COMP IS OK
TRNA
JRST MXF2A4
TSWF FASIGN ;UNLESS UNSIGNED
TSWF FASUB ; OR SUBSCRIPTED,
JRST MXF2A4 ; GET IT IN THE AC'S.
MXF2A2: HRRZ CH,EAC
DPB CH,CHAC ;GET ACC FIELD
HRRI CH,EBASEA ;POINT TO "A"
SKIPE EINCRA ;ANY INCREMENT
TLO CH,ASINC ;YES
PUSHJ PP,PUT.16 ;OUTPUT MOVX 16,"A"
HRRZ TE,EMODEA
MOVEI CH,FLT.12
CAIN TE,D2MODE
MOVEI CH,FLT.22
PUSHJ PP,PUT.PJ
MOVEI TD,F2MODE
MOVEM TD,EMODEA
SWON FASIGN!FANUM;
SWOFF FASUB;
MOVN TD,EDPLA
JRST GENF2L
MXF2A4: PUSHJ PP,MXAC.
MOVE TE,EAC
MOVEM TE,EBASEA
SETZM EINCRA
JRST MXF2A2
;GENERATE CODE TO MOVE A DISPLAY OR COMP-3 FIELD TO AC'S
;GENERATE PARAMETER
MC3AC.:
MDAC.: MOVE TE,ESIZEA
MOVEM TE,ESIZEZ
IFN BIS,<
HRRZ TE,EMODEA
CAIN TE,C3MODE ;COMP-3?
JRST MDAC.E ;YES, MUST USE GC3%
PUSHJ PP,NB1PAR## ;NO! SETUP AC5=BYTE PTR TO "A"
;GEN "MOVEI 4,<SIZE>"
;THE FOLLOWING ANS74 CODE IS COMMENTED OUT. IF THE VALUE IS "+001" OR "001-"
; WE HAVE TO LOOK AT ALL 4 CHARACTERS TO GET THE SIGN AND VALUE RIGHT!!
; SIMILAR CODE IS COMMENTED OUT AT MDAC.E+FEW
;IFN ANS74,<
; SKIPGE EFLAGA ;SEPARATE SIGN?
; SOSA CH,ESIZEA ;YES, 1 CHAR LESS
;>;END IFN ANS74
MOVE CH,ESIZEZ ;GET SIZE
CAILE CH,77777 ;SMALL?
SKIPA CH,[MOVEI.+AC4+ASINC,,AS.CNB]
HRLI CH,MOVEI.+AC4
PUSHJ PP,PUTASY##
MOVE CH,ESIZEZ
CAILE CH,77777
PUSHJ PP,PUTASN##
;GEN "MOVE SW,[XWD FLAGS,BYTE.SIZE]"
HRRZ TE,EMODEA
HRRZ TA,BYTE.S(TE) ;GET BYTE SIZE
PUSHJ PP,SETMDA ;SET MODE TO 1-WD COMP OR 2-WD COMP
TSWF FASIGN
TLO TA,(1B0) ;SIGNED--TURN ON BIT 0 IN FLAGS
HRRZ TB,EMODEA ;GET NEW MODE
CAIN TB,D2MODE ;2-WD COMP?
TLO TA,(1B1) ;YES--SET BIT 1 IN FLAGS
PUSH PP,TA ;SAVE XWD
TLNE TA,-1 ;IS LH=0?
JRST HAVFLG ;NO, PUT IN LITTAB
MOVE CH,TA ;GET SIZE
CAILE CH,77777 ;SMALL CONST.?
SKIPA CH,[MOVEI.+AC14+ASINC,,AS.CNB]
HRLI CH,MOVEI.+AC14 ;YES
PUSHJ PP,PUTASY##
POP PP,CH
CAILE CH,77777
PUSHJ PP,PUTASN##
JRST GENCVT
;GENERATE "MOVE SW,%LITNN"
HAVFLG: MOVE TA,[XWD XWDLIT,2]
PUSHJ PP,STASHP
HLLZ TA,(PP) ;GET LH OF XWD
HRRI TA,AS.CNB ;LARGE CONSTANT
PUSHJ PP,STASHQ
POP PP,TA
TLZ TA,-1 ;GET RH OF XWD
PUSHJ PP,POOLIT ;FINISH LITERAL
MOVSI CH,MOV+AC14
PUSHJ PP,PUT.LD## ;GEN THE MOVE
SKIPN PLITPC ;DID WE POOL IT?
AOS ELITPC ;NO, BUMP LITERAL PC
;[12B] GENERATE CALL TO SEP SIGN ROUTINES, IF NECESSARY
GENCVT:
IFN ANS74,<
SKIPL EFLAGA ;SKIP IF SEPARATE SIGN
JRST GENCV2 ;NO, NORMAL CASE
MOVEI CH,CVDBL.## ;ASSUME LEADING SIGN
MOVE TE,EFLAGA ;GET FLAGS FOR "A"
TLNN TE,LDN.SN ;LEADING?
MOVEI CH,CVDBT.## ;NO, TRAILING - USE THIS ROUTINE
GENCV1: SKIPA ;SKIP OVER MOVEI
GENCV2:
>;END IFN ANS74
MOVEI CH,CVTDB.##
PUSHJ PP,PUT.PJ ;"PUSHJ PP,CVTDB."
;GENERATE INSTRUCTION TO STORE RESULT INTO CORRECT AC'S
HRRZ TA,EMODEA
SKIPE ESAFLG## ;JUST LEAVE WHERE IT IS?
JRST [MOVEI TE,10 ;YES
CAIN TA,D2MODE ;2-WD?
MOVEI TE,7 ;YES
MOVEM TE,EAC ;BUT POINT TO IT
POPJ PP,]
CAIN TA,D2MODE
JRST STR2WD ;2-WD RESULT
MOVE CH,[MOV,,10] ;GET "MOVE AC,10"
JRST PUT.XA##
STR2WD: PUSHJ PP,PUTASA## ;GET "DMOVE AC,7"
MOVE CH,[DMOVE.,,7]
JRST PUT.XA
>;END IFN BIS
MDAC.E: PUSHJ PP,B1PAR
TSWF FASUB ;IS IT GOING TO BE IN SXR?
SETZI EACC, ;YES, REMEMBER THAT.
HRRZ TE,EMODEA ;GET THE MODE.
HLRZ CH,GDNPDN(TE) ;SELECT THE APPROPRIATE CONVERSION ROUTINE.
CAIGE TE,D1MODE ;[636] MAKE SURE ITS IN RANGE
JRST MDAC.F ;[636] OK
CAIE TE,C3MODE ;[636] WAS IT COMP-3?
POPJ PP, ;[636] MUST BE ERROR, GIVE UP
HRRZI CH,GC3%## ;YES, USE GC3. THEN.
MDAC.F:
; SEE @MDAC.+ FEW
;IFN ANS74,<
; SKIPGE EFLAGA ;SEPARATE SIGN?
; SOS ESIZEA ;YES, 1 CHAR LESS DATA
;>
PUSHJ PP,SETMDA ;SET MODE OF "A" TO BE COMP-1 OR COMP-2
PJRST PMOPU.## ;GO WRITE OUT THE CALL AND RETURN.
SETMDA: MOVEI TB,D1MODE
MOVE TE,ESIZEA ;IS SIZE OF "A" LESS THAN 11?
CAILE TE,^D10
MOVEI TB,D2MODE ;NO--IT IS TO BE 2-WORD COMP
MOVEM TB,EMODEA
POPJ PP,
;GENERATE CODE TO MOVE AC'S TO A 1-WORD COMP OR INDEX.
MAC1C.: PUSHJ PP,CUTCX ;[1442] CUT DOWN INTEGER PLACES IF NECESSARY
JFCL ;DON'T CARE IF IT DID
MAC1C1: MOVE TC,ESIZEA ;SEE WHAT A'S SIZE IS NOW.
CAIG TC,^D10
JRST MAC1CI ;IT'S ONLY ONE WORD.
PUSHJ PP,ADJ2C. ;IT'S TWO WORDS.
JRST MAC1CJ ;[766] MAKE SURE WE BUMP THE AC.
MAC1CI: PUSHJ PP,ADJ1C.
MOVE TC,ESIZEA ;[766] GET SIZE AGAIN
CAILE TC,^D10 ;[766] INCASE IT INCREASED TO 2 WORDS
MAC1CJ: AOS EAC ;[766] YES IT DID, RESULT IN ACC+1
MAC1C2: PUSHJ PP,SUBSCB ;DO ANY SUBSCRIPTING
MOVSI CH,MOVEM. ;ASSUME "B" IS SIGNED.
TSWT FBSIGN; ;IS "B" SIGNED?
MOVSI CH,MOVMM. ;NO--USE "MOVMM"
JRST PUT.BA ;GENERATE INSTRUCTION AND RETURN
;GENERATE CODE TO MOVE AC'S TO A 2-WORD COMP.
MAC2C.: PUSHJ PP,CUTC2 ;CUT DOWN INTEGER PLACES, IF NECESSARY
JFCL ;DON'T CARE IF IT DID.
PUSHJ PP,ADJ2C. ;ADJUST DECIMAL PLACES
HRRZ TE,EMODEA ;IS "A" NOW
CAIN TE,D1MODE ; ONE WORD?
PUSHJ PP,CC1C2. ;YES--CONVERT TO TWO WORDS
MAC2C1: PUSHJ PP,SUBSCB ;DO ANY SUBSCRIPTING
TSWT FBSIGN; ;IS "B" SIGNED?
JRST MAC2C3
MAC2C2:
IFN BIS,<
PUSHJ PP,PUTASA##
MOVSI CH,DMOVM.##
JRST PUT.BA
>
IFE BIS,<
MOVSI CH,MOVEM. ;YES--GENERATE <MOVEM AC,EBASEB>
PUSHJ PP,PUT.BA
>
MAC2C4: MOVSI CH,MOVEM. ;GENERATE <MOVEM AC+1,EBASEB+1> AND RETURN
MOVE TE,EAC
ADDI TE,1
DPB TE,CHAC
AOS EINCRB
JRST PUT.B
MAC2C3: TSWT FASIGN ;IS "A" SIGNED?
JRST MAC2C2 ;NO
IFE BIS,<
MOVSI CH,MAG. ;YES--GENERATE <MAG. AC,EAC>
>
IFN BIS,<
MOVSI CH,SKPGE. ;SKIPGE AC
HRR CH,EAC
PUSHJ PP,PUTASY
PUSHJ PP,PUTASA
MOVSI CH,DMOVN. ;DMOVN AC,AC
>
HRR CH,EAC
PUSHJ PP,PUT.XA
JRST MAC2C2
;GENERATE CODE TO MOVE AC'S TO COMP-1
MACFP.: HRRZ TE,EMODEA ;ARE AC'S ALREADY COMP-1?
CAIE TE,FPMODE
PUSHJ PP,CCXFP. ;NO--CONVERT THEM
JRST MAC1C2
;GENERATE CODE TO MOVE AC'S TO COMP-2
MACF2.: HRRZ TE,EMODEA ;ARE AC'S ALREADY COMP-2?
CAIE TE,F2MODE
PUSHJ PP,CCXF2. ;NO--CONVERT THEM
JRST MAC2C2
;GENERATE CODE TO MOVE COMP-1 ACC TO COMP-2
MAFPF2: HRRZ TE,EMODEA
CAIE TE,FPMODE ;ARE AC'S COMP-1?
CAIN TE,F2MODE ;OR COMP-2?
TRNA ;YES
PUSHJ PP,CCXFP. ;NO, CONVERT TO COMP-1
PUSHJ PP,MAC1C2 ;STORE FIRST WORD
MOVSI CH,SETZM. ;ZERO SECOND WORD
AOS EINCRB ;"B" +1
PUSHJ PP,PUT.B
SOS EINCRB
POPJ PP,
;GENERATE CODE TO MOVE COMP-2 AC'S TO COMP-1
MAF2FP: HRRZ TE,EMODEA
CAIE TE,FPMODE ;ARE AC'S ALREADY COMP-1?
CAIN TE,F2MODE ;OR COMP-2?
JRST MAC1C2 ;YES
JRST MACFP. ;NO, CONVERT TO COMP-1
;GENERATE CODE TO STORE FOUR WORDS
MAC44.: PUSHJ PP,PUTASA
MOVSI CH,DMOVM.##
PUSHJ PP,PUT.BA## ;"DMOVEM AC,B"
PUSH PP,EAC ;SAVE AC
MOVEI TE,2
ADDM TE,EAC ;BUMP PC
ADDM TE,EINCRB ;LOOK AT B+2
PUSHJ PP,PUTASA
MOVSI CH,DMOVM.
PUSHJ PP,PUT.BA## ;"DMOVEM AC+2,B+2"
POP PP,EAC ;RESTORE CURRENT AC
POPJ PP, ;DONE, RETURN
;GENERATE CODE TO MOVE ACCUMULATORS TO A DISPLAY FIELD
;AC'S CONTAIN FLOATING-POINT
MACFD.: PUSHJ PP,CFPCX. ;MAKE THEM FIXED POINT.
;AC'S CONTAIN ONE OR TWO WORD COMP.
MACD.: LDB TE,[POINT 3,EBASEB,20] ;IS ITEM 'BLANK WHEN ZERO'?
CAIE TE,AC.DAT
JRST MACD.1
MOVE TA,ETABLB
PUSHJ PP,LNKSET
LDB TE,DA.BWZ
JUMPN TE,MACE.
;'B' IS NEITHER EDITED NOR 'BLANK WHEN ZERO'
MACD.1: HRRZ TE,EMODEA ;IF 'A' IS
CAIE TE,F2MODE ; COMP-2 OR
CAIN TE,FPMODE ; COMP-1,
PUSHJ PP,CFPCX. ; CONVERT TO FIXED POINT
IFN ANS74,<
SKIPGE EFLAGB ;IF SEPARATE SIGN
SOS ESIZEB ;REDUCE SIZE BEFORE TESTS
SKIPGE EFLAGA ;[764] SAME FOR "A"
SOS ESIZEA ;[764] SO WE DON'T GET SPURIOUS WARNINGS
>
PUSHJ PP,CUTCX ;CUT DOWN "A" IF NECESSARY
TRN ;DON'T CARE IF CODE GENERATED
PUSHJ PP,ADJDP. ;ADJUST DECIMAL PLACES
PUSHJ PP,SWAPAB ;SWAP OPERANDS
MOVE TE,ESIZEA
MOVEM TE,ESIZEZ
IFN ANS74,<
LDB TE,[POINT 2,EFLAGA,1] ;GET SIGN FLAGS
DPB TE,[POINT 2,ESIZEZ,26] ;STORE IN SIZE SO THEY GET IN LIT
JUMPN TE,MACD.O ;JUMP IF FUNNY FLAGS ON
>
IFN BIS,<
PUSHJ PP,SWAPAB ;SWAP OPERANDS BACK
;[755] "PUSHJ PP,NBBPAR" DONE TOO EARLY!
;[755] PUSHJ PP,NBBPAR## ;[745] SETUP AC10= OUTPUT BYTE PTR
MOVE TE,ESIZEB ;IS "B" 2 WORDS?
CAILE TE,^D10
JRST MACD2A ;YES
MOVEI TE,D1MODE
EXCH TE,EMODEA
HRRZS TE
CAIE TE,D1MODE ;IF "A" IS 1 WORD, OK
PUSHJ PP,MFPS01 ;ELSE GO MAKE IT ONE WORD
PUSHJ PP,NBBPAR## ;[755] SETUP AC10= OUTPUT BYTE PTR
TSWT FBSIGN ;SKIP IF SIGNED
JRST MAC1US ;1 WORD, UNSIGNED
;1-WORD, SIGNED
;GEN "MOVE 4,AC" ;GET NUMBER
; "ASHC 4,-^D35" ;EXTEND SIGN
MOVSI CH,MOV+AC4
HRR CH,EAC
PUSHJ PP,PUTASY##
PUSHJ PP,PUTASA##
MOVE CH,[ASHC.+AC4+ASINC,,AS.CNB]
PUSHJ PP,PUTASY##
MOVEI CH,-^D35
PUSHJ PP,PUTASN##
JRST ENDSTP ;END SETUP CODE
;1-WD, UNSIGNED
;CODE GEN:
; "SETZ 4," ;CLEAR HIGH ORDER WORD
; "MOVM 5,AC" ;GET MAGNITUDE OF NUMBER
MAC1US: PUSHJ PP,PUTASA##
MOVSI CH,SETZ.+AC4
PUSHJ PP,PUTASY##
MOVSI CH,MOVM.+AC5
HRR CH,EAC
PUSHJ PP,PUTASY##
JRST ENDSTP
;TWO WORD COMP
MACD2A: HRRZ TE,EMODEA
CAIE TE,D1MODE ;SKIP IF "A" IS ONE-WORD
JRST MACD2B
MOVE CH,[XWD MULI.,1] ;YES-- CONVERT TO 2 WORD
PUSHJ PP,PUT.XA##
MACD2B: PUSHJ PP,NBBPAR## ;[755] SETUP AC10= OUTPUT BYTE PTR
TSWT FBSIGN ;SKIP IF SIGNED
JRST MAC2US ;NO - 2-WD UNSIGNED
;2-WD, SIGNED
;CODE GEN:
; "DMOVE 4,AC" ;GET NUMBER IN AC4 & AC5
PUSHJ PP,PUTASA##
MOVSI CH,DMOVE.+AC4
HRR CH,EAC
PUSHJ PP,PUTASY##
JRST ENDSTP
;2-WD, UNSIGNED
;CODE GEN:
; "SKIPL 4,AC" ;GET HIGH ORDER NUMBER
; "SKIPA 5,AC+1" ;POSITIVE, GET LOW ORDER
; "DMOVN 4,AC" ;NEGATIVE, GET MAGNITUDE
MAC2US: MOVSI CH,SKIPL.+AC4
HRR CH,EAC
PUSHJ PP,PUTASY##
MOVSI CH,SKIPA.+AC5
HRR CH,EAC
AOJ CH,
PUSHJ PP,PUTASY##
PUSHJ PP,PUTASA##
MOVSI CH,DMOVN.+AC4
HRR CH,EAC
PUSHJ PP,PUTASY##
ENDSTP:
;GEN "MOVE 7,[1B0+SIZE]"
MOVE TA,[XWD XWDLIT,2]
PUSHJ PP,STASHP##
MOVE TA,[1B0+AS.CNB]
PUSHJ PP,STASHQ##
HRL TA,ESIZEZ
HRRI TA,AS.CNB
PUSHJ PP,POOLIT##
MOVSI CH,MOV+AC7
PUSHJ PP,PUT.LD##
SKIPN PLITPC
AOS ELITPC
;[745] PUSHJ PP,NBBPAR## ;SETUP AC10= OUTPUT BYTE PTR
;GEN EXTEND 4,[CVTBDT @ CVBD.N##
; XWD Z,FILL.CHR]
MOVE TA,[XTNLIT,,1]
PUSHJ PP,STASHP
HRRZ TE,EMODEB
HRRZ TA,[EXP CVBD.6##
EXP CVBD.7##
EXP CVBD.9##](TE)
IFE TOPS20,<
TSWT FREENT ;NO INDIRECT IF /R
>
IFN TOPS20,<
SKIPN RENSW## ;NO INDIRECT IF /R
>
TLOA TA,(CVTBDT @)
TLO TA,(CVTBDT)
PUSHJ PP,STASHQ
MOVE TA,[XWD XWDLIT,2]
PUSHJ PP,STASHP
SETZ TA,
PUSHJ PP,STASHQ
HRRZ TE,EMODEB
HLRZ TA,SZLTAB(TE) ;GET ZERO IN APPROPRIATE CHAR. SET
PUSHJ PP,POOLIT
PUSHJ PP,PUTASA##
MOVSI CH,XTND.+AC4
PUSHJ PP,PUT.LD##
SKIPE PLITPC ;POOLED?
JRST EXTDNC ;YES
MOVEI TE,2
ADDM TE,ELITPC ;UPDATE LITERAL PC
EXTDNC: PUSHJ PP,PUTASA
MOVE CH,[ERROR.##+AC17,,CBDOV.##]
PUSHJ PP,PUT.EX
;IF OUTPUT STRING IS EBCDIC AND SIGNED, GEN. CODE TO OVERPUNCH A "+".
HRRZ TE,EMODEB
CAIE TE,D9MODE ;SKIP IF EBCDIC
POPJ PP, ;NO, ALL DONE
TSWT FBSIGN ;IS IT SIGNED?
POPJ PP, ;NO, ALL DONE
;GEN "LDB 6,10"
MOVE CH,[LDB.+AC6,,10]
PUSHJ PP,PUTASY##
;GEN "TRNE 6,40" ;SKIP IF NUMBER NOT POSITIVE
MOVE CH,[TRNE.+AC6,,40]
PUSHJ PP,PUTASY##
;GEN "TRZ 6,60" ;OVERPUNCH A "+"
PUSHJ PP,PUTASA##
MOVE CH,[TRZ.+AC6,,60]
PUSHJ PP,PUTASY##
;GEN "DPB 6,10" ;STASH THE CHAR
MOVE CH,[DPB.+AC6,,10]
PJRST PUTASY## ;THEN RETURN
>;END IFN BIS
MACD.O: PUSHJ PP,B1PAR ;BUILD PARAMETER
TSWF FASUB; ;IS IT GOING TO BE IN SXR?
SETZI EACC, ;YES, REMEMBER THAT.
PUSHJ PP,SWAPAB ;SWAP OPERANDS BACK
MOVE TE,ESIZEB ;IS 'B'
CAILE TE,^D10 ; TWO WORDS?
JRST MACD.2 ;YES
MOVEI TE,D1MODE ;NO
EXCH TE,EMODEA ;IF 'A'
HRRZS TE ; IS
CAIE TE,D1MODE ; ONE WORD, OK
PUSHJ PP,MFPS01 ; ELSE GO MAKE IT ONE WORD.
JRST MACD.3
MACD.2: HRRZ TE,EMODEA
CAIE TE,D1MODE
JRST MACD.3
MOVE CH,[XWD MULI.,1];YES--CONVERT "A" TO BE 2 WORDS
PUSHJ PP,PUT.XA
MACD.3: HRRZ TE,EMODEB ;GET THE MODE.
CAIL TE,D1MODE ;[636] MAKE SURE ITS IN RANGE
POPJ PP, ;[636] MUST BE ERROR, GIVE UP
HRRZ CH,GDNPDN(TE) ;SELECT THE APPROPRIATE CONVERSION ROUTINE.
PJRST PMOPU.## ;GO WRITE THE CALL AND RETURN.
;GENERATE CODE TO MOVE AC'S TO EDITED FIELD.
MACE.: MOVE TE,[XWD EBASEB,ESAVMB] ;SAVE "B" PARAMETERS
BLT TE,ESVMBX
MOVEI TE,D6MODE ;SET MODE TO SIXBIT
HRRM TE,EMODEB
MOVE TE,ESIZEB ;FIND OUT HOW MUCH TEMP NEEDED
ADDI TE,5
IDIVI TE,6
PUSHJ PP,GETEMP ;ALLOCATE SOME TEMP WORDS
MOVEM EACC,EINCRB ;RESET "B" TO BE TEMP
MOVE TE,[XWD ^D36,AS.MSC]
MOVEM TE,EBASEB
MOVE TE,[XWD EBASEB,ESAVMA] ;SAVE THE NEW "B" PARAMETERS
BLT TE,ESVMAX
PUSH PP,SW ;SAVE SWITCHES
SWOFF FBSUB ;CLEAR 'B IS SUBSCRIPTED'
PUSHJ PP,MACD.1
POP PP,SW ;RESTORE SWITCHES
SWOFF FASUB ;TEMP IS NOT SUBSCRIPTED
MOVE TE,[XWD ESAVMA,EBASEA] ;GET BACK "B" AND "A"
BLT TE,EBASBX
JRST MDED.1 ;GENERATE MOVE TO EDITED FIELD AND RETURN
;MOVE AC'S TO A COMP-3 FIELD.
MACC3.: MOVE TE, ESIZEB ;GET B'S SIZE.
CAIG TE, ^D10 ;DOES IT LOOK LIKE ONE OR TWO WORDS?
JRST MACC3E ;ONE, GO WORRY OVER IT.
;WE'RE GOING TO HAVE TWO WORDS IN THE AC'S.
PUSHJ PP, CUTC2 ;GO CUT DOWN INTEGER PLACES IF
; NECESSARY.
JFCL ;DON'T CARE IF WE GENERATED CODE.
PUSHJ PP, ADJ2C. ;GO ADJUST DECIMAL PLACES.
MACC3C: HRRZ TE, EMODEA ;DID THAT MAKE A INTO A
CAIN TE, D1MODE ; 1 WORD COMP ITEM?
PUSHJ PP, CC1C2. ;YES, GO TURN IT BACK INTO A
; TWO WORD COMP ITEM.
JRST MACC3I ;NOW WE CAN GENERATE THE MOVE.
;WE'RE ONLY GOING TO HAVE ONE WORD IN THE AC'S.
MACC3E: PUSHJ PP, CUTC1 ;GO CUT DOWN INTEGER PLACES IF
; NECESSARY.
JFCL ;DON'T CARE IF WE GENERATED CODE.
MOVE TC, ESIZEA ;SEE WHAT A'S SIZE IS NOW.
CAIG TC, ^D10
JRST MACC3G ;IT'S ONLY ONE WORD.
PUSHJ PP, ADJ2C. ;IT'S TWO WORDS.
AOSA EAC ;MAKE SURE WE BUMP THE AC.
MACC3G: PUSHJ PP, ADJ1C.
;HERE WE GENERATE THE MOVE.
MACC3I: PUSHJ PP, SWAPAB ;SWAP OPERANDS.
MOVE TE, ESIZEA ;TELL EVERYBODY WHAT THE
MOVEM TE, ESIZEZ ; SIZE IS.
PUSHJ PP, B1PAR ;BUILD THE PARAMETER.
TSWF FASUB; ;IS IT GOING TO BE IN SXR?
SETZI EACC, ;YES, REMEMBER THAT.
PUSHJ PP, SWAPAB ;RESTORE THE OPERANDS.
HRRZI CH, PC3%## ;GET THE EXTAB LINK TO THE
; CONVERSION ROUTINE.
PJRST PMOPU.## ;GO WRITE THE CALL AND RETURN.
;GENERATE CODE TO ADJUST DECIMAL PLACES OF AC TO MATCH B-FIELD,
ADJDPA: MOVEM TD,ESAVDP## ;[466] SAVE AMOUNT OF DECIMAL PLACE ADJ
CAIA ;[466] SO CAN RESTORE IF NECESSARY
ADJDP.: SETZM ESAVDP## ;[466] MAKE SURE ZERO IF NO ADJUSTMENT
HRRZ TE,EMODEB
CAIE TE,FPMODE
CAIN TE,F2MODE
POPJ PP,
HRRZ TE,EMODEA
CAIN TE,D1MODE
JRST ADJ1C.
CAIN TE,D2MODE
JRST ADJ2C.
IFN BIS,<
CAIN TE,D4MODE##
JRST ADJ4C.
>
POPJ PP,
;ADJUST DECIMAL PLACES FOR 1-WORD COMP.
ADJ1C.: TSWF FALWY0;
POPJ PP,
MOVE TC,EDPLA ;DOES "A" HAVE SAME DECIMAL PLACES AS "B"?
SUB TC,EDPLB
JUMPE TC,CPOPJ ;YES IF JUMP
MOVN TD,TC ;NO--ADJUST SIZE AND DECIMAL PLACES OF "A"
ADDB TD,ESIZEA
CAILE TD,MAXSIZ ;SIZE NOW GREATER THAN MAX ALLOWED?
JRST IRERA. ;YES--YOU LOSE
MOVN TE,TC
ADDM TE,EDPLA
JUMPL TC,ADJ1C1 ;D.P. OF A > D.P. OF B?
MOVSI CH,IDIV. ;YES--GENERATE DIVIDE
PUSHJ PP,PUT.PA
JRST LSERA.
;D.P. OF A < D.P. OF B
ADJ1C1: MOVMS TC
CAIG TD,^D10 ;NO--NEW SIZE > 10?
JRST ADJ1C3 ;NO
ADJ1C2: AOS EMODEA ;YES--CHANGE MODE
CAILE TC,^D10 ;IS DIFFERENCE > 10?
JRST ADJ1C4 ;YES
MOVSI CH,MUL.
PJRST PUT.PA
;ADJUST DECIMAL PLACES OF 1-WORD COMP (CONT'D).
;NEW SIZE IS STILL < 10 -- USE "IMUL"
ADJ1C3: MOVSI CH,IMUL.
JRST PUT.PA
;DIFFERENCE IN SIZE IS GREATER THAN 10
ADJ1C4: MOVEI TE,D2MODE
MOVEM TE,EMODEA
IFE BIS,<
MOVSI CH,MUL.12 ;GENERATE <MUL.12 AC,[LIT]>
PJRST PUT.PA
>
IFN BIS,<
PUSHJ PP,PUTASA##
MOVEM TC,EWORDB ;SAVE DECIMAL PLACE ADJUSTMENT
MOVE CH,[ASHC.+ASINC,,AS.CNB]
PUSHJ PP,PUT.XA
MOVEI CH,-^D35
PUSHJ PP,PUTASN##
JRST ADJ2CK
ADJ2C2: PUSHJ PP,PUTASA
MOVSI CH,DMUL.##
PUSHJ PP,PUT.PA ;DMUL AC,<POWER-OF-TEN>
ADJ2CV: PUSHJ PP,PUTASA
MOVE CH,[DMOVE.,,2]
ADD CH,EAC ;PUT IN EAC & EAC+1
PJRST PUT.XA
>
;GENERATE CODE TO ADJUST DECIMAL PLACES OF 2-WORD COMP FIELD TO MATCH B-FIELD.
ADJ2C.: TSWF FALWY0 ;AC'S CONTAIN ZEROES?
POPJ PP, ;YES--RETURN
MOVE TE,EDPLA ;ANY ADJUSTMENT NEEDED?
SUB TE,EDPLB
JUMPE TE,CPOPJ ;NO IF JUMP
MOVN TD,TE
ADDB TD,ESIZEA ;ADJUST SIZE
CAILE TD,MAXSIZ ;NEW SIZE GREATER THAN 19?
IFE BIS,<
JRST IRERA. ;YES--YOU LOSE
>
IFN BIS,<
JRST ADJA24 ;[731] YES, CONVERT "A" TO QUAD-WORD
HRRZ TB,EMODEA ;[664] GET MODE
CAIN TB,D4MODE ;[664] IS IT QUAD-WORD (ACS 0-3 HAS "A")?
JRST ADJ4C0 ;[664] YES, GO ADJUST
>;END IFN BIS
MOVN TC,TE ;ADJUST DECIMAL PLACES
ADDM TC,EDPLA
MOVEM TE,EWORDB ;SAVE SIZE DIFFERENCE
JUMPL TE,ADJ2C1 ;D.P. OF A > D.P. OF B?
PUSHJ PP,LSERA. ;YES--PUT OUT WARNING DIAG
PUSHJ PP,FORCX0 ;INSURE AC'S ARE 0&1
MOVE TC,EWORDB ;GET SIZE DIFFERENCE BACK
HRRZ TE,EMODEA ;IS "A" 1 WORD?
CAIE TE,D2MODE
JRST ADJ2C4 ;YES--SPECIAL PROCESSING
MOVSI CH,DIV.22
CAIG TC,^D10
MOVSI CH,DIV.21
JRST PUT.PC
;D.P. OF A < D.P. OF B -- MULTIPLY
ADJ2C1: HRRZ TE,EMODEA ;IS "A" ONE WORD?
CAIE TE,D2MODE
JRST ADJ1C2 ;YES
IFE BIS,<
MOVM TC,EWORDB
MOVSI CH,MUL.21
CAILE TC,^D10
MOVSI CH,MUL.22
MOVE TE,EAC
DPB TE,CHAC
JRST PUT.PC
>
IFN BIS,<
ADJ2CK: HRRZ TD,EAC ;MAKE SURE THERE IS ENOUGH ROOM FOR DMUL
HRRZ TE,EBASEB
CAIL TE,(TD) ;IS ACC OF "A" ALREADY BIGGER THAN AC OF "B"?
CAIL TE,4(TD) ;OR, "A" AT LEAST 4 ACS AWAY FROM "B"?
JRST OKDMUL ;YES
;"B" MUST BE MOVED TO ANOTHER AC ELSE WE WILL SMASH IT!
MOVEI TD,4(TD) ;HERE'S WHERE IT SHOULD BE
LSH TD,^D18+5 ;SHIFT TO AC POSITION
HRRZ TC,EMODEB ;ONE OR TWO WORDS?
CAIE TC,D1MODE
CAIN TC,FPMODE
JRST ADJ2D1 ; ONE WORD
PUSHJ PP,PUTASA ;MUST BE TWO WORDS
SKIPA CH,[DMOVE.,,0] ;GEN "DMOVE NEW.AC,OLD.AC"
ADJ2D1: HLRZI CH,MOV ;GEN "MOVE NEW.AC,OLD.AC"
IOR CH,TE
IOR CH,TD
PUSHJ PP,PUTASY
PUSHJ PP,OKDMUL ;NOW OK TO DMUL
;NOW PUT "B" BACK IN THE ACS IT SHOULD BE IN
HRRZ TD,EBASEB ;WHERE IT SHOULD BE
HRRZ TE,EAC
ADDI TE,4 ;WHERE IT IS
LSH TD,^D18+5 ;IN AC POSITION
HRRZ TC,EMODEB
CAIE TC,D1MODE
CAIN TC,FPMODE
JRST ADJ2E1 ;ONE WORD
PUSHJ PP,PUTASA ;MUST BE TWO WORDS
SKIPA CH,[DMOVE.,,0] ;GEN "DMOVE NEW.AC,OLD.AC"
ADJ2E1: HLRZI CH,MOV ;GEN "MOVE NEW.AC,OLD.AC"
IOR CH,TE
IOR CH,TD
JRST PUTASY
;"B" IS OUT OF THE WAY-- OK TO DO DMUL
OKDMUL: MOVM TC,EWORDB
CAILE TC,^D10 ;IS LIT 2 WORDS?
JRST ADJ2C2 ;YES, JUST DO DMUL
PUSHJ PP,PUTASA##
MOVSI CH,SETZ.+AC7
PUSHJ PP,PUTASY
MOVSI CH,MOV+AC10
PUSHJ PP,PUT.P ;MOVE 10,<POWER-OF-TEN>
PUSHJ PP,PUTASA
MOVE CH,[DMUL.,,7]
PUSHJ PP,PUT.XA
JRST ADJ2CV ;COPY VALUE TO CORRECT ACCS
>
;GENERATE CODE TO ADJUST DEC. PL. OF 2-WORD COMP (CONT'D)
;"A" IS ACTUALLY 1 WORD, NOT 2
ADJ2C4: MOVSI CH,IDIV.
JRST PUT.PA
;GENERATE CODE TO ADJUST DECIMAL PLACES OF 4-WORD COMP FIELD TO MATCH B-FIELD.
IFN BIS,<
ADJ4C.: TSWF FALWY0 ;AC'S CONTAIN ZEROES?
POPJ PP, ;YES--RETURN
MOVE TE,EDPLA ;ANY ADJUSTMENT NEEDED?
SUB TE,EDPLB
JUMPE TE,CPOPJ ;NO IF JUMP
MOVN TD,TE
ADDB TD,ESIZEA ;ADJUST SIZE
ADJ4C0: CAILE TD,^D40 ;NEW SIZE GREATER THAN 4-WORDS?
JRST IRERA. ;YES--YOU LOSE
MOVN TC,TE ;ADJUST DECIMAL PLACES
ADDM TC,EDPLA
MOVEM TE,EWORDB ;SAVE SIZE DIFFERENCE
JUMPL TE,ADJ4C1 ;D.P. OF A GREATER THAN D.P. OF B?
PUSHJ PP,LSERA. ;YES--PUT OUT WARNING DIAG
PUSHJ PP,FORCX0 ;INSURE AC'S ARE 0&1
MOVE TC,EWORDB ;GET SIZE DIFFERENCE BACK
MOVEI CH,DIV%42##
CAIG TC,^D10
MOVEI CH,DIV%41##
JRST ADJ4C2 ;GENERATE CALL
;D.P. OF A LESS THAN D.P. OF B -- MULTIPLY
ADJ4C1: MOVM TC,EWORDB
MOVEI CH,MUL%41##
CAILE TC,^D10
MOVEI CH,MUL%42##
MOVE TE,EAC
DPB TE,CHAC
ADJ4C2: PUSHJ PP,PMOPC.## ;GENERATE CALL
MOVE TE,ESIZEA ;GET NEW SIZE
CAILE TE,MAXSIZ ;WILL IT NOW FIT IN 2-WORDS?
POPJ PP, ;NOT YET
MOVEI TE,D2MODE ;YES
MOVEM TE,EMODEA ;RESET MODE
PUSHJ PP,PUTASA## ;MOVE
MOVE CH,[DMOVE.##,,2]
JRST PUTASY ;INTO 0&1
>;END OF BIS
;CHECK TO SEE IF "A" HAS TOO MANY INTEGER PLACES
CUTCX: HRRZ TE,EMODEA
CAIE TE,D1MODE
JRST CUTC2
;"A" IS 1-WORD COMP
CUTC1: TSWT FSZERA ;ANY SIZE ERROR CODING?
TSWF FALWY0 ;ARE AC'S ZERO?
POPJ PP, ;YES
MOVE TE,ESIZEB
SUB TE,EDPLB
ADD TE,EDPLA
SUB TE,ESIZEA
IFN ANS74,<
SKIPGE EFLAGA ;[1442] SEPARATE SIGN?
ADDI TE,1 ;[1442] YES, ACCOUNT FOR IT
>
JUMPGE TE,CUTC1E
ADDM TE,ESIZEA ;IT HAS--CUT DOWN "A"
PUSHJ PP,MSERA. ;PUT OUT WARNING DIAG
CUTC1A: SKIPG TC,ESIZEA ;IF SIZE OF 'A' IS
MOVEI TC,1 ; NON-POSITIVE, USE 1
MOVSI CH,IDIV. ;NO--GENERATE A DIVIDE.
CAILE TC,^D10 ;IF MORE THAN 10 DIGITS TO SCALE,
MOVSI CH,DIV.12 ; SWITCH TO DIV.12
PUSH PP,CH ;KEEP REMINDER OF WHAT WE ARE DOING
PUSHJ PP,PUT.PA
POP PP,TA ;NOW, WHAT WAS THAT AGAIN?
MOVEI TB,2 ;PREPARE TO ADD 2 TO EAC
CAMN TA,[DIV.12,,0] ;1-WORD OR 2-WORD DIVISOR?
ADDM TB,EAC ;TWO
AOSA EAC ;AC_AC+1
CUTC1B: AOS (PP) ;SKIP RETURN IF NO DIVIDE GENERATED
CUTC1C: POPJ PP,
;CUT DOWN ONLY IF AC'S ARE 2-WORD COMP
CUTC1E: HRRZ TE,EMODEA
CAIE TE,D2MODE
JRST CUTC1B
MOVE TC,ESIZEA
JRST CUTC2A
;CHECK TO SEE IF "A" HAS TOO MANY INTEGER PLACES (CONT'D).
;"A" IS TWO-WORD COMP
CUTC2: TSWT FSZERA ;ANY SIZE ERROR CODING?
TSWF FALWY0 ;DO AC'S CONTAIN ZERO?
POPJ PP, ;YES
IFN BIS,<
CUTC2C: MOVE TE,EMODEA ;[634] ADD LABEL
CAIN TE,D4MODE ;CHECK FOR 4-WORD MODE
JRST CUTC4 ;IT IS
>
MOVE TE,ESIZEB
SUB TE,EDPLB
ADD TE,EDPLA
SUB TE,ESIZEA
IFN ANS74,<
SKIPGE EFLAGA ;[1442] SEPARATE SIGN?
ADDI TE,1 ;[1442] YES, ACCOUNT FOR IT
>
JUMPGE TE,CUTC1B
IFE BIS,<
ADDM TE,ESIZEA ;IT HAS--CUT DOWN "A"
>
IFN BIS,<
ADD TE,ESIZEA
CAILE TE,MAXSIZ ;DO WE NEED SPECIAL?
JRST [MOVEI TE,D4MODE ;SIGNAL 4-WORDS
MOVEM TE,EMODEA
PUSHJ PP,ADJ4C. ;YES, QUAD DIVIDE
JRST CUTC2] ;NOW ADJUST
MOVEM TE,ESIZEA
>
PUSHJ PP,MSERA. ;PUT OUT WARNING DIAG
SKIPG TC,ESIZEA ;ANY SIZE LEFT TO "A"?
MOVEI TC,1
CUTC2A: PUSHJ PP,FORCX0 ;INSURE AC'S ARE 0&1
MOVEI TE,2 ;NOW SET AC'S TO 2&3
ADDM TE,EAC
MOVSI CH,DIV.22
CAILE TC,^D10
JRST PUT.PC
MOVEI CH,D1MODE
MOVEM CH,EMODEA
MOVSI CH,DIV.21
JRST PUT.PC ;GENERATE <DPD.21 [10**SIZE OF "A"]> AND
;RETURN
;CHECK TO SEE IF "A" HAS TOO MANY INTEGER PLACES (CONT'D).
;"A" IS FOUR-WORD COMP
IFN BIS,<
CUTC4: MOVE TE,ESIZEB
SUB TE,EDPLB
ADD TE,EDPLA
SUB TE,ESIZEA
JUMPGE TE,CUTC1B ;SHOULD NOT HAPPEN?
ADD TE,ESIZEA
CAILE TE,MAXSIZ ;DO WE NEED SPECIAL?
JRST [PUSHJ PP,ADJ4C. ;YES, ADJUST DECIMAL PLACES FIRST
JRST CUTC2C] ;[634] NOW ADJUST
MOVEM TE,ESIZEA
PUSHJ PP,MSERA. ;PUT OUT WARNING DIAG
SKIPG TC,ESIZEA ;ANY SIZE LEFT TO "A"?
MOVEI TC,1
PUSHJ PP,FORCX0 ;INSURE AC'S ARE 0&1
MOVEI TE,4 ;NOW SET AC'S TO 4&5
ADDM TE,EAC
MOVEI TE,D2MODE ;ASSUME 2-WORDS LEFT
MOVEI CH,DIV%42##
CAILE TC,^D10
JRST CUTC4D
MOVEI TE,D1MODE
MOVEI CH,DIV%41##
AOS EAC ;REMAINDER IS ONLY IN AC5 IF S.P.
CUTC4D: MOVEM TE,EMODEA
;[567] MOVE TC,ESIZEB ;WHAT WE WANT
JRST PMOPC.## ;GENERATE <DPD.41 [10**SIZE OF "A"]>
>
;CREATE AN ALPHANUMERIC LITERAL
LITD.0:: ;UNTIL WE FIGURE OUT IF STRGEN IS SAFE
SETZM IMCONS ;MAKE IT WORK THE OLD WAY
TRNA
LITD.: SETOM IMCONS## ;ALLOW IMMEDIATE MODE
PUSHJ PP,LITSZE ;GET LITERAL SIZE [167]
TSWF FERROR ;[1353] TOO LARGE TO STORE
POPJ PP, ;[1353]
MOVE TE,ESIZEA ;IS LITERAL THE SAME SIZE AS "B"?
CAMN TE,ESIZEB
JRST LITD.2 ;YES
CAMG TE,ESIZEB ;NO--IS LITERAL LARGER THAN "B"?
JRST LITD.5 ;NO--SMALLER
;LITERAL IS LARGER THAN "B"
SKIPGE EMODEB ;IS "B" JUSTIFIED RIGHT?
JRST LITD.1 ;YES
PUSHJ PP,RTERA. ;NO--PUT OUT DIAG
JRST LITD.2
LITD.1: SUB TE,ESIZEB ;YES--UPDATE BYTE POINTER
IDIVI TE,5
ADDM TE,EBYTEA
JUMPE TD,LITD.2
IBP EBYTEA
SOJG TD,.-1
PUSHJ PP,LTERA. ;PUT OUT DIAG
;CREATE AN ALPHANUMERIC LITERAL (CONT'D).
;LITERAL IS THE SAME SIZE AS "B"
LITD.2: HRRZ TC,EMODEB
MOVE TD,ESIZEB
PUSHJ PP,PVALIT
LITD.3: SETZM EDPLA ;NO DECIMAL PLACES
SKIPN IMCONS ;DID WE GENERATE A LITERAL?
JRST LITD3A ;YES
MOVEM TA,EBASEA ;NO, STORE CONST.
SETZM EINCRA
MOVSI TE,^D36
HLLM TE,ERESA
MOVEI TC,IMMODE## ;SET MODE TO IMMEDIATE CONST.
MOVEM TC,EMODEA
SETZM IMCONS ;CLEAR "IMMEDIATE CONSTANT" FLAG
POPJ PP,
LITD3A: TLNN TB,1B18 ;IS "TA" EMPTY?
LITD3B: PUSHJ PP,STASHQ ;NO--PUT IT INTO LITAB
LITD3C: SKIPN TA,ESIZEB ;[1000] IF B HAS NO LENGTH
PUSHJ PP,STASHQ ;PUT OUT A WORD OF NULLS
PUSHJ PP,POOL ;POOL THE LITERAL
SKIPN TE,PLITPC
HRRZ TE,ELITPC
IORI TE,AS.LIT
MOVEM TE,EINCRA
SKIPN TE,CURSIZ ;GET LITERAL SIZE
MOVEI TE,1 ;NULL, USE 1 WORD
SKIPN PLITPC
ADDM TE,ELITPC
MOVSI TE,^D36
HLLM TE,ERESA
MOVE TE,ESIZEB
MOVEM TE,ESIZEA
HRRZ TC,EMODEB ; [303] MAKE SURE EMODEA=EMODEB
HRRZM TC,EMODEA
MOVEI TE,AS.MSC
HRRM TE,EBASEA
POPJ PP,
LITSZE: ; [167]
HRRZ TC,EMODEB ;GET MODE OF "B"
HRL TA,D.LTCD##(TC) ;SELECT THE APPROPRIATE LITAB CODE.
MOVE TE,ESIZEB ;GET B'S SIZE.
ADD TE,ADCRLF## ;ALLOW FOR CR-LF NUL IF REQUIRED
CAIN TE,1 ;IS LIT 1 CHAR ONLY?
SKIPN IMCONS ;YES, SKIP IF IMMEDIATE MODE ALLOWED
SETZM IMCONS ;HERE IF NOT 1 CHAR - CAN'T USE IMMEDIATE MODE
;NOW IMCONS = -1 IF IT IS POSSIBLE TO USE IMMEDIATE MODE AND IT IS ALSO
; SAFE TO DO SO, ELSE IT IS 0.
LITSZ1: IDIV TE,BYTE.W(TC) ;NO. OF FULL WORDS FOR LITERAL
SKIPE ESIZEB ; B GETS AT LEAST 1 LITERAL WORD [167]
SKIPE TD ; ANY REMAINING CHARS [167]
AOS TE ; NEEDS 1 MORE WORD [167]
HRRM TE,TA ; SET LITERAL SIZE IN HEADER WORD
HRRZM TE,CURSIZ ;SAVE THE SIZE [167]
SKIPN IMCONS ;NO LIT. IF CONST.
JRST STASHP ;STASH LITAB HEADER WORD & RETURN
POPJ PP,
;CREATE AN ALPHANUMERIC LITERAL (CONT'D).
;LITERAL IS SMALLER THAN "B".
LITD.5: HLRZ TA,OPERND ;IS IT "ALL"?
MOVE TE,0(TA)
TLNE TE,GNALL
JRST LITD.7 ;YES
SKIPGE EMODEB ;IS "B" JUSTIFIED RIGHT?
JRST LITD.6 ;YES
MOVE TD,ESIZEA ;NO
PUSHJ PP,PVALIT
MOVE TD,ESIZEB
SUB TD,ESIZEA
PUSHJ PP,SLIT1
JRST LITD.3
LITD.6: MOVE TD,ESIZEB
SUB TD,ESIZEA
PUSHJ PP,SPCLIT
MOVE TD,ESIZEA
PUSHJ PP,PVLIT2
JRST LITD.3
;CREATE AN ALPHANUMERIC LITERAL (CONT'D).
;"ALL" SPECIFIED, AND LITERAL IS SMALLER THAN "B"
LITD.7: MOVE TE,EBYTEA ;SAVE BYTE POINTER TO VALUE
MOVEM TE,ELITLO
MOVE DT,ESIZEB ;GET SIZE OF "B"
SKIPGE EMODEB ;IS "B" JUSTIFIED RIGHT?
JRST LITD10 ;YES
;"B" IS JUSTIFIED LEFT
LITD7A: MOVE TD,ESIZEA ;GET ONE OCCURENCE INTO
PUSHJ PP,PVALIT ; LITAB
LITD.8: SUB DT,ESIZEA ;DECREMENT AMOUNT LEFT
LITD.9: JUMPLE DT,LITD.3 ;DONE?
MOVE TD,ESIZEA ;NO--GET LITERAL SIZE
CAMLE TD,DT ;IS IT LESS THAN AMOUNT LEFT?
MOVE TD,DT ;NO--USE AMOUNT LEFT
MOVE TE,ELITLO ;RESET BYTE POINTER TO VALUE
MOVEM TE,EBYTEA
PUSHJ PP,PVLIT2 ;GET MORE VALUE INTO LITAB
JRST LITD.8 ;LOOP
;"B" IS JUSTIFIED RIGHT
LITD10: MOVE TE,ESIZEB ;GET LEFT RESIDUE INTO
IDIV TE,ESIZEA ; TD
JUMPE TD,LITD7A ;IF ZERO--SAME AS JUSTIFIED LEFT
SUB DT,TD ;DECREMENT AMOUNT LEFT
MOVE TE,DT ;INCREMENT
SUB TE,TD ; BYTE POINTER
IBP EBYTEA ; TO
SOJG TE,.-1 ; VALUE
PUSHJ PP,PVALIT ;GET SOME CHARACTERS
JRST LITD.9 ;NOW PRETEND IT'S LEFT JUSTIFIED
;CREATE A NUMERIC DISPLAY LITERAL
LITN.: PUSHJ PP,SCANL ;SCAN THE VALUE IN VALTAB
TSWF FERROR ;ANY ERRORS?
POPJ PP, ;YES--QUIT
LITN.A: SETZM IMCONS ;NO IMMEDIATE MODE (AT LEAST NOT YET)
MOVE TE,[POINT 6,LITHLD] ;SET EBYTEA TO POINT TO LITHLD
MOVEM TE,EBYTEA
PUSHJ PP,LITSZE ; GET LITERAL SIZE [167]
MOVE TD,ESIZEB ;DOES LITERAL HAVE MORE INTEGRAL PLACES THAN "B"?
MOVEM TD,ESIZEZ ; [303] SAVE SIZE OF B
SUB TD,EDPLB
SUB TD,ESIZEA
ADD TD,EDPLA
JUMPE TD,LITN.3 ;IF JUMP--INTEGER SIZES ARE EQUAL
JUMPG TD,LITN.2
;LITERAL HAS MORE INTEGER PLACES THAN RECEIVING FIELD
ADDM TD,ESIZEA ;DECREMENT SIZE OF LITERAL
MOVMS TD
IDIVI TD,6 ;BUMP EBYTEA
ADDM TD,EBYTEA
JUMPE TC,LITN.1 ; [303] BYTE POINTER OF "A" EXACT- GO ON
IBP EBYTEA
SOJG TC,.-1
LITN.1: SKIPN ESIZEA
JRST LITN10
PUSHJ PP,MSERA.
JRST LITN.3
;LITERAL HAS FEWER INTEGER PLACES THAN "B" FIELD
LITN.2: MOVE TB,ESIZEB ; [303] SIZE OF B
CAMLE TD,TB ;[1075] DON'T PUT OUT MORE ZEROS THAN WE NEED
MOVE TD,TB ;[1075] CAN HAPPEN IF LIT IS OF FORM 0.000123
SUB TB,TD ; [303] LESS NUMBER OF ZEROS TO BE INSERTED IN MSD'S
MOVEM TB,ESIZEZ ; [303] NO OF DIGITS LEFT IN "B"
PUSHJ PP,ZERLIT ;GENERATE ZEROES AT FRONT
JRST LITN.4
;INTEGER PLACES OF LITERAL AND "B" ARE EQUAL
LITN.3: MOVEI TA,0 ;CLEAR TA
HRRZ TC,EMODEB
MOVE TB,VLIT7.##(TC) ;SELECT THE APPROPRIATE BYTE POINTER.
LITN.4: MOVE TE,EDPLB ;COMPARE DECIMAL PLACES
SUB TE,EDPLA
JUMPGE TE,LITN.5 ;JUMP IF "A" IS NOT GREATER THAN "B"
ADDM TE,EDPLA ;DECREMENT DECIMAL PLACES OF LITERAL
ADDB TE,ESIZEA ;DECREMENT SIZE OF LITERAL
JUMPLE TE,LITN11 ; [303] PUT IN ZEROS INTO REMAINING DIGITS OF "B"
PUSHJ PP,LLSERA ; [303] SAVE LITERAL AND LIT BYTE POINTER AND PUT OUT DIAG
;GENERATE A NUMERIC DISPLAY LITERAL (CONT'D)
LITN.5: MOVE TD,ESIZEA ;GET SIZE OF LITERAL
JUMPLE TD,LITN11 ; [303] IF NOTHING LEFT--WARN HIM
MOVE TC,EMODEB
LITN.6: ILDB TE,EBYTEA
XCT LITN12(TC) ;CONVERT IT IF NECESSARY.
IDPB TE,TB
TLNN TB,760000 ;IS "TA" FULL?
PUSHJ PP,PVLIT6## ;YES--WRITE IT OUT
SOJG TD,LITN.6 ;LOOP UNTIL DONE
MOVE TD,EDPLB
SUB TD,EDPLA
SKIPLE TD
PUSHJ PP,ZLIT2
TSWF FLNEG ;IS LITERAL NEGATIVE?
TSWT FBSIGN ;YES--IS "B" SIGNED?
JRST LITN.9 ;NO
JUMPN TA,LITN.8 ;IS "TA" EMPTY?
SKIPL PLITCT ;YES, BUT ARE WE POOLING LITERALS
JRST [MOVE TB,PLITPT## ;YES, GET BYTE POINTER TO LAST ONE
HLL TB,LITN9A(TC) ;FIXUP FOR LAST CHARACTER
JRST LITN.8] ;AND DO CONVERSION
MOVE TD,LITNXT ;YES--GET BACK ONE %LIT WORD
POP TD,TA
MOVEM TD,LITNXT
MOVE TB,LITN9A(TC) ;SELECT THE APPROPRIATE BYTE POINTER.
LITN.8: LDB TE,TB ;GET THE LAST DIGIT
XCT LITN14(TC) ;MAKE IT NEGATIVE.
DPB TE,TB ;REPLACE LAST DIGIT
LITN.9: MOVE TE,EDPLB
MOVEM TE,EDPLA
JUMPE TA,LITD3C
JRST LITD3B
LITN9A: POINT 6,TA,35
POINT 7,TA,34
POINT 9,TA,35
;NOTHING LEFT TO LITERAL AFTER TRUNCATION
LITN10: PUSHJ PP,NOSIZ. ;PUT OUT WARNING
SKIPN TD,ESIZEB ;[1000] IF NO SIZE
JRST LITD3C ;[1000] PUT OUT A ZERO WORD
PUSHJ PP,ZERLIT
JRST LITD3A
; SIMLIAR TO LITN10 EXCEPT KEEP ANY CURRENT LITERAL AND ONLY PUT IN ZEROS ON LEFT OVER DIGITS
LITN11: PUSH PP,TA ; [303] SAVE ANY LITERAL
PUSH PP,TB ; [303] SAVE LITERAL BYTE PNTR
PUSHJ PP,NOSIZ. ; [303] WARN THAT MOVE IS ALL ZEROES
POP PP,TB ; [303] GET BACK LIT BYTE PNTR
POP PP,TA ; [303] GET BACK LITERAL
MOVE TC,EMODEB## ; [V10] GET THE MODE BACK TOO.
SKIPLE TD,ESIZEZ ; [303] ANY MORE ZEROES TO PUT IN?
PUSHJ PP,ZLIT2 ; [303] YES COMPLETE ZERO LITERAL
JRST LITD3A ; [303] FINISH LITERAL
;CONVERT THE SIXBIT CHAR IN TE TO SOMETHING - XCT LITN12(TC) -
LITN12: JFCL ;SIXBIT.
ADDI TE, 40 ;ASCII.
PUSHJ PP, LITN13 ;EBCDIC.
LITN13: ADDI TE, 40 ;FIRST TO ASCII.
JRST VLIT8.## ;THENCE TO EBCDIC.
;TURN THE POSITIVE DIGIT IN TE INTO A NEGATIVE ONE - XCT LITN14(TC) -
LITN14: PUSHJ PP, .+3 ;SIXBIT.
PUSHJ PP, .+1 ;ASCII.
ADDI TE, -40 ;EBCDIC.
TRNN TE, 17 ;ZERO?
SKIPA TE, .+4 ;YES, GET A SIXBIT NEGATIVE ZERO.
ADDI TE, 31 ;NO, MAKE THE DIGIT NEGATIVE.
SKIPE TC ;SIXBIT?
ADDI TE, 40 ;NO, MAKE IT ASCII.
POPJ PP, ']' ;RETURN.
;PUT ZEROES BEFORE OR AFTER A DISPLAY LITERAL.
;SIZE IS IN "TD", HEADER FOR LITAB HAS BEEN PUT OUT.
;LITERAL IS BEING POOLED
ZERLIT: JUMPE TD,CPOPJ ; [424] IF NO SIZE QUIT
HRRZ TC,EMODEB
PUSHJ PP,VLIT5.##
ZLIT2: HLRZ TE,SZLTAB(TC) ;SELECT AN APPROPRIATE ZERO.
IDPB TE,TB
SOJLE TD,PVLIT5##
TLNN TB,760000
PUSHJ PP,PVLIT6##
JRST ZLIT2
;MOVE SPACES TO LITAB TO FILL OUT A LITERAL.
;HEADER HAS BEEN PUT OUT, SIZE IS IN "TD".
;LITERAL IS BEING POOLED
SPCLIT: JUMPE TD,CPOPJ ; [424] IF NO SIZE QUIT
HRRZ TC,EMODEB
PUSHJ PP,VLIT5.##
SLIT1: HRRZ TE,SZLTAB(TC) ;SELECT AN APPROPRIATE SPACE.
IDPB TE,TB ;STASH IT INTO "TA"
SOJLE TD,PVLIT5##
;QUIT IF ENOUGH HAVE BEEN DONE
TLNN TB,760000 ;IS "TA" FULL?
PUSHJ PP,PVLIT6##
JRST SLIT1
;TABLE OF ZEROES AND SPACES IN THE VARIOUS CHARACTER SETS.
SZLTAB: XWD 20,0 ;SIXBIT.
XWD 60,40 ;ASCII.
XWD 360,100 ;EBCDIC.
;GENERATE A MOVE BETWEEN TWO DISPLAY FIELDS OF EQUAL LENGTH.
GMOVE.: HRRZ TA,EMODEA ;SAME USAGE?
HRRZ TB,EMODEB
CAIN TA,IMMODE ;IMMEDIATE MODE
JRST GMOV.I ;YES
CAME TA,TB
IFE BIS,< JRST GMOVE7 ;NO>
IFN BIS,< JRST GMOV.2 ;SEE IF SPECIAL CASE>
;IS EITHER FIELD SUBSCRIPTED?
TSWF FASUB!FBSUB ;IF SO, DONT LOOK FOR BLT
JRST GMSUB ;YES--SAME USAGE, SUBSCRIPTED MOVE
HLRZ TB,ERESA ;YES--SAME STARTING BIT?
HLRZ TA,ERESB
CAMN TB,TA
JRST GMOVE2 ;YES
;IF BOTH OPERANDS ARE WORD CONTAINED, TREAT THEM IN A SPECIAL WAY
GMOVE1: HLRZ TB,ERESA ;GET CORRECT RESIDUE
MOVE TC,EMODEA ;IS "A" OPERAND WORD-CONTAINED?
MOVE TD,BYTE.S(TC)
IMUL TD,ESIZEZ
SUB TB,TD
IFE BIS,< JUMPL TB,GMOVE7 ;NO IF JUMP>
IFN BIS,< JUMPL TB,GMOV.1 ;USE EXTEND INSTR IF POSSIBLE>
LSH TB,6 ;YES--CREATE LEFT-HALF OF PARAMETER
ADD TB,TD
MOVEM TB,EWORDB ;SAVE IT
HLRZ TB,ERESB ;IS "B" OPERAND WORD-CONTAINED?
SUB TB,TD
IFE BIS,< JUMPL TB,GMOVE7 ;NO IF JUMP>
IFN BIS,< JUMPL TB,GMOV.1 ;USE EXTEND INSTR IF POSSIBLE>
;GENERATE A MOVE BETWEEN TWO DISPLAY FIELDS OF EQUAL LENGTH (CONT'D).
;BOTH OPERANDS ARE WORD-CONTAINED.
;THEY MAY OR MAY NOT HAVE THE SAME STARTING BIT.
LSH TB,6 ;"TB" HAS RESIDUE OF "B"
ADD TB,TD ;"TD" HAS SIZE, IN BITS
EXCH TB,EWORDB ;SAVE THAT, AND GET "A" INFO BACK
LSH TB,6 ;CREATE BYTE POINTER TO "A"
LDB TD,[POINT 6,TB,29] ;GET SIZE OF BYTE
CAILE TD,22 ;LESS OR EQUAL TO A HALFWORD?
JRST GMOV0A ;NO, CAN'T USE HALFWORD INSTRUCTIONS
LDB TD,[POINT 6,TB,23] ; DOES THE BYTE END ON A HALFWORD?
CAIE TD,22
CAIN TD,0
JRST GMOV1A ;YES -- GEN A HALFWORD LOAD
GMOV0A: LDB TD,[POINT 6,TB,23] ; DOES THE BYTE END ON A FULL WORD?
JUMPE TD,GMOV1D ;YES -- GEN A FULL WORD LOAD
MOVE TA,[XWD BYTLIT,2]
PUSHJ PP,STASHP
HRRZ TA,EBASEA
PUSHJ PP,STASHQ
MOVE TA,EINCRA
HRL TA,TB
PUSHJ PP,POOLIT
MOVE CH,[XWD LDB.+AC4+ASINC,AS.MSC];[575] GENERATE <LDB 4,BYTE-POINTER-TO-A>
PUSHJ PP,PUTASY
SKIPN CH,PLITPC##
HRRZ CH,ELITPC
IORI CH,AS.LIT
PUSHJ PP,PUTASN
SKIPN PLITPC ;DON'T BUMP LIT COUNT IF WE POOLED
AOS ELITPC
JRST GMOV1B
GMOV1A: PUSHJ PP,PUTASA## ;YES, NEW CODE
TRNN TB,220000 ;LEFT-HALF?
SKIPA CH,[HRRZ.##+AC4,,0] ;[575]
MOVSI CH,HLRZ.##+AC4 ;[575]
GMOV1E: PUSHJ PP,PUT.A
GMOV1B: MOVE TB,EWORDB
LSH TB,6
CAIE TB,222200 ;CHECK FOR LEFT HALF-WORD
CAIN TB,002200 ;OR RIGHT HALF-WORD
JRST GMOV1C ;YES
MOVE TA,[XWD BYTLIT,2]
PUSHJ PP,STASHP
HRRZ TA,EBASEB ;CREATE BYTE POINTER TO "B"
PUSHJ PP,STASHQ
MOVE TA,EINCRB
HRL TA,TB
PUSHJ PP,POOLIT
SKIPN EACC,PLITPC ;WAS IT POOLED?
AOSA EACC,ELITPC ;NO
CAIA
SUBI EACC,1
PUSHJ PP,GENM7B ;[575] GENERATE <DPB 4,BYTE-POINTER-TO-B>
JRST GMOVE8 ;INCREMENT A AND B AND THEN RETURN
GMOV1C: PUSHJ PP,PUTASA
TRNN TB,220000
SKIPA CH,[HRRM.##+AC4,,0] ;[575]
MOVSI CH,HRLM.##+AC4 ;[575]
PUSHJ PP,PUT.B
JRST GMOVE8 ;BUMP A AND B INFO AND RETURN TO CALLER
GMOV1D: MOVSI CH,MOV+AC4 ;[575]
JRST GMOV1E
;GENERATE A MOVE BETWEEN TWO DISPLAY FIELDS OF EQUAL LENGTH (CONT'D).
;ITEMS HAVE THE SAME USAGE, AND THE SAME STARTING POSITION
GMOVE2: CAIE TB,^D36 ;START IN BIT 0?
JRST GMOVE6 ;NO
GMOVE3: MOVE TC,EMODEA ;YES--GET MODE OF FIRST OPERAND
MOVE TE,BYTE.W(TC) ;EXTEND UP TO OR PAST WORD BOUNDARY?
CAMLE TE,ESIZEZ
JRST GMOVE1 ;NO
LSH TE,1 ;YES--AT LEAST 2 FULL WORDS?
CAMLE TE,ESIZEZ
JRST GMOVE5 ;NO
CAME TE,ESIZEZ ;EXACTLY 2 WORDS
JRST GMOV3A ;NO
IFN BIS,<
PUSHJ PP,PUTASA ;YES
HRRZ TE,EBASEA
CAIG TE,17 ;OPERAND IN ACCS?
JRST GMOV5C ;YES
MOVSI CH,DMOVE.##+AC4 ;DMOVE - DMOVEM
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVSI CH,DMOVM.##+AC4
JRST GMOV5A ;COMMON CODE
>
IFE BIS,<
HRRZ TE,EBASEA
CAIG TE,17 ;OPERAND IN ACCS?
JRST GMOV5C ;YES
>
GMOV3A: MOVE TA,[XWD XWDLIT,2] ;CREATE [XWD A,B]
PUSHJ PP,STASHP
MOVE TA,EBASEA
HRL TA,EINCRA
PUSHJ PP,STASHQ
MOVE TA,EBASEB
HRL TA,EINCRB
PUSHJ PP,POOLIT
SKIPN PLITPC
AOS ELITPC
MOVE TE,ESIZEZ ;GENERATE <MOVE 4,[XWD]
IDIV TE,BYTE.W(TC) ; BLT 4,EBASEB+EINCRB-1>
ADDM TE,EINCRB ;INCREMENT THE INCREMENTS
ADDM TE,EINCRA
SETZM EWORDB
PUSHJ PP,GENM1A
GMOVE4: MOVEM TD,ESIZEZ ;STASH SIZE OF ANY REMAINING FIELD
JUMPN TD,GMOVE1 ;ANY MORE?
POPJ PP, ;NO
;ITEMS DO NOT HAVE MORE THAN ONE FULL WORD.
GMOVE5: HRRZ TE,EBASEA ;GET LOCATION OF OPERAND
CAIG TE,17 ;IN ACCS?
JRST GMOV5B ;YES
MOVSI CH,MOV+AC4 ;[575]
PUSHJ PP,PUT.A
MOVSI CH,MOVEM.+AC4 ;[575]
GMOV5A: PUSHJ PP,PUT.B
MOVE TE,ESIZEZ ;UPDATE SIZES AND INCREMENTS
IDIV TE,BYTE.W(TC)
ADDM TE,EINCRA
ADDM TE,EINCRB
JRST GMOVE4 ;LOOP BACK
IFE BIS,<
GMOV5C: HRRZ TE,EBASEA ;WHERE "A" IS
MOVEM TE,EAC ; MAKE IT THE CURRENT AC
MOVSI CH,MOVEM.
PUSHJ PP,PUT.BA ;MOVE FIRST WORD
AOS EBASEA ;BUMP SOURCE ACC
AOS EINCRB ;AND DESTINATION
>
GMOV5B: HRRZ TE,EBASEA ;GET AC WHERE "A" IS
MOVEM TE,EAC ; MAKE IT THE "CURRENT" AC
MOVSI CH,MOVEM.
PUSHJ PP,PUT.BA ;JUST MOVE FROM CURRENT ACC TO MEMORY
MOVE TE,ESIZEZ ;UPDATE SIZES AND INCREMENTS
IDIV TE,BYTE.W(TC)
AOS EBASEA ;IN ACS BUMP A OPERAND TO NEXT AC
AOS EINCRB
JRST GMOVE4 ;LOOP BACK
IFN BIS,<
GMOV5C: HRRZ TE,EBASEA ;WHERE IS "A"?
MOVEM TE,EAC ; CURRENT AC
MOVSI CH,DMOVM.
PUSHJ PP,PUT.BA ;JUST MOVE FROM CURRENT ACC TO MEMORY
MOVEI TE,2
ADDM TE,EBASEA ;IN ACS BUMP A OPERAND TO NEXT AC
ADDM TE,EINCRB
MOVE TE,ESIZEZ ;UPDATE SIZES AND INCREMENTS
IDIV TE,BYTE.W(TC)
JRST GMOVE4 ;LOOP BACK
>
;GENERATE A MOVE BETWEEN TWO DISPLAY FIELDS OF EQUAL LENGTH (CONT'D).
;ITEMS HAVE SAME USAGE AND STARTING POSITION, BUT THAT STARTING POSITION
; IS NOT BIT 0.
GMOVE6: MOVE TC,EMODEA ;RELOAD MODE
MOVE TC,BYTE.S(TC) ;UP TO OR THRU WORD BOUNDARY?
IMUL TC,ESIZEZ
SUB TB,TC
CAILE TB,1
JRST GMOVE1 ;NO
MOVSI CH,MOV+AC4 ;[575]
PUSHJ PP,PUT.A
HLRZ TB,ERESB
MOVE TC,TB
CAIN TB,22 ;RIGHT HALF-WORD?
JRST [PUSHJ PP,PUTASA ;YES
MOVSI CH,HRRM.##+AC4 ;[575]
PUSHJ PP,PUT.B
JRST .+3]
PUSHJ PP,GENM06 ;GENERATE BYTE POINTER TO "B" OPERAND
PUSHJ PP,GENM7B ;GENERATE THE DPB
MOVE TD,EMODEA ;UPDATE THE SIZE OF REMAINING FIELD
IDIV TC,BYTE.S(TD)
MOVN TD,TC
ADDB TD,ESIZEZ
MOVEI TE,^D36 ;SET RESIDUES TO 36
HRLM TE,ERESA
HRLM TE,ERESB
HRRZ TA,EBASEA ;[371] GET LOCATION OF A OPERAND
CAIG TA,17 ;[371] IS OPERAND A IN ACS
AOSA EBASEA ;[371] IN ACS BUMP A OPERAND TO NEXT AC
AOS EINCRA ;INCREMENT THE INCREMENTS
AOS EINCRB
MOVE TC,EMODEA
JUMPN TD,GMOVE3 ;ANYTHING LEFT?
POPJ PP, ;NO--RETURN
;GENERATE IMMEDIATE MOVE FOR LITERAL IN EBASEA
GMOV.I: MOVE TC,EMODEB
MOVEM TC,EMODEA ;RESET MODE TO BE EQUAL
TSWF FBSUB ;"B" SUBSCRIPTED?
JRST GMOVI0 ;YES, SETUP BYTE PTR IN SAC
MOVSI CH,HRRZI.+AC4
HRR CH,EBASEA
PUSHJ PP,PUTASY
HLRZ TE,ERESB ;GET BYTE RESIDUE
MOVE TD,BYTE.S(TC) ;GET BYTE SIZE
IMUL TD,ESIZEZ ;SHOULD BE 1
SUB TE,TD ;GET ENDING BIT
LSH TE,6
ADD TE,TD
MOVEM TE,EWORDB ;SAVE IT
JRST GMOV1B ;NOW STORE BYTE
;"A" IS IMMEDIATE MODE, "B" IS SUBSCRIPTED
;GEN: SETUP ILDB BYTE PTR IN AC10
; HRRZI AC4,CHAR
; IDPB AC4,AC10
GMOVI0: SETOM IBPFLG## ;MAKE ILDB BYTE POINTER
PUSHJ PP,SUBSCB ; SETUP SAC = BYTE PTR TO "B"
;GEN "HRRZI AC4, CHAR"
MOVSI CH,HRRZI.+AC4
HRR CH,EBASEA
PUSHJ PP,PUTASY
;GEN "IDPB AC4, SXR"
MOVE CH,[IDPB.+AC4,,SXR]
PUSHJ PP,PUTASY
JRST GMOVE8 ;GO INCREMENT THE PARAMETERS, THEN RETURN
;GENERATE A CALL TO SOME CONVERSION ROUTINE.
;THE SPECIFIC ROUTINE IS DETERMINED BY THE MODES OF THE "A" & "B" OPERANDS.
;BUILD THE PARAMETERS
GMOVE7:
SKIPG TC,ESIZEZ ;POSITIVE SIZE?
POPJ PP, ;NO--FORGET IT
IFE BIS,< ;ONLY NEED TO CHECK SIZE FOR NON-BIS CASE
CAILE TC,MXPSZ.## ;GREATER THAN MAX WE CAN FIT IN PARAM?
JRST GMOVE9 ;YES
> ;END OF IFE BIS
JRST GMOV7A
;HERE IF MOVE IS OF A TABLE WITH DEPENDING ITEM
IFN BIS,<
SRCAC==4
DSTAC==7
>;END IFN BIS AC DEFS
IFE BIS,<
SRCAC==4
DSTAC==16
>;END IFE BIS AC DEFS
MDDDEP: PUSHJ PP,DEPTSA ;FOR "A"
JRST NOTADP ; NO, IT'S "B" WHO'S DEPENDING
MOVEI TE,SRCAC ;USE SOURCE AC
PUSHJ PP,SZDPVA## ; SETUP SRCAC = SIZE OF 'A'
JRST NOTADP ;ERRORS, SKIP THIS
MOVEI TE,SRCAC ;AC TO SAVE IF FURTHER CONVERSION NECESSARY
MOVEM TE,CONVSV## ;SAVE THE VALUE
JRST GOSTPB ;GO SETUP "B"
NOTADP: SETZM CONVSV## ;NO AC TO SAVE FOR CONVERSIONS YET
GOSTPB: PUSHJ PP,DEPTSB ;IS "B" DEPENDING?
JRST NOTBDP ;NO, SKIP THIS
MOVEI TE,DSTAC ;USE DESTINATION AC
PUSHJ PP,SZDPVB## ; CALL ROUTINE TO SETUP SIZE
JRST NOTBDP ;?ERROR - KEEP GOING
NOTBDP: SETZM CONVSV## ;DON'T WORRY ABOUT SAVING ACS
IFE BIS,< ;[1324]
IFE ANS74,< MOVE TA,ESIZEZ ;[1324] TEST ON SIZE OF FIELD
CAILE TA,MXPSZ. ;[1324] BREAK INTO SMALLER PARTS
JRST GMOVE9 ;[1324] IF GREATER THAN 3770
>; [1324] END OF IFE ANS74
PUSHJ PP,B2PARD## ;[1324] ELSE USE AS ONE CHUNK
>;[1324] END OF IFE BIS
IFN BIS,< PUSHJ PP,NB2PAR## ;OR BUILD BYTE POINTERS IN ACS>
;SIZES HAVE BEEN SETUP FOR THE DEPENDING VARIABLE.
; SETUP THE SIZE FOR THE OTHER IF IT IS CONSTANT.
PUSHJ PP,DEPTSA ;SKIP IF 'A' IS DEPENDING
CAIA ;NO
JRST GMVXX1 ;YES--SIZE ALREADY SETUP
HRLI CH,MOVEI.+<SRCAC_5>
HRR CH,ESIZEA
PUSHJ PP,PUTASY ;"MOVEI SRCAC, SIZE.OF.A"
GMVXX1: PUSHJ PP,DEPTSB ;SKIP IF 'B' IS DEPENDING
CAIA ;NO
JRST GMVXX2 ;YES--SIZE ALREADY SETUP
HRLI CH,MOVEI.+<DSTAC_5>
HRR CH,ESIZEB
PUSHJ PP,PUTASY ;"MOVEI DSTAC, SIZE.OF.B"
; HERE WHEN ALL DONE SETTING UP COUNTS IN ACS
GMVXX2:
IFN BIS,<
;NOW GENERATE EXTEND DEPENDING ON MODE OF OPERANDS
HRRZ TA,EMODEA
HRRZ TB,EMODEB
CAME TA,TB ;ARE THEY SAME MODE?
JRST GMOV.4 ;NOT SAME
;SAME MODE CAN USE SIMPLE MOVE STRING LEFT JUSTIFIED WITH FILL
MOVE TA,[XTNLIT,,1] ;TELL ABOUT OCTAL LITERAL
PUSHJ PP,STASHP ;POOLED
MOVSI TA,(MOVSLJ) ;WANT A MOVE STRING LEFT JUSTIFIED
SKIPGE EMODEB ;UNLESS "B" IS RIGHT JUSTIFIED
MOVSI TA,(MOVSRJ) ; THEN, WANT A MOVE STRING RIGHT JUSTIFIED
;COMMON DEPENDING CODE
GMOV.0: PUSHJ PP,STASHQ ;POOLED
AOS ELITPC ;MAKE SURE 2ND ADDR GETS RIGHT PC
MOVE TA,[OCTLIT,,1] ;AND WE WANT A CONSTANT FILL
PUSHJ PP,STASHP
MOVE TA,EMODEB ;THE MODE OF THE DESTINATION
HRRZ TA,IFSPCS##(TA) ;THE SPACE FOR THE MODE OF THE DESTINATION
PUSHJ PP,POOLIT ;POOLED AS A TWO WORD LITERAL.
SOS ELITPC ;BACK TO ORIGINAL ELITPC
PUSHJ PP,PUTASA ;NOW GENERATE EXTEND (SECOND SET OF OP CODES)
MOVSI CH,XTND.+AC4 ;USING AC4 AS THE START OF THE AC BLOCK
PUSHJ PP,PUT.LD ;OUTPUT USING LATEST LITERAL
MOVE TA,ELITPC ;NOW INCREMENT LITERAL POOL
SKIPN PLITPC ;
ADDI TA,2 ;WE MADE TWO WORDS
MOVEM TA,ELITPC ;
PUSHJ PP,PUTASA ;SECOND OP-CODE SET
MOVSI CH,JFCL. ;OUTPUT NO-OP FOLLOWING EXTEND
PUSHJ PP,PUTASY ;CAUSE WE DONT CARE ABOUT SKIP
JRST GMOVE8 ;INCREMENT PARAMETERS AND RETURN
> ;END OF IFN BIS, AT GMOV7E
IFE BIS,<
MOVE TA,[BYTLIT,,2]
PUSHJ PP,STASHP
MOVE TA,[AS.BYT,,AS.MSC]
PUSHJ PP,STASHQ
MOVSI TA,(POINT 11,0,17)
HRRI TA,1(EACC) ;GET TEMP+1
PUSHJ PP,POOLIT
MOVE CH,[DPB.+<SRCAC_5>+ASINC,,AS.MSC]
PUSHJ PP,PUTASY
SKIPE CH,PLITPC
JRST .+3
AOS CH,ELITPC
SUBI CH,1
IORI CH,AS.LIT
PUSHJ PP,PUTASN
SETOM HRRIFL## ;SETUP LH OF AC16 (DSTAC) NOW
PUSHJ PP,PUTASA## ;HRLZ IN 2ND CODE SET
MOVE CH,[HRLZ.+AC16,,16]
PUSHJ PP,PUTASY ;GET AC16= XWD 1B0+ DST SIZE,,0
MOVE CH,[TLO.+ASINC+AC16,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,(1B0)
PUSHJ PP,PUTASN ;TURN ON BIT 0 TO MAKE SURE SOMETHING IS THERE
JRST GMOV7B
> ;END OF IFE BIS STARTING AT GMOV7E
;GENERATE ACTUAL PUSHJ TO LIBOL MOVE ROUTINE
GMOV7A: PUSHJ PP,B2PAR ;NO--BUILD PARAMETER WORDS
;GENERATE CODE TO CALL A LIBOL ROUTINE.
;GENERATE "HRRZI 16, PARAMETER ADDRESS".
GMOV7B: SKIPE HRRIFL## ;IS SOMETHING IN LH(AC16)?
SKIPA CH, [XWD HRRI.+AC16+ASINC,AS.MSC] ;YES--GET HRRI
MOVE CH, [XWD HRRZI.+AC16+ASINC,AS.MSC]
PUSHJ PP, PUTASY
HRRZI CH, (EACC)
PUSHJ PP, PUTASN
SETZM HRRIFL## ;CLEAR HRRI FLAG IF SET
;GENERATE "PUSHJ 17, ROUTINE".
GMOV7Y: HRRZ TC, EMODEA ;GEN THE MODE OF THE OPERADNDS.
HRRZ TE, EMODEB
IMULI TC, 3 ;FORM THE TABLE ADDRESS.
ADDI TC, (TE)
ROT TC, -1
JUMPL TC, .+2 ;IF NEGATIVE USE THE LEFT HALF.
SKIPA CH, GMOVEX(TC) ;POSITIVE, USE RIGHT HALF.
HLRZ CH, GMOVEX(TC) ;NEGATIVE.
PUSHJ PP, GNPSX.## ;GO GENERATE THE INSTRUCTION.
;INCREMENT THE PARAMETERS.
GMOVE8:
IFN BIS, SETZM USENBT ;ZERO MULTIPLE BYTE FLAG
MOVE TE,ESIZEZ ;INCREMENT "B" PARAMETERS
PUSHJ PP,M.IB
MOVE TE,ESIZEZ ;INCREMENT "A" PARAMETERS
PJRST M.IA ; AND RETURN
;GENERAL MOVE WITH SIZE GREATER THAN THE SIZE WE CAN FIT IN A PARAMETER.
IFE BIS,< ;ONLY DO LOOP IN NON-BIS CASE
GMOVE9: PUSH PP,ESIZEB ; [416] SAVE ESIZE OF B
PUSHJ PP,GMOV9A ; [416] DO THE LARGE MOVE
POP PP,ESIZEB ; [416] RESTORE ORIGINAL SIZE OF B
POPJ PP, ; [416] RETURN
GMOV9A: MOVEI TC, MXPSZ.## ; [416] MAXIMUM SIZE IN A PARAMETER.
EXCH TC, ESIZEZ ;REDUCE THE SIZE.
SUB TC, ESIZEZ
PUSH PP, TC ;SAVE IT.
MOVE TC,ESIZEZ ; [416] GET BACK SIZE WE ARE MOVING
MOVEM TC,ESIZEB ; [416] MAKE THIS SIZE OF B FOR SUBSCC ROUTINE IN CMNGEN
PUSHJ PP, GMOV7A ;GO GENERATE CODE TO MOVE
; MXPSZ. BYTES.
POP PP, TC ;GET THE REMAINING SIZE.
MOVEM TC, ESIZEZ ;TELL EVERYBODY WHAT IT IS.
MOVEM TC, ESIZEB ; [416] NEW SIZE OF B
CAILE TC, MXPSZ.## ;TOO MANY BYTES LEFT?
JRST GMOVE9 ;YES, GO REPEAT THE PROCESS.
JRST GMOV7A ;NO, GO MOVE THE REST AND RETURN.
> ;END OF IFE BIS
IFN BIS,< ;ONLY HAVE THIS CODE IF BIS TURNED ON
;GENERATE CODE TO DO EXTEND INSTR IN-LINE IF SAME USAGE
GMOV.1:
;GET HERE IF EITHER OPERAND
; IS NOT WORD CONTAINED.
; WE SEE IF POSSIBLE TO MOVE MULTIPLE BYTES,
; AND GENERATE THE EXTEND INSTR OR A COUPLE OF
; ILDB/IDPB INSTRS.
MOVE TA, ESIZEZ ;GET SIZE OF OPERANDS
MOVEM TA, NCHARS## ;SET UP ARG FOR TEST ROUTINE
PUSHJ PP, GETNB## ;RETURNS IN NBYTES THE NUMBER OF
; BYTES (MULTIPLE) WE CAN
; USE TO SPEED UP THE EXTEND.
; THE USENBT FLAG IS CLEARED
; BY GMOVE8, THE EXIT ROUTINE.
SETOM USENBT## ;ASSUME WE CAN USE LARGER BYTES
MOVE TB, ESIZEZ ;GET SIZE OF THE MOVE
IDIV TB, NBYTES ;DIVIDE TO GET NUMBER OF BYTES TO MOVE
; (SIDE EFFECT: ZERO'S TA)
CAIN TB, 1 ;IF ONE BYTE
JRST GMOV.7 ;DO SPECIAL CASE
PUSHJ PP, NB2PAR## ;GENERATE ILDB BYTEPOINTERS
; IN ACS WITH SUBSCRIPTING ALL
; TAKEN CARE OF.
MOVE TA, NBYTES## ;SEE IF 4 OR 6 BYTES/BYTE
CAIE TA, 4 ; IN WHICH CASE WE CAN DO A BLT!
CAIN TA, 6
JRST GMOV.W ;MOVE FULL WORD STYLE
MOVE TB, ESIZEZ ;GET SIZE OF MOVE
IDIV TB, NBYTES## ;DIVIDE BY MULTIPLE TO GET NEW SIZE
; (SIDE EFFECT: ZERO'S TA)
CAILE TB, 2 ;IF SMALL SIZE DONT USE EXTEND
JRST GMOV.6 ;LARGE--GO AROUND ILDB/IDPB LOOP
;WE KNOW THERE ARE TWO BYTES IF WE GET HERE, SINCE
; ONE BYTE CASE IS HANDLED EARLIER, AND MORE THAN TWO
; BYTES ARE HANDLED LATER. JUST GENERATE TWO ILDB/IDPB'S.
MOVE CH, [ILDB.+AC4,,5] ;LOAD BYTE FROM AC5 TO AC4
PUSHJ PP, PUTASY ;
MOVE CH, [IDPB.+AC4,,10] ;DEPOSIT BYTE FROM AC4 TO AC10
PUSHJ PP, PUTASY ;
MOVE CH, [ILDB.+AC4,,5] ;LOAD BYTE FROM AC5 TO AC4
PUSHJ PP, PUTASY ;
MOVE CH, [IDPB.+AC4,,10] ;DEPOSIT BYTE FROM AC4 TO AC10
PUSHJ PP, PUTASY ;
JRST GMOVE8 ;INCREMENT ARGS AND RETURN
;MOVING FULL WORDS, USE (AC5) AS PTR TO 1ST, (AC10) AS PTR TO 2ND
GMOV.W: MOVE TB,ESIZEZ ;TOTAL # BYTES IN MOVE
IDIV TB,NBYTES ;HOW MANY WORDS?
CAIN TB,2 ;CAN WE USE DMOVE/M?
JRST GMOV.Y ;YES
;DO A BLT
; GENERATE: MOVSI 5,"A"
; HRRI 5,"B"
; BLT 5,N-1+B
GMOVW1: MOVSI CH,MOVSI.+AC5
PUSHJ PP,PUT.A ;"MOVSI 5,A"
MOVSI CH,HRRI.+AC5
PUSHJ PP,PUT.B ;"HRRI 5,B"
MOVE TB,ESIZEZ
IDIV TB,NBYTES
MOVEI TB,-1(TB) ;N-1
PUSH PP,EINCRB## ;SAVE INCR. OF "B"
ADDM TB,EINCRB## ;ADD TO "B" INCREMENT
MOVSI CH,BLT.+AC5
PUSHJ PP,PUT.B ;"BLT 5,B+N-1"
POP PP,EINCRB## ;RESTORE OLD INCREMENT
JRST GMOVE8 ;DONE
;HERE FOR 2-WORD MOVE. USE DMOVE/DMOVEM
GMOV.Y: PUSHJ PP,PUTASA## ;READY FOR "DMOVE"
MOVSI CH,DMOVE.
PUSHJ PP,PUT.AA## ;DMOVE AC,"A"
PUSHJ PP,PUTASA## ; START OF DMOVEM
MOVSI CH,DMOVM.
PUSHJ PP,PUT.BA## ;DMOVEM AC,"B"
JRST GMOVE8
>;END OF IFN BIS
GMSUB:
;HERE FOR MOVE BETWEEN TWO ITEMS WITH SAME DISPLAY MODE,
; AND AT LEAST ONE OF THEM IS SUBSCRIPTED. IF SAME
; STARTING BIT IS GUARANTEED, THE SLOW "EXTEND" INSTRUCTION
; CAN BE AVOIDED (OR SLOW BYTE INSTRUCTIONS FOR NON-BIS)
;THIS WILL ALSO ALLOW MOVING BIT 35 FOR ASCII ITEMS, WHEN
; THE SAME STARTING BIT IS GUARANTEED.
HLRZ TB,ERESA ;GET RESIDUE OF BASE "A"
HLRZ TA,ERESB ; AND BASE "B"
CAME TA,TB ;MUST BE = FOR THIS...
JRST GMSUBO ;NO, HAVE TO USE SINGLE BYTE CHUNKS
TSWT FASUB ;IS "A" SUBSCRIPTED?
JRST GMSUBB ;NO
HLRZ TA,OPERND ;POINT TO "A" OPERAND
HRRZ TD,EMODEA
HRRZ TB,BYTE.W##(TD) ;[654] GET # BYTES/WORD FOR "A"
PUSHJ PP,CHKSBP ;SAME STARTING BIT?
JRST GMSUBO ;NO, DO IT THE "OLD" WAY
GMSUBB: TSWT FBSUB ;IS "B" SUBSCRIPTED?
JRST GMSUBC ;NO
HRRZ TA,OPERND ;POINT TO "B" OPERAND
HRRZ TD,EMODEB
HRRZ TB,BYTE.W(TD) ;[654] TD= # BYTES/WORD FOR "B"
PUSHJ PP,CHKSBP ;SAME STARTING BIT?
JRST GMSUBO ;NO, AGAIN, DO IT THE "OLD" WAY
HRRZ TE,EBASEA ;MAYBE "A" IS IN ACS
;[537] CAIG TE,17 ;IF THIS HAPPENS, SEE EDIT 371 (GMOVE6+FEW)
;[537] TTCALL 3,[ASCIZ/? SUBSCRIPTED MOVE WITH "A" IN ACS!!
;[537] /]
; NOW WE KNOW THAT NO MATTER WHAT THE SUBSCRIPTS ARE, THEY WILL WORK
;OUT TO START AT THE SAME STARTING BIT. THE CODE TO GENERATE IS:
;
; MOVE 4,[FIRST PART OF "A"]
; DPB 4,[FIRST PART OF "B"]
; "BLT", OR MOVE/MOVEM, FOR MIDDLE PART
; LDB 4,[LAST PART OF "A"]
; DPB 4,[LAST PART OF "B"]
;
; IT IS LIKELY THAT THE ITEMS WILL EITHER BEGIN OR END ON A WORD BOUNDARY,
;SO THAT THE FIRST OR LAST TWO INSTRUCTIONS MAY NOT BE NEEDED.
;
; WE START BY SETTING UP AC5 IFF "A" IS SUBSCRIPTED,
; AC10 IFF "B" IS SUBSCRIPTED.
GMSUBC: SETZM IBPFLG## ;MAKE SURE RH OF AC POINTS TO START OF ITEM
MOVEI TE,5 ;AC5 FOR "A"
MOVEM TE,SUSEAC##
PUSHJ PP,SUBSCA ;SETUP AC5 IF A IS SUBSCRIPTED
MOVEI TE,10 ; AND AC10 IF B IS SUBSCRIPTED
MOVEM TE,SUSEAC
PUSHJ PP,SUBSCB
SETZM SUSEAC ;DON'T LEAVE JUNK IN SUSEAC
SETZM INDIND## ;SO FAR, WE HAVE MOVED 0 WORDS
; SO THE "INDEX TO THE INDEXES" IS 0
HLRZ TC,ERESA ;START IN BIT 0?
CAIN TC,^D36
JRST GMSUBM ;YES--GO ON TO "MIDDLE PART"
;NOTE: TC:= # BITS LEFT IN THIS WORD THAT CAN BE DATA
;DO "FIRST" PART - MOVE BITS TO THE FIRST WORD BOUNDARY
HRRZ TA,EMODEA
HRRZ TA,BYTE.S##(TA) ;BITS/BYTE FOR THIS MODE
IDIV TC,TA ;TC= # BYTES LEFT IN THIS WORD
CAMLE TC,ESIZEZ ; MOVING AT LEAST TILL THE WORD BOUNDARY?
JRST GMSUBF ;NO--JUST PARTIAL MOVE, THEN EXIT!
EXCH TC,ESIZEZ ;UPDATE ESIZEZ TO WHAT IT WILL BE
SUB TC,ESIZEZ ; AFTER THIS FIRST PART IS DONE
MOVEM TC,ESIZEZ
;GEN: MOVE 4,FIRST.PARTIAL.WORD.OF.A
; DPB 4,FIRST.PARTIAL.WORD.OF.B
MOVSI CH,MOV+AC4 ;START INSTRUCTION
TSWT FASUB ;WHERE IS BYTE PTR TO "A"?
JRST GMSUF1 ;NOT SET UP
MOVSI TE,5 ;ALREADY SETUP IN AC 5
IOR CH,TE ; GEN "MOVE 4,(5)"
PUSHJ PP,PUTASY##
JRST GMSUF2
GMSUF1: PUSHJ PP,PUT.A## ;NO BYTE PTR TO "A" NEEDED!!!
;GEN "MOVE 4,A"
; NOW, CAREFULLY, GENERATE A BYTE PTR TO THE FIRST PART OF "B".
;IT MUST INCLUDE BIT 35.
GMSUF2: MOVE TA,[XWD BYTLIT,2]
PUSHJ PP,STASHP ;READY TO PUT BYTE PTR IN LITERALS
TSWF FBSUB ;SKIP IF "B" NOT SUBSCRIPTED
JRST [SETZ TA, ;IT IS, RH OF BYTE PTR WILL BE 0
PUSHJ PP,STASHQ
JRST GMSUF3]
HRRZ TA,EBASEB
PUSHJ PP,STASHQ
GMSUF3: HLRZ TA,ERESB ;RESIDUE (NO MATTER WHAT THE SUBSCRIPTS ARE!)
SETZ TB, ;TB:= <35 - BIT POSITION TO STOP MOVE AT>
MOVE TE,TA ;COPY SIZE OF BYTE PTR
SETZ TA,
DPB TE,[POINT 6,TA,11] ;PUT SIZE IN BYTE PTR
DPB TB,[POINT 6,TA,5] ;PUT <35 - END.BIT.POSITION> IN BYTE PTR
MOVSI TE,10 ;AC10 (IF "B" IS SUBSCRIPTED)
TSWF FBSUB ;SKIP IF IT ISN'T
IOR TA,TE ; ELSE PUT INDEX AC IN BYTE PTR
TSWT FBSUB
HRR TA,EINCRB ;ALSO ADD INCREMENT IF NOT SUBSCRIPTED
PUSHJ PP,POOLIT ;FINISH BYTE PTR TO FIRST PART OF "B"
MOVSI CH,DPB.+AC4
PUSHJ PP,PUT.LD ;GEN "DPB 4,PTR.TO.B"
SKIPN PLITPC## ;LITERAL POOLED?
AOS ELITPC## ;NO, COUNT IT
;DONE THE FIRST PART. ADJUST THINGS TO START AT THE NEXT WORD
;BOUNDARY, AND SEE IF ANY MORE CHARS TO MOVE
MOVEI TE,^D36 ;HERE IS A NEW RESIDUE
HRLM TE,ERESA
HRLM TE,ERESB
AOS EINCRA
AOS EINCRB
AOS INDIND## ;INCREMENT INDEX TO THE INDEXES
SKIPN ESIZEZ ;ANY MORE CHARS TO MOVE?
POPJ PP, ;NO, RETURN
;HERE TO DO "MIDDLE PART" OF MOVE, IF NECESSARY
GMSUBM: MOVE TE,ESIZEZ ;FIRST SEE IF IT'S NECESSARY
HRRZ TC,EMODEB
HRRZ TC,BYTE.W(TC) ;BYTES/WORD
IDIV TE,TC ;TE= WORDS LEFT TO MOVE, TD= BYTES LEFT OVER
JUMPE TE,GMSUBL ; NO COMPLETE WORDS LEFT -- GO ON TO LAST PART
MOVEM TE,SAVENW## ;SAVE # WORDS TO MOVE
MOVEM TD,ESIZEZ ; MAKE ESIZEZ= # BYTES LEFT OVER AFTER THIS
CAIN TE,1 ;1 WORD IN MIDDLE PART?
JRST GMSM1W ;YES, GEN MOVE/MOVEM
CAIN TE,2 ;2 WORDS IN MIDDLE PART?
JRST GMSM2W ;YES, GEN DMOVE/DMOVEM
;3 OR MORE WORDS IN MIDDLE PART. GENERATE A "BLT".
; HRLI 4,"A"
; HRRI 4,"B"
; BLT 4,"B"+SAVENW-1
PUSHJ PP,PUTASA## ;HRLI IN 2ND CODE SET
MOVEI CH,HRLI.+AC4
TSWF FASUB ;IF SUBSCRIPTED,
IORI CH,5 ;INDEX BY AC5
HRLZ CH,CH
TSWT FASUB ;SKIP IF "A" IS SUBSCRIPTED
JRST [PUSHJ PP,PUT.A ; GEN THE HRLI 4,A
JRST GMSM01] ;DONE WITH THIS INSTRUCTION
HRR CH,INDIND## ;INCREMENT TO THE INDEX
PUSHJ PP,PUTASY## ;GEN "HRLI 4,INDIND(5)"
GMSM01: MOVEI CH,HRRI.+AC4
TSWF FBSUB
IORI CH,10
HRLZ CH,CH
TSWT FBSUB
JRST [PUSHJ PP,PUT.B
JRST GMSM02]
HRR CH,INDIND
PUSHJ PP,PUTASY##
GMSM02: MOVEI CH,BLT.+AC4
TSWF FBSUB
IORI CH,10
HRLZ CH,CH
TSWF FBSUB
JRST GMSM03 ;"B" IS SUBSCRIPTED
PUSH PP,EINCRB ;SAVE INCREMENT OF "B"
MOVE TE,SAVENW## ;# WORDS TO MOVE
SUBI TE,1
ADDM TE,EINCRB
PUSHJ PP,PUT.B ;GEN "BLT 4,B+N"
POP PP,EINCRB ;RESTORE INCREMENT OF "B"
JRST GMSMDN
GMSM03: HRR CH,SAVENW## ;# WORDS TO MOVE
SUBI CH,1 ; -1
ADD CH,INDIND ;ACCOUNT FOR WORDS ALREADY MOVED
PUSHJ PP,PUTASY## ; "BLT 4,B+N-1"
JRST GMSMDN ;DONE WITH MIDDLE PART
; ONE WORD IN MIDDLE PART. GEN:
; MOVE 4,"A"
; MOVEM 4,"B"
GMSM1W: PUSHJ PP,GMSM11 ;GEN 1 MOVE/MOVEM
JRST GMSMDN ;THEN DONE
;ROUTINE TO GENERATE "MOVE / MOVEM" TO MOVE 1 WHOLE WORD OF DATA
GMSM11: MOVEI CH,MOV+AC4
TSWT FASUB ;SUBSCRIPTED?
JRST GMSM1A ;NO
IORI CH,5
HRLZ CH,CH
HRR CH,INDIND ;INDEX TO THE INDEXES
PUSHJ PP,PUTASY## ;MOVE 4,INDIND(5)
JRST GMSM1C ; NOW DO MOVEM
GMSM1A: HRLZ CH,CH
PUSHJ PP,PUT.A ;MOVE 4,A
GMSM1C: MOVEI CH,MOVEM.+AC4
GMSM1E: TSWT FBSUB ;[537] ADD LABEL
JRST GMSM1D ;NOT SUBSCRIPTED
IORI CH,10
HRLZ CH,CH
HRR CH,INDIND
JRST PUTASY## ;MOVEM 4,INDIND(10), THEN RETURN
GMSM1D: HRLZ CH,CH
JRST PUT.B ;MOVEM 4,B, THEN RETURN
;HERE IF MIDDLE PART IS 2 WORDS
;GEN: MOVE 4,A
; MOVEM 4,B
; MOVE 4,A+1
; MOVEM 4,B+1
GMSM2W: HRRZ TE,EBASEA ;[537] SEE IF A IN ACS
CAIG TE,17 ;[537]
JRST GMSM2Q ;[537] YES
IFN BIS,<
TSWF FASUB ;IF "A" IS NOT SUBSCRIPTED, THEN
; WE CAN SMASH AC5
JRST GMSM21 ;ELSE HAVE TO DO 2 MOVE/MOVEM'S, LIKE NON-BIS
PUSHJ PP,PUTASA## ;GET SET FOR "DMOVE"
MOVSI CH,DMOVE.+AC4
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA## ;GET SET FOR "DMOVEM"
MOVEI CH,DMOVM.+AC4
GMSMQR: TSWT FBSUB ;[537] ADD NEW LABEL
JRST [HRLZ CH,CH
PUSHJ PP,PUT.B
JRST GMSMDN]
IORI CH,10
HRLZ CH,CH
HRR CH,INDIND##
PUSHJ PP,PUTASY## ;"DMOVEM 4,INDIND(10)"
JRST GMSMDN
GMSM21:
>;END IFN BIS
PUSHJ PP,GMSM11 ;DO FIRST WORD
AOS EINCRA
AOS EINCRB ;INCREMENT THE INCREMENTS
AOS INDIND
SOS SAVENW## ;PRETEND ONLY 1 WORD IS GOING TO BE MOVED
PUSHJ PP,GMSM11 ;DO 2ND WORD
JRST GMSMDN ;GO TO THE MIDDLE ONE
;[537] "A" IN ACS - (MOVE TODAY TO SUBSCRIPTED-ITEM..)
GMSM2Q: ;[537]
IFN BIS,< ;[537]
PUSHJ PP,PUTASA## ;[537] GET SET TO GENERATE "DMOVEM"
HRRZ CH,EBASEA ;[537] AC TO MOVE FROM
LSH CH,5 ;[537] SHIFT TO AC FIELD
IORI CH,DMOVM. ;[537] DMOVEM AC,
JRST GMSMQR ;[537] GO PUT "B" IN ADDRESS FIELD
>;END IFN BIS ;[537]
IFE BIS,< ;[537] AND FOR YOU KI/KA FOLKS
HRRZ TE,EBASEA ;[537] GET AC WHERE "A" IS
LSH TE,5 ;[537] WILL BE IN AC POSITION...
MOVEI CH,MOVEM.(TE) ;[537] [564] MOVEM AC,
PUSHJ PP,GMSM1E ;[537] DO FIRST "MOVEM" TO 1ST WORD OF B
HRRZ TE,EBASEA ;[537] THEN MOVE THE 2ND WORD
AOS TE ;[537]..
LSH TE,5 ;[537]
MOVEI CH,MOVEM.(TE) ;[537] [564] MOVEM AC+1,
PUSHJ PP,GMSM1E ;[537] DO "MOVEM" TO 2ND WORD OF B
JRST GMSMDN ;[537] DONE
>;END IFE BIS ;[537] (END OF PATCH)
;HERE WHEN MIDDLE PART IS DONE, FIXUP INFO, START ON FINAL PART IF NECESSARY
GMSMDN: MOVE TE,SAVENW## ;HOW MANY WORDS WERE MOVED?
ADDM TE,INDIND ; INCREMEMT THE INCREMENTS
ADDM TE,EINCRA
ADDM TE,EINCRB
;HERE TO START ON THE LAST PART OF THE MOVE
GMSUBL: SKIPN ESIZEZ ;ANY CHARS LEFT?
POPJ PP, ;NO, DONE, SO RETURN FROM MOVE
HRRZ TC,EMODEB
HRRZ TC,BYTE.S(TC) ;GET # BITS/BYTE
IMUL TC,ESIZEZ ;TC= # BITS LEFT TO MOVE
PUSH PP,TC ;SAVE # BITS LEFT
CAIN TC,^D18 ;18 ?
JRST GMSL01 ;YES, USE HLRZ
; GEN "LDB 4,A"
MOVE TA,[XWD BYTLIT,2]
PUSHJ PP,STASHP ;START A BYTE PTR TO "A"
TSWF FASUB ;GET "BASE"
SKIPA TA,INDIND##
HRRZ TA,EBASEA
PUSHJ PP,STASHQ
SETZ TA, ;START FRESH
MOVE TC,0(PP) ;RESTORE TC FROM STACK WITHOUT "POP"-ING
DPB TC,[POINT 6,TA,11] ;STORE BYTE SIZE IN PTR
TSWF FASUB ;IF SUBSCRIPTED,
IOR TA,[5,,0] ; STICK INDEX IN BYTE PTR
MOVEI TD,^D36
SUB TD,TC ;TD= 35 - RIGHTMOST BIT POSITION TO MOVE
DPB TD,[POINT 6,TA,5] ;STORE BYTE RESIDUE IN PTR
TSWT FASUB ;IF NOT SUBSCRIPTED,
HRR TA,EINCRA ; GET ACTUAL INCREMENT
PUSHJ PP,POOLIT ;FINISH BYTE PTR LITERAL
MOVSI CH,LDB.+AC4
PUSHJ PP,PUT.LD## ;LDB 4,LITERAL
SKIPN PLITPC
AOS ELITPC
JRST GMSL02
;HERE IF "HLRZ" WILL DO (MOVING 18 BITS)
GMSL01: PUSHJ PP,PUTASA ;IN 2ND CODE SET
MOVEI CH,HLRZ.+AC4
TSWT FASUB
JRST [HRLZ CH,CH
PUSHJ PP,PUT.A
JRST GMSL02]
IORI CH,5
HRLZ CH,CH
HRR CH,INDIND ;"HLRZ 4,INDIND(5)"
PUSHJ PP,PUTASY##
GMSL02: POP PP,TC ;RESTORE # BITS LEFT
CAIN TC,^D18 ; EXACTLY A HALFWORD?
JRST GMSLHF ;YES, GEN "HRLM"
;WE MUST GENERATE A BYTE PTR TO "B"
MOVE TA,[XWD BYTLIT,2]
PUSHJ PP,STASHP ;GOING TO GENERATE A LITERAL BYTE PTR
TSWF FBSUB
SKIPA TA,INDIND ;USE "INCREMENT TO THE INCREMENTS" AS THE BASE
HRRZ TA,EBASEB ; UNLESS NOT SUBSCRIPTED-- THEN USE REGULAR BASE
PUSHJ PP,STASHQ
SETZ TA, ;START WITH FRESH TA
DPB TC,[POINT 6,TA,11] ;STORE BYTE SIZE IN PTR
TSWF FBSUB ;IF SUBSCRIPTED,
IOR TA,[10,,0] ; STICK INDEX IN BYTE PTR
MOVEI TD,^D36
SUB TD,TC ;TD= 35 - RIGHTMOST BIT POSITION TO MOVE
DPB TD,[POINT 6,TA,5] ;STORE BYTE RESIDUE IN PTR
HRLM TD,ERESA ;BY COINCIDENCE, THIS IS NEW RESIDUE FOR "A"
HRLM TD,ERESB ; AND "B"
TSWT FBSUB ;IF NOT SUBSCRIPTED,
HRR TA,EINCRB ; GET ACTUAL INCREMENT
PUSHJ PP,POOLIT ;POOL THE LITERAL
MOVSI CH,DPB.+AC4
PUSHJ PP,PUT.LD## ;DPB 4,LITERAL
SKIPN PLITPC## ;POOLED?
AOS ELITPC## ;NO, INCREMENT LITERAL PC
POPJ PP, ;DONE THE MOVE!
;EXACTLY 18 BITS TO MOVE. GEN: HRLM CH,"B"
GMSLHF: MOVEI TE,^D18 ;FINAL RESIDUE
HRLM TE,ERESA
HRLM TE,ERESB
PUSHJ PP,PUTASA ;HRLM IN 2ND CODE SET
MOVEI CH,HRLM.+AC4
TSWT FBSUB
JRST [HRLZ CH,CH
PJRST PUT.B]
IORI CH,10
HRLZ CH,CH
HRR CH,INDIND
JRST PUTASY## ;GEN "HRLM 4,INDIND(10)" THEN RETURN FROM MOVE
; HERE IF BOTH ITEMS ARE WORD-CONTAINED AND DON'T START AT BIT 0.
; THIS IS AN ESPECIALLY RARE SET OF SPECIAL CASES.
GMSUBF: HLRZ TE,ERESA ;CHECK RESIDUE FOR POSSIBLE HALFWORD
; INSTRUCTIONS
CAIE TE,^D18
JRST GMSF01 ;FORGET IT
HRRZ TE,EMODEA
HRRZ TE,BYTE.S(TE) ;BITS/BYTE
IMUL TE,ESIZEZ ; * # BYTES
CAIN TE,^D18 ;WILL WE MOVE EXACTLY A HALFWORD?
JRST GMSFHF ;YES--USE HRRZ / HRRM
;GEN: LDB 4,"A"
; DPB 4,"B"
GMSF01: MOVE TA,[XWD BYTLIT,2]
PUSHJ PP,STASHP ;GET SET TO MAKE A BYTE PTR TO "A"
SETZ TA, ; ASSUME SUBSCRIPTED, RH OF BYTE PTR=0
TSWT FASUB
HRRZ TA,EBASEA ;NO, GET BASE
PUSHJ PP,STASHQ
HRRZ TE,EMODEA
HRRZ TE,BYTE.S(TE)
IMUL TE,ESIZEZ ;# BITS IN BYTE PTR
HLRZ TD,ERESA
SUB TD,TE ;TD= NEW RESIDUE
SETZ TA, ;START WITH FRESH TA
TSWF FASUB ; IF SUBSCRIPTED,
MOVSI TA,5 ;START WITH INDEX PTR
DPB TD,[POINT 6,TA,5] ;STORE RESIDUE
DPB TE,[POINT 6,TA,11] ;STORE SIZE OF BYTE PTR
TSWT FASUB ;IF NOT SUBSCRIPTED,
HRR TA,EINCRA ;INCLUDE REAL INCREMENT
PUSHJ PP,POOLIT
MOVSI CH,LDB.+AC4 ;LDB 4,"A"
PUSHJ PP,PUT.LD
SKIPN PLITPC
AOS ELITPC
;NOW STORE IT
MOVE TA,[XWD BYTLIT,2]
PUSHJ PP,STASHP ;GET SET TO MAKE A BYTE PTR TO "B"
SETZ TA, ; ASSUME SUBSCRIPTED, RH OF BYTE PTR=0
TSWT FBSUB
HRRZ TA,EBASEB ;NO, GET BASE
PUSHJ PP,STASHQ
HRRZ TE,EMODEA
HRRZ TE,BYTE.S(TE)
IMUL TE,ESIZEZ ;# BITS IN BYTE PTR
HLRZ TD,ERESA ; TD= RESIDUE NOW
SUB TD,TE ; TD= RESIDUE IN A MILLISHAKE
HRLM TD,ERESA ;FIXUP RESIDUES OF "A" AND "B"
HRLM TD,ERESB
SETZ TA, ;CLEAR IT OUT
TSWF FBSUB ; IF SUBSCRIPTED,
MOVSI TA,10 ;START WITH INDEX PTR
DPB TD,[POINT 6,TA,5] ;STORE RESIDUE
DPB TE,[POINT 6,TA,11] ;STORE SIZE OF BYTE PTR
TSWT FBSUB ;IF NOT SUBSCRIPTED,
HRR TA,EINCRB ; INCLUDE REAL INCREMENT
PUSHJ PP,POOLIT
MOVSI CH,DPB.+AC4 ;DPB 4,"B"
PUSHJ PP,PUT.LD
SKIPN PLITPC
AOS ELITPC
POPJ PP,
; HERE IF WHOLE MOVE IS JUST "HRRZ 4,'A' / HRRM 4,'B' "
GMSFHF: PUSHJ PP,PUTASA ;HRRZ IN 2ND CODE SET
MOVEI CH,HRRZ.+AC4
TSWT FASUB
JRST [HRLZ CH,CH
PUSHJ PP,PUT.A
JRST GMSH01]
IORI CH,5
HRLZ CH,CH
PUSHJ PP,PUTASY##
GMSH01: PUSHJ PP,PUTASA ;HRRM IN 2ND CODE SET
MOVEI CH,HRRM.+AC4
TSWT FBSUB
JRST [HRLZ CH,CH
PUSHJ PP,PUT.B
JRST GMSH02]
IORI CH,10
HRLZ CH,CH
PUSHJ PP,PUTASY##
GMSH02: MOVEI TE,^D36 ;NEW RESIDUE
HRLM TE,ERESA ; INCASE THERE'S MORE
HRLM TE,ERESB
AOS EINCRA
AOS EINCRB
POPJ PP, ;RETURN FROM MOVE
; HERE IF THE STARTING BITS ARE UNEQUAL, OR CAN'T BE GUARANTEED TO
;BE EQUAL. GO OFF AND DO THE MOVE ONE BYTE AT A TIME (TOO BAD!)
GMSUBO:
IFN BIS,< JRST GMOV.1>
IFE BIS,< JRST GMOVE7 >
;ROUTINE TO CHECK FOR A STATIC BIT POSITION OF SUBSCRIPTED ITEM
;[654] USE TB INSTEAD OF TD BECAUSE IT DOESN'T HAVE TO BE PRESERVED
;CALL:
; MOVE TB,BYTES.PER.WORD ;[654]
; HRRZ TA,OPERND ;OR HLRZ TA,OPERND
; PUSHJ PP,CHKSBP ; CHECK FOR STATIC BIT POSITION
; <HERE IF NO>
; <HERE IF YES>
CHKSBP: MOVE TA,1(TA) ;LOOK AT ITEM
LDB TE,TASUBC## ;ARE THERE REALLY SUBSCRIPTS,
JUMPE TE,CPOPJ1 ; OR IS THIS A PLAIN LINKAGE SECTION
PUSHJ PP,LNKSET
LDB TE,DA.OCC##
JUMPN TE,CHKSB1 ;HAVE PTR TO OCCURS ITEM
LDB TA,DA.OCH## ;OCCURS AT HIGHER LEVEL
PUSHJ PP,LNKSET
CHKSB1: LDB TE,DA.NOC ;NUMBER OF LOW LEVEL OCCURS
LDB TC,DA.USG
XCT SUBSIZ##(TC) ;GET TE= SIZE IN BYTES
IDIV TE,TB ;[654] TE= # WORDS, TD= # BYTES LEFT OVER
JUMPN TD,CPOPJ ;[654] IF NOT EVEN # WORDS, RETURN "NO"
LDB TA,DA.OCH## ;[654] ANY HIGHER LEVEL OCCURS?
JUMPE TA,CPOPJ1 ;[654] IF NOT, RETURN "YES" - STATIC POSITION
PUSHJ PP,LNKSET ;[654] ELSE SET UP THE LINK TO IT
JRST CHKSB1 ;[654] AND GO CHECK IT TOO
IFN BIS,<
;GENERATE SETUP FOR COUNTS AND THEN THE EXTEND
GMOV.6: MOVSI CH, MOVEI. + AC4 ;GENERATE MOVEI AC4, SIZE
HRR CH, TB ;GET THE SIZE OF THE MOVE
PUSHJ PP, PUTASY ;INCREMENT PC
MOVSI CH, MOVEI. + AC7 ;GENERATE MOVEI AC7, SIZE
HRR CH, TB ;GET THE SIZE OF THE MOVE
PUSHJ PP, PUTASY ;INCREMENT PC
;NOW GENERATE THE ACTUAL EXTEND AC4,[MOVSLJ]
MOVE TA, [XTNLIT,,1] ;OCTAL LITERAL
PUSHJ PP, STASHP ;OUTPUT THE HEADER TO THE TABLE
MOVSI TA, (MOVSLJ) ;GENERATE THE OCTAL LITERAL
;COMMON CODE FOR THE EXTEND INSTR
GMOV.C: PUSHJ PP, POOLIT ; IN THE POOLED LITERALS AREA
PUSHJ PP, PUTASA ;EXTEND IS IN SECOND OPCODE SET
MOVSI CH, XTND.## + AC4 ;GET THE EXTEND INSTRUCTION
PUSHJ PP, PUT.LD ;OUTPUT USING LATEST LITERAL
SKIPN PLITPC ;BUMP COUNT IF NON POOLED LITERAL
AOS ELITPC
PUSHJ PP,PUTASA
MOVE CH, [XWD ERROR.+AC17,XTND.E##] ;ERROR CONDITION HANDLER
PUSHJ PP, PUT.EX ;OUTPUT EXTERNAL
;NOW THAT THE CODE IS GENERATED, INCREMENT A AND B
; AND RETURN TO CALLER
JRST GMOVE8 ;USE COMMON CODE
;GENERATE CODE FOR THE ONE CHARACTER CASE SUBSCRIPTED
GMOV.7: PUSHJ PP, PCXBP2 ;GET BYTE POINTERS FOR THE SRC AND DST
SKIPN USENBT ;USING LARGER BYTES?
JRST GMOV71 ;NO
MOVE TA, NBYTES ;HOW BIG ARE THEY?
CAIE TA, 4
CAIN TA, 6
CAIA
JRST GMOV71 ;NOT 4 OR 6
;MOVING FULL WORDS. DON'T USE BYTES IF POSSIBLE
TSWT FASUB ;SKIP IF "A" WAS SUBSCRIPTED
JRST GMV.71
MOVE TA, PCXPTR
MOVSI CH, MOV+AC4+5 ;IN AC
PUSHJ PP, PUTASY ;GET BYTE INTO AC4
JRST GMV.72
GMV.71: MOVSI CH, MOV+AC4
PUSHJ PP, PUT.A##
GMV.72: TSWT FBSUB ;SKIP IF "B" WAS SUBSCRIPTED
JRST GMV.73
MOVSI CH, MOVEM.+AC4+10 ;DEST. IN AC
PUSHJ PP, PUTASY
JRST GMOVE8 ;INCREMENT PARAMS AND RETURN
GMV.73: MOVSI CH, MOVEM.+AC4
PUSHJ PP, PUT.B##
JRST GMOVE8 ;INCREMENT PARAMS AND RETURN
GMOV71: MOVE TA, PCXPTR ;GET RETURNED VALUE IN AC
TLNN TA, AS.LIT ;TEST TO SEE IF ITS REALLY A LITERAL
JRST GMOV.8 ;ITS AN AC, USE ILDB
MOVE CH, [LDB.+AC4+ASINC,,AS.MSC] ;LITERAL, THEREFORE LDB BYTEPOINTER
PUSHJ PP, PUTASY ;GENERATE CODE TO GET BYTE INTO AC4
HLRZ CH, PCXPTR ;GET ADDRESS OF LITERAL
PUSHJ PP, PUTASN ;AND ADD IT TO INSTR
JRST GMOV.9 ;GO AROUND
GMOV.8: MOVE CH, [ILDB.+AC4,,5] ;ITS IN AN AC, AND AN ILDB BP
PUSHJ PP, PUTASY ;GENERATE THE INSTRUCTION
GMOV.9: HRRZ TA, PCXPTR ;GET LOCN OF "B" BYTEPOINTER
TRNN TA, AS.LIT ;TEST TO SEE IF ITS REALLY A LITERAL
JRST GMOV.. ;ITS IN AN AC AND THUS AN IDPB
MOVE CH, [DPB.+AC4+ASINC,,AS.MSC] ;GENERATE LDB AC4,LIT
PUSHJ PP, PUTASY
HRRZ CH, PCXPTR ;GET ADDR OF LITERAL
PUSHJ PP, PUTASN ; AND RETURN TO CALLER
JRST GMOVE8 ;INCREMENT PARAMS AND RETURN
GMOV..: MOVE CH, [IDPB.+AC4,,10] ;GENERATE IDPB AC4,AC10
PUSHJ PP, PUTASY ;AND RETURN TO CALLER
JRST GMOVE8 ;INCREMENT PARAMS AND RETURN
;GENERATE CODE TO HANDLE THE SIXBIT TO ASCII CONVERSION
GMOV.2: CAIN TA, D6MODE ;SEE IF A IS SIXBIT
CAIE TB, D7MODE ;AND B IS ASCII
JRST GMOV.3 ;NO
;WE HAVE A SIMPLE SIXBIT TO ASCII CONVERSION
; WE ONLY HAVE TO GENERATE A MOVE STRING OFFSET BY 40
PUSHJ PP, NB2PAR## ;PUT PARAM BPS IN ACS 5 AND 10
;NOW WE SET UP THE SIZE OF THE MOVE IN THE TWO ACS
MOVSI CH, MOVEI. + AC4 ;GENERATE MOVEI AC4, SIZE
HRR CH, ESIZEZ ;GET THE SIZE OF THE MOVE
PUSHJ PP, PUTASY ;INCREMENT PC
MOVSI CH, MOVEI. + AC7 ;GENERATE MOVEI AC7, SIZE
HRR CH, ESIZEZ ;GET THE SIZE OF THE MOVE
PUSHJ PP, PUTASY ;INCREMENT PC
MOVE TA, [XTNLIT,,1] ;GENERATE THE MOVSO AS LIT
PUSHJ PP, STASHP ; A POOLED LITERAL
MOVE TA, [MOVSO 40] ;OFFSET IS 40 FROM SIXBIT TO ASCII
JRST GMOV.C ;GO TO COMMON CODE
;SAME CODE AS ABOVE BUT FOR DEPENDING ITEMS. ACS ALREADY SET UP
;MERELY NEED THE CORRECT INSTRUCTION
GMOV.4:
CAIN TA, D6MODE ;SEE IF A IS SIXBIT
CAIE TB, D7MODE ;AND B IS ASCII
JRST GMOV.5 ;NOT SO, NEED TO TRANSLATE
PUSHJ PP, RJUSTA ;SPACE FILL AS NECESSARY
;WE ONLY NEED DO AN OFFSET
MOVE TA, [XTNLIT,,1] ;GENERATE LITERAL FOR EXTEND OPCODE
PUSHJ PP, STASHP ;
MOVE TA, [MOVSO 40] ;THE MOVE STRING OFFSET
JRST GMOV.0 ;GO TO COMMON CODE IN DEPENDING CASE
GMOV.T: ;TABLE FOR LIBOL DISPATCH ADDRESSES CONTAINING
; TABLE FOR MOVE STRING TRANSLATE
XWD 0 ; NO CASES
XWD ALP.76##,ALP.69## ;A-S,S-E
XWD ALP.79##,0 ;A-E,NO CASE
XWD ALP.97##,ALP.96## ;E-A,E-S
GMOV.L:
;RETURN IN TA THE EXTERNAL ADDRESS OF THE TABLE TO USE
; FOR THE SPECIFIC CONVERSION CASE. ONLY USE TA AND TB.
HRRZ TA, EMODEA ;DEPENDS UPON THE MODES
HRRZ TB, EMODEB
IMULI TA, 3
ADD TA, TB
ROT TA, -1
JUMPL TA, .+2 ;IF NEGATIVE USE LEFT HALF
SKIPA TA, GMOV.T(TA) ;GET WHOLE WORD
HLR TA, GMOV.T(TA) ;GET ONLY LEFT HALF
HRRZ TA, TA ;ZERO LEFT HALF OF TA (CLEAN-UP)
POPJ PP, ;RETURN TO CALLER
;GENERATE AN EXTEND INSTRUCTION THAT DOES A MOVE STRING
; TRANSLATE. LIBOL HAS IN ITS DISPATCH VECTOR THE ADDRESSES
; OF ALL THE NECESSARY TABLES. WE CAUSE THE GENERATED CODE
; TO DO AN EXTEND INSTRUCTION USING THE CORRECT TABLE.
GMOV.3:
;CANT USE POOLED CODE, NEED SPECIAL CASE CODE TO SET UP ACS
PUSHJ PP, NB2PAR## ;NEW BUILD TWO PARAMS
; IN CORRECT ACS FOR EXTEND
MOVE TA, [OCTLIT,,1] ;GENERATE OCTAL LITERAL
PUSHJ PP, STASHP ; FOR FIRST AC OF BLOCK
HRR TA, ESIZEZ ;GET THE SIZE
HRLI TA, 400000 ;AND SIGNIFICANCE BIT FOR MOVST
PUSHJ PP, POOLIT ;AND POOL THAT LITERAL
HRLZI CH, MOV+AC4 ;GENERATE MOVE TO AC4
PUSHJ PP, PUT.LD ;OUTPUT USING THE LITERAL
SKIPN PLITPC ;BUMP LIT COUNT IF NEW LITERAL
AOS ELITPC
MOVSI CH, MOVEI.+AC7 ;SETUP AC7 USING MOVEI(ITS FASTER)
HRR CH, ESIZEZ ; AND THE LENGTH OF THE MOVE
PUSHJ PP, PUTASY ;GENERATE IT.
MOVE TA, [XTNLIT,,1] ;GENERATE THE MOVST
PUSHJ PP, STASHP ;POOLED IF POSSIBLE
;NOW GET EXTERNAL ADDRESS BY TABLE LOOKUP
PUSHJ PP,GMOV.L ;CALL COMMON ROUTINE
IFE TOPS20,<
TSWT FREENT ;NO INDIRECT IF /R
>
IFN TOPS20,<
SKIPN RENSW## ;NO INDIRECT IF /R
>
TLOA TA,(MOVST @) ;LH IN LH WITH FLAG FOR EXTERN
TLO TA,(MOVST)
JRST GMOV.C ;GOTO COMMON CODE
;SAME AS GMOV.3 EXCEPT FOR THE DEPENDING ITEM CASE.
; ALL ACS ALREADY GENERATED, AND WE NEED TO SET SIGNIFICANCE
; IN AC4 AND EXTEND USING THE RIGHT TABLE.
GMOV.5: PUSHJ PP,RJUSTA ;SPACE FILL IF NECESSARY
; FOR RIGHT JUSTIFY CASE
MOVE CH,[TLO.+AC4+ASINC,,AS.CNB] ;WANT TLO AC4,400000
PUSHJ PP,PUTASN
MOVEI CH,400000
PUSHJ PP,PUTASY
;NOW GENERATE THE LITERAL FOR WHICH EXTEND
MOVE TA, [XTNLIT,,1] ;XWD FORMAT
PUSHJ PP, STASHP ;POOLED LITERAL IF POSSIBLE
;NOW GET TABLE BY TABLE LOOK-UP
PUSHJ PP,GMOV.L ;CALL COMMON ROUTINE
IFE TOPS20,<
TSWT FREENT ;NO INDIRECT IF /R
>
IFN TOPS20,<
SKIPN RENSW## ;NO INDIRECT IF /R
>
TLOA TA,(MOVST @) ;LH IN LH WITH FLAG FOR EXTERN
TLO TA,(MOVST)
JRST GMOV.0
> ;END OF BIS CONDITIONAL
;ROUTINE TO SPACE FILL IF DEPENDING VARIABLES HAVE FOULED US UP
; THIS ROUTINE HANDLES SPACE FILLING IF "B" IS RIGHT JUSTIFIED.
; IT EXPECTS THE FOLLOWING RUNTIME AC'S TO BE SETUP:
;
;AC4 = # CHARS IN SOURCE
;AC7 = # CHARS IN DEST.
;AC5 = BYTE PTR TO SOURCE
;AC10 = BYTE PTR TO DEST.
;
; THIS ROUTINE ALSO EXPECTS THE FOLLOWING:
;EMODEB = CHARACTER SET TO GET THE FILLER CHARACTER FROM
; IF 1B0 = 1 THEN "B" IS RIGHT JUSTIFIED
RJUSTA: SKIPL EMODEB ;SKIP IF "B" IS RIGHT JUSTIFIED
POPJ PP, ;NO, DON'T DO IT
;GENERATE CODE TO SPACE FILL IF NECESSARY
; MOVEI 0,A-SPACE ;GET SPACE IN "B"'S CHARACTER SET
; HRRZ 1,7
; SUBI 1,(4) ;IF .GT. 0, HAVE TO SPACE FILL
; JUMPL 1,.+3
; IDPB 0,10
; SOJG 1,.-1
HRRZ CH,EMODEB ;GET A SPACE IN THE RIGHT MODE
HRRZ CH,IFSPCS##(CH)
HRLI CH,MOVEI.+AC0
PUSHJ PP,PUTASY
PUSHJ PP,PUTASA
MOVE CH,[HRRZ.+AC1,,7]
PUSHJ PP,PUTASY
HRLZI CH,SUBI.##+AC1+4 ;"SUBI 1,(4)"
PUSHJ PP,PUTASY
MOVE CH,[JMPLE.##+AC1+ASINC,,AS.MSC]
PUSHJ PP,PUTASY ;" JUMPLE AC1,.+3"
MOVEI CH,AS.DOT+3
PUSHJ PP,PUTASN
MOVE CH,[IDPB.+AC0,,10]
PUSHJ PP,PUTASY ;"IDPB AC0,10"
MOVE CH,[SOJG.+AC1,,AS.MS2]
PUSHJ PP,PUTASY ;"SOJG. AC1,.-1"
MOVEI CH,AS.DOT+1
PJRST PUTASN ;THEN RETURN
;GENERATE CODE TO CONVERT 1-WORD COMP TO 2-WORD COMP IN AC'S
CC1C2.: MOVEI TE,D2MODE
HRRM TE,EMODEA
MOVE CH,[XWD MULI.,1]
JRST PUT.XA
;CONVERT FLOATING POINT TO 2-WORD COMPUTATIONAL
CFPCX.: MOVE TE,ESIZEB ;[1377] SEE IF
SUB TE,EDPLB ;[1377] "A" NEEDS
ADD TE,EDPLA ;[1377] TO BE
SUB TE,ESIZEA ;[1377] TRUNCATED,
SKIPGE TE ;[1377] IF SO,
PUSHJ PP,MSERA. ;[1377] GIVE WARNING.
HRRZ TE,EMODEA
CAIN TE,F2MODE ;IS IT COMP-2?
JRST CF2CX. ;YES
SKIPE TD,EDPLB
PUSHJ PP,GENFPL
MOVSI CH,FIX.
PUSHJ PP,PUT.XA
JRST CF2CX0
;CONVERT COMP-2 TO 2-WORD COMPUTATIONAL
CF2CX.: SKIPE TD,EDPLB
PUSHJ PP,GENF2L
HRRZ CH,EAC
DPB CH,CHAC
PUSHJ PP,PUT.16 ;GENERATE MOVX 16,<Z AC,AC>
MOVEI CH,FIX.2
PUSHJ PP,PUT.PJ
CF2CX0: MOVE TE,[XWD ESIZEB,ESIZEA]
BLT TE,EBASAX
MOVEI TE,D2MODE
MOVEM TE,EMODEA
POPJ PP,
;CONVERT COMP-1 TO COMP-2
CFPF2.: MOVEI TE,F2MODE
MOVEM TE,EMODEA ;SET MODE OF "A" TO COMP-2
PUSHJ PP,PUTASA
MOVSI CH,SETZ. ;JUST ZERO AC+1
JRST PUT.XB
;CONVERT COMP-2 TO COMP-1
CF2FP.: PUSHJ PP,PUTASA
SKIPE TB,CF2CNV##
JRST CF2FP1
MOVE TB,ELITPC
IORI TB,AS.LIT
MOVEM TB,CF2CNV
MOVE TA,[OCTLIT,,2]
PUSHJ PP,STASHI##
SETZ TA,
PUSHJ PP,STASHL##
MOVSI TA,(1B1)
PUSHJ PP,STASHL
AOS ELITPC
AOS ELITPC
CF2FP1: MOVE CH,[DADD.##+ASINC,,AS.MSC]
PUSHJ PP,PUT.XA
HRRZ CH,TB
PUSHJ PP,PUTASN
MOVEI TE,FPMODE
MOVEM TE,EMODEA ;SET MODE OF "A" TO COMP-1
MOVSI CH,SKPLE.
HRR CH,EAC
PUSHJ PP,PUTASY
MOVE CH,[TLO.,,400]
JRST PUTASY
;CONVERT AC'S TO FLOATING POINT
CCXFP.: HRRZ TE,EMODEA
CAIN TE,F2MODE ;COMP-2?
JRST CF2FP. ;YES
IFN BIS,<
MOVSI CH,FLOT.2
CAIE TE,D1MODE ;FLOAT 1 WORD?
JRST CCXFP1 ;NO
PUSHJ PP,PUTASA## ;YES
MOVSI CH,FLTR.##
HRR CH,EAC
DPB CH,CHAC## ;FLTR AC,AC
JRST CCXFP2
>
IFE BIS,<
MOVSI CH,FLOT.1
CAIE TE,D1MODE
MOVSI CH,FLOT.2
>
CCXFP1: HRR CH,EAC
CCXFP2: PUSHJ PP,PUTASY
MOVEI TE,FPMODE
MOVEM TE,EMODEA
MOVN TD,EDPLA
JRST GENFPL
;CONVERT AC'S TO D.P. FLOATING POINT (COMP-2)
CCXF2.: HRRZ TE,EMODEA
CAIN TE,FPMODE ;COMP-1?
JRST CFPF2. ;YES
CAIE TE,D1MODE ;FLOAT 1 WORD?
JRST CCXF22 ;NO
PUSHJ PP,PUTASA
MOVSI CH,SETZ. ;YES
PUSHJ PP,PUT.XB ;CLEAR SECOND ACC
PUSHJ PP,PUTASA## ;YES
MOVSI CH,FLTR.##
HRR CH,EAC
DPB CH,CHAC## ;FLTR AC,AC
PUSHJ PP,PUTASY
JRST CCXF23
CCXF22: HRRZ CH,EAC ;GET ACC
DPB CH,CHAC ;AS <Z AC,AC>
PUSHJ PP,PUT.16 ;GENERATE MOVX 16,<Z AC,AC>
MOVEI CH,FLT.12
CAIE TE,D1MODE
MOVEI CH,FLT.22
PUSHJ PP,PUT.PJ
CCXF23: MOVEI TE,F2MODE
MOVEM TE,EMODEA
MOVN TD,EDPLA
JRST GENF2L
;GET A FLOATING POINT LITERAL TO %LIT.
;EXIT WITH %LIT RELATIVE ADDRESS IN "TC".
MSFP%L: PUSHJ PP,CONVFP
MFP%L0: CAIE LN,EBASEA
SKIPA TA,OPERND
MOVS TA,OPERND
MOVE TE,1(TA)
TLZE TE,NEGEOP
TSWC FLNEG;
TSWF FLNEG;
TLO TC,17B21
MOVEM TE,1(TA)
MFP%L1: MOVE TA,[XWD FLTLIT,2]
PUSHJ PP,STASHP
MOVE TA,TD
PUSHJ PP,STASHQ
MOVE TA,TC
PUSHJ PP,POOLIT
SKIPN TC,PLITPC
SKIPA TC,ELITPC
CAIA
AOS ELITPC
IORI TC,AS.LIT
POPJ PP,
;GET A COMP-2 FLOATING POINT LITERAL TO %LIT.
;EXIT WITH %LIT RELATIVE ADDRESS IN "TC".
MSF2%L: PUSHJ PP,CONVF2
CAIE LN,EBASEA
SKIPA TA,OPERND
MOVS TA,OPERND
MOVE TE,1(TA)
MOVE TC,C2MANT## ;GET FIRST WORD OF MANTISSA
TLZE TE,NEGEOP
TSWC FLNEG;
TSWF FLNEG;
TLO TC,17B21
MOVEM TE,1(TA)
MF2%L1: MOVE TA,[F2LIT,,2]
SKIPE C2MANT+2 ;IF 18 DIGITS
AOSA TA ;NEED 2 EXTRA WORDS
SKIPE C2MANT+1 ;NO, BUT MORE THAN 8
ADDI TA,1 ;NEED EXTRA WORD
PUSH PP,TA ;SAVE SIZE
PUSHJ PP,STASHP
MOVE TA,TD ;STORE EXPONENT
PUSHJ PP,STASHQ
MOVE TA,TC ;STORE FIRST 8 DIGITS + SIGN
PUSHJ PP,STASHQ
POP PP,TD ;GET SIZE BACK
HRRZ TD,TD
MOVE TA,C2MANT+1
CAIL TD,3
PUSHJ PP,STASHQ ;DIGITS 9 - 17
MOVE TA,C2MANT+2
CAIL TD,4
PUSHJ PP,STASHQ ;DIGIT 18
PUSHJ PP,POOL ;POOL THE LITERAL
SKIPN TC,PLITPC
SKIPA TC,ELITPC
JRST .+3
MOVEI TD,2 ;ALWAYS USES 2 WORDS OF LITERAL
ADDM TD,ELITPC
IORI TC,AS.LIT
POPJ PP,
;CREATE A MASK OF 1-BITS AT LEFT SIDE OF WORD.
;ENTER WITH # ZERO BITS IN "TE".
BITSL.: MOVEI TD,1
ROT TD,(TE)
MOVNM TD,EMASK
POPJ PP,
;CREATE A MASK OF 1-BITS AT RIGHT SIDE OF WORD.
;ENTER WITH # BITS IN "TE".
BITSR.: MOVEI TD,1
ROT TD,(TE)
MOVNS TD
SETCAM TD,EMASK
POPJ PP,
;GENERATE: MOVE 4,[XWD EBASEB+EINCRB-1,EBASEB+EINCRB]
; BLT 4,EBASEB+EWORDB+EINCRB-1
GENM01: MOVE TA,[XWD XWDLIT,2] ;CREATE XWD HEADER FOR LITAB
PUSHJ PP,STASHP
MOVE TA,EINCRB ;CREATE LH OF XWD
SUBI TA,1
MOVSS TA
HRR TA,EBASEB
PUSHJ PP,STASHQ
MOVS TA,EINCRB ;CREATE RH OF XWD
HRR TA,EBASEB
PUSHJ PP,POOLIT
SKIPN PLITPC
AOS ELITPC
GENM1A: MOVE CH,[XWD MOV+AC4+ASINC,AS.MSC] ;CREATE THE MOVE
PUSHJ PP,PUTASY
SKIPE CH,PLITPC
JRST .+3
HRRZ CH,ELITPC
SUBI CH,1
IORI CH,AS.LIT
PUSHJ PP,PUTASN
MOVSI CH,BLT.+AC4+ASINC ;CREATE THE BLT
HRR CH,EBASEB
PUSHJ PP,PUTASY
HRRZ CH,EWORDB
ADD CH,EINCRB
SOJA CH,PUTASN ;WRITE THE BLT AND RETURN
;GENERATE <MOVE 3,[(@EACD)+1]>
GENM04: SKIPE ECONRJ ;HAS MOVE BEEN GENERATED YET?
POPJ PP, ;YES--QUIT
MOVE CH,[XWD MOV+AC3+ASINC,AS.MSC]
MOVEM CH,ECONRJ
PUSHJ PP,PUTASY ;WRITE IT OUT
HRRZ CH,EACD ;CREATE INCREMENT
AOJA CH,PUTASN ;WRITE IT AND RETURN
;GENERATE <MOVE 2,[@EACD]>
GENM05: SKIPE ECONLJ ;HAS MOVE BEEN GENERATE YET?
POPJ PP, ;YES--QUIT
MOVE CH,[XWD MOV+KAC+ASINC,AS.MSC]
MOVEM CH,ECONLJ
PUSHJ PP,PUTASY
HRRZ CH,EACD
JRST PUTASN
;GENERATE <HRRZI 2,<TB>>
GENM5I: SKIPE ECONLJ ;HAS MOVE BEEN GENERATE YET?
POPJ PP, ;YES--QUIT
MOVE CH,[XWD MOV+KAC+ASINC,AS.MSC]
MOVEM CH,ECONLJ
MOVSI CH,HRRZI.+KAC+ASINC
JRST GENM26
;GENERATE A BYTE POINTER TO B-FIELD.
;ENTER WITH RESIDUE OF PREVIOUS BYTE IN TB, SIZE IN TC.
;EXIT WITH RELATIVE RUN-TIME ADDRESS OF BYTE-POINTER IN EACC.
GENM06: MOVE TA,[XWD BYTLIT,2]
PUSHJ PP,STASHP
MOVE TA,EBASEB
PUSHJ PP,STASHQ
MOVE TA,EINCRB
SUB TB,TC
LSH TB,6
ADD TB,TC
LSH TB,6
HRL TA,TB
PUSHJ PP,POOLIT
SKIPE EACC,PLITPC
POPJ PP,
MOVE EACC,ELITPC
AOS ELITPC
POPJ PP,
;GENERATE <DPB X,BYTE-POINTER>.
;ENTER WITH OBJECT ADDRESS OF BYTE POINTER IN EACC.
GENM07: SKIPA CH,ECONLJ
GENM7A: MOVE CH,ECONRJ
TLZ CH,177000
TLOA CH,DPB.
GENM7B: MOVE CH,[XWD DPB.+AC4+ASINC,AS.MSC] ;[575]
PUSHJ PP,PUTASY
HRRZ CH,EACC
IORI CH,AS.LIT
JRST PUTASN
;GENERATE <MOVEM 4,EBASEB+EINCRB>
GENM08: MOVSI CH,MOVEM.+AC4
JRST PUT.B
;GENERATE <MOVE 4,[LITERAL]>.
;ENTER WITH LITERAL VALUE IN TB,CONSTANT TYPE IN LH OF TA.
GENM09: TLNN TB,-1 ;IS LEFT HALF OF LITERAL EQUAL TO ZERO?
JRST GENM11 ;YES
TRNN TB,-1 ;NO--IS RIGHT HALF OF LITERAL EQUAL TO ZERO?
JRST GENM10 ;YES
SETCM TE,TB ;NO--IS LEFT HALF OF LITERAL EQUAL TO ALL ONES?
TLNN TE,-1
JRST GENM14 ;YES
TRNN TE,-1 ;NO--IS RIGHT HALF OF LITERAL EQUAL TO ALL ONES?
JRST GNM14A ;YES
HRRI TA,1 ;NO--CREATE THE LITERAL
PUSHJ PP,STASHP
MOVE TA,TB
PUSHJ PP,POOLIT
MOVE CH,[XWD MOV+AC4+ASINC,AS.MSC] ;CREATE THE MOVE
PUSHJ PP,PUTASY ;WRITE FIRST OF TWO WORDS
SKIPN CH,PLITPC
HRRZ CH,ELITPC
IORI CH,AS.LIT
SKIPN PLITPC
AOS ELITPC
JRST PUTASN ;WRITE SECOND WORD AND RETURN
GENM10: MOVSS TB
SKIPA CH,[XWD HRLZI.+AC4,0] ;USE "HRLZI"
GENM11: MOVSI CH, HRRZI.+AC4 ;USE "HRRZI"
JRST GNM25A
GNM14A: MOVSS TB
SKIPA CH,[XWD HRLOI.+AC4,0] ;USE "HRLOI"
GENM14: MOVSI CH,HRROI.+AC4 ;USE "HRROI"
JRST GNM25A
;GENERATE <SETZM EBASEB+EINCRB>
GENM16: MOVSI CH,SETZM.
JRST PUT.B
;GENERATE <SETOM EBASEB+EINCRB>
GENM17: MOVSI CH,SETOM.
JRST PUT.B
;GENERATE <HRLOI 4,377777>
GENM19: MOVE CH,[XWD HRLOI.+AC4+ASINC,AS.CNB]
PUSHJ PP,PUTASY
HRRZI CH,377777
JRST PUTASN
IFN BIS,<
;CONVERT "A" TO QUAD-WORD AND MOVE "B" IF NECESSARY
ADJA24: TSWF FBIGCV ;CAN WE COP OUT AND USE FLOATING PT?
JRST CNVFP ;YES!
HRRZ TC,EBASEB ;[731] GET ADDRESS OB "B"
CAIL TC,17 ;[731] IS IT IN THE ACCS?
JRST ADJA25 ;[731] NO, LEAVE IT ALONE
PUSHJ PP,PUTASA##
MOVE CH,[DMOVE.+AC4,,2] ;MOVE NEXT ACC OUT OF WAY
PUSHJ PP,PUTASY
MOVEI TC,2 ;NOTE THAT "B" MOVED
ADDM TC,EBASEB
ADDM TC,ESAVEB ;ITS IN ONE OF THESE PLACES
ADJA25: MOVEI TC,D4MODE## ;[731]
MOVEM TC,EMODEA ;"A" IS NOW 4-WORDS
JRST ADJ4C0 ;AND TRY QUAD PRECISSION
>
;GENERATE <OP X,[LITERAL]>, OR <OPI X,LITERAL>.
GENM24: TLNN TB,-1 ;CAN WE USE IMMEDIATE MODE?
JRST GENM25 ;YES
GNM24A: HRRI TA,1 ;NO--STASH THE LITERAL
PUSHJ PP,STASHP
MOVE TA,TB
PUSHJ PP,POOLIT
HRRI CH,AS.MSC ;CREAT THE INSTRUCTION
TLO CH,ASINC
PUSHJ PP,PUTASY ;WRITE OUT FIRST OF TWO WORDS
SKIPN CH,PLITPC
HRRZ CH,ELITPC
IORI CH,AS.LIT
SKIPN PLITPC
AOS ELITPC
JRST PUTASN ;WRITE OUT INCREMENT AND RETURN
GENM25: ADD CH,[EXP 1B8] ;USE IMMEDIATE MODE
GNM25A: TRNE TB,700000 ;IS CONSTANT > 77777?
JRST GENM26
HRR CH,TB ;NO--PUT CONSTANT IN RIGHT HALF
JRST PUTASY ;WRITE AND RETURN
GENM26: TLO CH,ASINC ;YES--SET "INCREMENT FOLLOWS"
HRRI CH,AS.CNB
PUSHJ PP,PUTASY ;WRITE OUT FIRST OF TWO WORDS
HRRZ CH,TB
JRST PUTASN ;WRITE OUT INCREMENT AND RETURN
;GENERATE <MOVE AC+1,[LITERAL]>
;ENTER WITH LITERAL IN TB, TYPE OF LITERAL IN LH OF TA.
GENM38: MOVE TE,EAC
AOSA TE
;GENERATE <MOVE AC,[LITERAL]>
;ENTER WITH LITERAL IN TB, TYPE OF LITERAL IN LH OF TA.
GENM39: MOVE TE,EAC
HRRZI CH,0
DPB TE,CHAC
MOVN TD,TB
TLNN TD,-1
TLOA CH,MOVN.
TLOA CH,MOV
MOVE TB,TD
MOVSI TA,D1LIT
JRST GENM24
;PUT OUT THE "MOST SIGNIFICANT DIGITS" DIAGNOSTIC.
MSERA.: TSWF FSZERA ;SIZE ERROR WANTED?
POPJ PP, ;YES--NO ERROR
MOVEI TA,E.502
JRST TERA.
;PUT OUT THE "LEAST SIGNIFICANT DIGITS" DIAGNOSTIC.
LLSERA: PUSH PP,TA ; [303] SAVE LITERAL
PUSH PP,TB ; [303] SAVE LITERAL BYTE PNTR
PUSHJ PP,LSERA. ; [303] GIVE LSD WARNING
POP PP,TB ; [303] RESTORE LIT BYTE PNTR
POP PP,TA ; [303] RESTORE LITERAL
POPJ PP, ; [303]
LSERA.: TSWF FROUND ;ARE WE ROUNDING?
POPJ PP, ;YES--NO ERROR
MOVEI TA,E.503
JRST TERA.
;PUT OUT THE "RIGHT TRUNCATION" DIAGNOSTIC.
RTERA.: MOVEI TA,E.501
JRST TERA.
;WRITE OUT THE "LEFT TRUNCATION" DIAGNOSTIC.
LTERA.: MOVEI TA,E.500
TERA.: HRRZ TC,CUREOP
CAIN TC,EOPHLD
JRST TERA.1
HRL TA,1(TC)
MOVE TC,0(TC)
LDB LN,TCLN
LDB CP,TCCP
JRST WARNAD
TERA.1: MOVEI DW,-4(TA)
JRST OPNWRN
;PUT OUT THE "BAD FIGURATIVE CONSTANT" DIAGNOSTIC
BADFIG: MOVEI DW,E.184
JRST OPNFAT
;PUT OUT THE "INTERMEDIATE RESULT TOO LARGE" DIAGNOSTIC
IRERA.: TSWF FBIGCV ;SHOULD WE CONVERT TO FLOATING POINT?
JRST CNVFP ;YES
MOVEI DW,E.88
SWON FERROR;
JRST OPNFAT
;PUT OUT THE "NO SIZE" DIAGNOSTIC
NOSIZ.: MOVEI TA,E.504
JRST TERA.
;"B" NON-NUMERIC, "A" HAS DECIMAL PLACES
NODPL: SWON FERROR;
MOVEI DW,E.96
JRST OPNFAT
;WE ARE IN AN ARITHMETIC EXPRESSION, AND "A" IS TOO LARGE.
;CONVERT IT TO COMP-1.
CNVFP: MOVE TD,EDPLB ;[466] IF ADJUSTMENT MADE SUB AMT
SUB TD,ESAVDP ;[466] WILL BE ZERO IF NO ADJ
MOVEM TD,EDPLB ;[466] GET REAL NO. OF DECIMAL PLACES
HRRZ TE,EBASEB
CAILE TE,17
IFE BIS,<JRST CCXFP. ;"B" ISN'T IN AC'S--CONVERT "A">
IFN BIS,<JRST CCXF2. ;USE COMP-2>
PUSHJ PP,SWAPEM ;"B" IS ALSO IN AC'S--SWAP OPERANDS
PUSHJ PP,PUTEMP ;PUT "B" INTO A TEMP
PUSHJ PP,SWAPAB ;RE-SWAP OPERANDS
HRRZ TD,EBASEA
MOVEM TD,EAC
IFE BIS,<JRST CCXFP.>
IFN BIS,<JRST CCXF2.>
;SET UP A FIELD FOR EDITING
SETED: TSWF FANUM ;IS 'A' NUMERIC?
JRST SETED1 ;YES--WE WILL MOVE TO TEMP
MOVE TE,ESIZEB ;ARE "A" & "B" THE SAME SIZE?
CAMN TE,ESIZEA
POPJ PP, ;YES--NO NEED FOR MORE WORK
MOVE TD,EMODEA ;[1341] IF "A" IS AN IMMEDIATE,
CAIN TD,IMMODE ;[1341] ALREADY WARNED IN LITD.3
JRST SETED1 ;[1341]
CAMG TE,ESIZEA ;[1323] "A" LONGER THAN "B"?
PUSHJ PP,RTERA. ;[1323] YES, WARN RIGHT TRUNCATION
;GENERATE CODE TO MOVE "A" TO A TEMPORARY LOCATION
SETED1: MOVE TD,[XWD EBASEB,ESAVMB] ;SAVE "B" PARAMETERS
BLT TD,ESVMBX
HRRZ TE,EMODEA
CAIE TE,FPMODE ;IS "A" COMP-1?
CAIN TE,F2MODE ;OR COMP-2?
TRNA ;YES
TSWF FBNUM ;NO--IS "B" NUMERIC?
JRST SETED2 ;YES
MOVE TD,[XWD EBASEA,EBASEB] ;SET B = A
BLT TD,EBASBX
IFN ANS74,<
MOVE TA,ETABLA
LDB TE,LNKCOD
CAIE TE,TB.DAT
JRST SETED0
SKIPL EFLAGA ;SEPARATE SIGN?
JRST SETED0 ;NO
SOS ESIZEB ;YES, 1 CHAR LESS
SWON FBNUM ;AND FORCE NUMERIC MOVE
SETZM EFLAGB ;BUT NOT SEPARATE SIGN
SETED0:>
SKIPL TE,EDPLA ;P SHIFTED?
TDZA TE,TE ;NO
MOVN TE,TE ;YES
JUMPE TE,.+3 ;WAS IT?
SWON FBNUM ;YES, FORCE NUMERIC
SETZM EDPLB ;CLEAR P SHIFT FOR "B"
ADDB TE,ESIZEB ;GET NEW SIZE
CAMGE TE,ESAVMB+2 ;+ESIZEX
MOVE TE,ESAVMB+2 ;USE THE LARGER
MOVEM TE,ESIZEB ;RESET IT
CAML TE,ESIZEA ; IS B SIZE LESS THAN A? [160]
JRST SETED4 ; NO ALL OF A WILL FIT IN B [160].
SKIPGE EMODEB ; B < A IS B RIGHT JUSTIFIED ? [160]
JRST SETED3 ; YES [160]
PUSHJ PP,RTERA. ; GIVE RIGHT MOST TRUNCATION WARN [160]
JRST SETED4 ; CONTINUE [160]
SETED3: PUSHJ PP,LTERA. ; GIVE LEFT MOST TRUNCATION WARN [160]
SETED4: ; [160]
SETED2: MOVE TD,[XWD ^D36,AS.MSC] ;RESET "B" TO BE A TEMP
MOVEM TD,EBASEB
MOVEI TD,D7MODE
MOVEM TD,EMODEB
MOVE TE,ESIZEB
ADDI TE,4
IDIVI TE,5
PUSHJ PP,GETEMP
MOVEM EACC,EINCRB
MOVE TD,[XWD EBASEB,ESAVMA] ;SAVE NEW "B" PARAMETERS
BLT TD,ESVMAX
PUSH PP,SW
SWOFF FBSUB;
IFN ANS68,<
TSWF FANUM ;[1043] IS "A" NUMERIC?
SWON FBNUM ;[1043] YES--SET "B" NUMERIC
>;END IFN ANS68
REPEAT 0,< ;/DAW THIS BREAKS OUR MOVE SUBSYSTEM TESTS
; AND NC105 PASSES WITHOUT IT. FOR SOME
; REASON, THIS PATCH SEEMED LIKE A GOOD IDEA
; AT THE TIME...
IFN ANS74,< ;SEE NAVY TEST NC105
TSWT FBNUM ;IS "B" NUMERIC?
SWOFF FANUM ;NO, SO SET "A" NON-NUMERIC
>
>; END REPEAT 0
MOVE TD,EMODEA ;[1337] GET MODE OF "A"
CAIN TD,IMMODE ;[1337] IF IMMEDIATE MODE,
JRST SETIMM ;[1337] SET UP CALL TO GMOV.I
PUSHJ PP,MXX.
JRST SETED5 ;[1337]
SETIMM: MOVE TD,ESAVMB+2 ;[1337] GET SIZE OF "B"
MOVEM TD,ESIZEZ ;[1337]
MOVE TD,ESAVMB+3 ;[1337] GET MODE OF "B"
MOVEM TD,EMODEB ;[1337]
MOVEM TD,ESAVMA+3 ;[1337] SAVE IN "A" FOR EDIT/CONVERSION STMTS
PUSHJ PP,GMOV.I ;[1337] GENERATE IMMEDIATE MOVE
SETED5: POP PP,SW ;[1337]
SWOFF FASUB;
MOVE TD,[XWD ESAVMA,EBASEA] ;RESTORE BOTH "A" & "B"
BLT TD,EBASBX
POPJ PP,
;CREATE THE MASK FOR THE "B" FIELD
BMASK: MOVE TE,[EXP ^D36B5+AS.CNB]
MOVEM TE,EDITW1
MOVSI TA,OCTLIT
PUSHJ PP,STASHP
HRRZM TE,CURLIT
MOVE TA,ETABLB
PUSHJ PP,LNKSET
LDB TC,DA.EDT
JUMPE TC,BMSK2N ;NOT EDITED SO MUST BE BLANK WHEN ZERO
;GET FLOAT AND SIGN CHARACTERS
MOVEI TC,0(TA)
ADD TC,[POINT 4,DA.EDW,11]
LDB TD,[POINT 12,DA.EDW(TA),11]
DPB TD,[POINT 12,EDITW1,17] ;STORE IN TEMP
BMASK0: ;ENTRY FROM DISPLAY NUMERIC GENERATION
;TC IS SET UP
;EDITW1 IS DONE
;LITTAB IS INITIALIZED
SETZB TD,TA ;INITIALIZE REPEAT COUNT
;AND INITIALIZE LITERAL TABLE MASK BUFFER
IFN BIS,< ;GENERATING BIS?
PUSHJ PP,BISINI ;YES - INITIALIZE
>
IFE BIS,<
MOVE TB,[POINT 4,TA] ;NON-BIS INITIALIZATION
>
BMASK2: ILDB TE,TC
CAIL TE,CODERP ;REPEAT OR STOP?
JRST BMSK2C ;YES - ONE OF THOSE
IFN BIS,<
PUSHJ PP,BSTRAN ;YES - TRANSLATE TO BIS CODE
>
;CODE RETURNS IN TE TO BE STORED
;NOTE: BSTRAN WILL SKIP RETURN IF CODE IS NOT TO BE STORED
BMSK2A: IDPB TE,TB ;STORE MASK CHARACTER
TLNN TB,770000 ;LAST CHARACTER IN THIS WORD??
PUSHJ PP,BMSK2B ;STORE LITERAL
SOJLE TD,BMASK2 ;GET NEXT CHAR IF NOT REPEATING
JRST BMSK2A ;REPEAT LAST CHARACTER
INTERNAL BMSK2B ;CALLED BY BISGEN.MAC
BMSK2B: ;PUT LITERAL WORD AWAY
PUSH PP,TE ;SAVE IN CASE OF REPEATS
PUSHJ PP,STASHQ ;STORE IT
POP PP,TE ;GET TE BACK
IFN BIS,<
MOVE TB,[POINT 9,TA]
>
IFE BIS,<
MOVE TB,[POINT 4,TA] ;REINITIALIZE POINTER
>
MOVEI TA,0 ;INITIALIZE BUFFER AGAIN
POPJ PP, ;AND RETURN
BMSK2C: ;STOP OR REPEAT?
CAIE TE,CODERP ;WHICH?
JRST BMSK2E ;STOP
; REPEAT
; THE CODE IS FOLLOWED BY A COUNT OF THE NUMBER
; OF 4 BIT BYTES WHICH FOLLOW THE COUNT AND CONTAIN THE
; NUMBER OF REPEATS IN BINARY. THE BYTE FOLLOWING THE
; NUMBER OF REPEATS IS THE CHARACTER TO BE REPEATED.
PUSH PP,TA ;SAVE A FEW REGS
PUSH PP,TB
ILDB TD,TC ;GET NUMBER OF BYTES HOLDING FACTOR
LSH TD,2 ;COMPUTE BITS RIGHT
MOVE TE,[POINT 4,TD] ;RESULT POINTER
DPB TD,[POINT 6,TE,5] ;STORE BITS RIGHT
MOVEI TD,0 ;INITIALIZE REPEAT COUNT
LDB TA,TC ;GET BYTE COUNT BACK
BMSK2D: ILDB TB,TC ;GET BYTE OF COUNT
IDPB TB,TE ;SAVE IN REPEAT REGISTER
SOJG TA,BMSK2D ;MOVE??
POP PP,TB ;NO - DONE
POP PP,TA
JRST BMASK2 ;GO BACK TO TOP
;NOT EDITED SO MUST BE BLANK WHEN ZERO
;SET UP DUMMY MASK OF X AND THEN
;FAKE THE REPEAT COUNT
;EDIT TYPE IS ALPHA AND X IS USED SO THAT
;NONE OF THE OVERPUNCHED CHARS GET CONVERTED
BMSK2N: MOVE TC,[POINT 4,[<CODEX>B3+<CODEST>B7]]
MOVE TD,ESIZEB ;REPEAT COUNT
MOVEI TA,0
IFN BIS,<
PUSHJ PP,BISINI
>
IFE BIS,<
MOVE TB,[POINT 4,TA]
>
SETZM BISALP
JRST BMASK2
BMSK2E:
;END OF THE MASK
IFN BIS,<
PUSHJ PP,BSEND ;TERMINATE BIS PATTERN
>
IFE BIS,<
IDPB TE,TB ;STORE STOP CODE - NON BIS
>
; NOW PUT LAST LITERAL AWAY AND THEN COMPUTE HOW MANY HAVE
; BEEN STORED AND THEN GO BACK AND FIX UP THE OCTLIT COUNT
BMASK3: PUSHJ PP,STASHQ
MOVEI TE,PLITSZ##-1
SUB TE,PLITCT## ;GET SIZE OF LITERAL
ADDM TE,PLITBF## ;STORE IN HEADER
PUSHJ PP,POOL## ;POOL IT
SKIPE TE,PLITPC ;DID WE?
JRST BMSK3A ;YES
LDB TE,[POINT 15,PLITBF,35]
EXCH TE,ELITPC
ADDM TE,ELITPC
BMSK3A: IORI TE,AS.LIT
HRLI TE,AS.MSC
MOVSM TE,EDITW2
POPJ PP,
;ADJUST A POSITIVE LITERAL (IN TD&TC) TO MATCH THE "B" FIELD.
ADJLIT: MOVE TE,ESIZEB ;COMPARE INTEGRAL PLACES
SUB TE,ESIZEA
SUB TE,EDPLB
ADD TE,EDPLA
JUMPGE TE,ADJLT1
;MORE INTEGER PLACES IN LITERAL THAN "B"--DIVIDE LITERAL
ADDB TE,ESIZEA
JUMPLE TE,CPOPJ
PUSHJ PP,DPDIV.
MOVEM TB,EWORDB
MOVEM TA,EREMAN
SKIPN TD
SKIPE TC
PUSHJ PP,MSERA.
MOVE TD,EWORDB
MOVE TC,EREMAN
ADJLT1: MOVE TE,EDPLB ;COMPARE DECIMAL PLACES
SUB TE,EDPLA
JUMPE TE,CPOPJ
ADDM TE,EDPLA
ADDM TE,ESIZEA
JUMPL TE,ADJLT3
;MORE DECIMAL PLACES IN "B" THAN IN LITERAL--MULTIPLY
CAILE TE,^D10 ;DIFFERENCE > 10?
JRST ADJLT2
IMUL TD,POWR10(TE) ;NO
MUL TC,POWR10(TE)
ADD TD,TC
MOVE TC,TB
POPJ PP,
;ADJUST LITERAL TO MATCH "B" (CONT'D).
;MORE DECIMAL PLACES IN "B" THAN LITERAL, AND DIFFERENCE > 10.
ADJLT2: SUBI TE,^D11
LSH TE,1
MOVEM TC,EWORDB
IMUL TD,DPWR10+1(TE)
MUL TC,DPWR10(TE)
ADD TD,TB
MOVE TC,EWORDB
MUL TC,DPWR10+1(TE)
ADD TD,TC
MOVE TC,TB
POPJ PP,
;MORE DECIMAL PLACES IN LITERAL THAN "B"--DIVIDE
ADJLT3: MOVMS TE
PUSHJ PP,DPDIV.
SKIPN TB ;ANY REMAINDER?
JUMPE TA,CPOPJ ;NOT IF JUMP
MOVEM TD,EWORDB ;YES--SAVE RESULT
MOVEM TC,EREMAN
PUSHJ PP,LSERA. ;PUT OUT DIAG
MOVE TD,EWORDB ;RESTORE RESULT
MOVE TC,EREMAN
POPJ PP,
IFN FT68274,<
;HERE TO TEST OPERAND "B" OF MOVE LOW-VALUES TO "B"
;TO SEE IF "B" IS SOME KIND OF FILE KEY
;IF IT IS WARN THE USER TO USE [NEXT] OPTION OF -74 VERBS
TSTKEY: HRRZ TB,EBASEB ;GET TABLE LINK OF "B"
TSTKY1: MOVEI TA,1 ;POINT TO FIRST TABLE
TSTKY2: ADD TA,FILLOC## ;ADD INBASE OF FILE TABLE
LDB TE,FI.ACC## ;GET ACCESS MODE
JRST @[EXP TSTKYS,TSTKYR,TSTKYI,TSTKYS](TE)
;FILE IS RANDOM
TSTKYR: LDB TE,FI.ACK##
CAMN TE,TB
JRST TSTKYE ;SAME AS ACTUAL KEY
JRST TSTKYS ;OK
;FILE IS ISAM
TSTKYI: LDB TE,FI.SKY##
CAMN TE,TB
JRST TSTKYE ;SAME AS SYMBOLIC KEY
LDB TE,FI.RKY##
CAMN TE,TB
JRST TSTKYE ;SAME AS RECORD KEY
; JRST TSTKYS ;OK
TSTKYS: LDB TA,FI.NXT## ;GET NEXT LINK
JUMPN TA,TSTKY2 ;LOOP
PUSHJ PP,FNDPOP## ;LOOK FOR NEXT HIGHER LEVEL
POPJ PP, ;ALL DONE
JRST TSTKY1 ;TRY THIS ONE
TSTKYE: MOVEI DW,E.774
JRST OPNWRN
>
;SOME CONSTANTS.
CODE9==1 ;PICTURE CODE FOR "9"
CODEM==3 ;FOR FLOATING "-"
CODES==10 ;FOR INSERTED "-"
CODEC==4 ;FOR ","
CODEP==11 ;FOR "."
CODERP==16 ;CODE FOR REPEAT
CODEST==17 ;CODE FOR STOP
CODEX==0 ;CODE FOR X
NEGEOP==1B<^D18+6> ;"UNARY MINUS" FLAG IN OPERAND
BYTEN6: OCT -6 ;NEGATIVE OF SIXBIT BYTE SIZE
BYTEN7: OCT -7 ;LIKEWISE FOR ASCII
;ENTRANCE POINTS FOR MOVING ZEROES TO DISPLAY FIELD
MZX.: EXP MZS. ;SIXBIT
EXP MZA. ;ASCII
EXP MZE. ;EBCDIC
;ENTRANCE POINTS FOR MOVING SPACES TO DISPLAY FIELDS
MSX.: EXP MLVD. ;SIXBIT
EXP MSA. ;ASCII
EXP MSE. ;EBCDIC
;EXTAB LINKS FOR DISPLAY/DISPLAY CONVERSION ROUTINES.
GMOVEX: XWD C%D6D7##,MOVE%## ;S-A,S-S
XWD C%D7D6##,C%D6D9## ;A-S,S-E
XWD C%D7D9##,MOVE%## ;A-E,A-A
XWD C%D9D7##,C%D9D6## ;E-A,E-S
XWD 0,MOVE%## ;-,E-E
;EXTAB LINKS FOR NUMERIC/DISPLAY - DISPLAY/NUMERIC CONVERSION ROUTINES.
GDNPDN: XWD GD6%##,PD6%##
XWD GD7%##,PD7%##
XWD GD9%##,PD9%##
;ENTRANCE TO"MOVE ZERO" ROUTINES
MZTAB: XWD MZS.,MZA. ;SIXBIT, ASCII
XWD MZE.,MZC1. ;EBCDIC,1-WORD COMP
XWD MZC2.,MZC1. ;2-WORD COMP, FLOAT
XWD MZC3.,MZED. ;COMP-3,EDITED
;ENTRANCES TO "MOVE HIGH-VALUES" ROUTINES
MHVTAB: XWD MHVS.,MHVA. ;[722] SIXBIT, ASCII
XWD MHVE.,MHVC1.
XWD MHVC2.,MHVC1.
XWD MHVC3.,MHVED.
;ENTRANCES TO "MOVE LOW-VALUES" ROUTINES
MLVTAB: XWD MLVS.,MLVA. ;[722] SIXBIT, ASCII
XWD MLVE.,MLVC1. ;[722] EBCDIC
XWD MLVC2.,MLVFP.
XWD MLVC3.,MLVED.
;ENTRANCES TO "MOVE SPACES" ROUTINES
MSTAB: XWD MLVD.,MSA.
XWD MSE.,BADFIG
XWD BADFIG,BADFIG
XWD BADFIG,MSED.
;ENTRANCES TO "MOVE QUOTES" ROUTINES
MQTAB: XWD MQS.,MQA.
XWD MQE.,BADFIG
XWD BADFIG,BADFIG
XWD BADFIG,MQED.
IFN ANS68,<
;ENTRANCES TO "MOVE TODAY" ROUTINES
MTTAB: XWD MTD.,MTD.
XWD MTD.,MTC.
XWD MTC.,MTC.
XWD MTC.,MTED.
>
IFN ANS74,<
;ENTRANCES TO "MOVE DATE" ROUTINES
MDTTAB: MDTD.,,MDTD.
MDTD.,,MDTC.
MDTC.,,MDTC.
MDTC.,,MDTED.
;ENTRANCES TO "MOVE DAY" ROUTINES
MDYTAB: MDYD.,,MDYD.
MDYD.,,MDYC.
MDYC.,,MDYC.
MDYC.,,MDYED.
;ENTRANCES TO "MOVE TIME" ROUTINES
MTITAB: MTID.,,MTID.
MTID.,,MTIC.
MTIC.,,MTIC.
MTIC.,,MTIED.
>
;TABLE OF FIGURATIVE CONSTANT TABLES
FCTAB:
IFN ANS68,<
EXP MTTAB ;TODAY
>
IFN ANS74,<
EXP 0
>
EXP MSTAB ;SPACES
EXP MZTAB ;ZEROES
EXP MQTAB ;QUOTES
EXP MHVTAB ;HIGH-VALUES
EXP MLVTAB ;LOW-VALUES
IFN ANS74,<
EXP MDTTAB ;DATE
EXP MDYTAB ;DAY
EXP MTITAB ;TIME
>
;TABLE OF ILLEGAL MOVES
;ENTRIES IN TABLE ARE FOR CLASSES OF "A".
;BITS IN TABLE ARE FOR CLASSES OF "B".
UNDEF==1B28!1B32-400 ;UNDEFINED
NE==1B29 ;NUMERIC EDITED
ABE==1B30 ;ALPHABETIC EDITED
;ANE==1B31 ;ALPHANUMERIC EDITED
NN==1B33 ;NUMERIC
ABN==1B34 ;ALPHABETIC
;ANN==1B35 ;ALPHANUMERIC
CLASST: EXP UNDEF ;ALPHANUMERIC
EXP UNDEF!NE!NN ;ALPHABETIC
EXP UNDEF!ABN!ABE ;NUMERIC
EXP -1 ;UNDEFINED
EXP UNDEF!NE!NN ;ALPHANUMERIC EDITED
EXP UNDEF!NE!NN ;ALPHABETIC EDITED
EXP UNDEF!ABN!ABE!NN!NE ;NUMERIC EDITED
EXP -1 ;UNDEFINED
EXTERNAL EXTLOC,EOPLOC,EOPNXT,CUREOP,OPERND,LITNXT,DATLOC
EXTERNAL EAS1PC,SUBCON,CURLIT
EXTERNAL DA.BWZ,DA.CLA,DA.EDT,DA.EDW,DA.EXS,DA.INS,DA.JST,DA.USG
EXTERNAL TB.DAT,LNKCOD
EXTERNAL EBASEX,ERESX,EINCRX,ESIZEX,EMODEX,EDPLX,EFLAGX,EBYTEX,ETABLX
EXTERNAL EBASEA,ERESA,EINCRA,ESIZEA,EMODEA,EDPLA,EFLAGA,EBYTEA,ETABLA
EXTERNAL EBASEB,ERESB,EINCRB,ESIZEB,EMODEB,EDPLB,EFLAGB,EBYTEB,ETABLB
EXTERNAL ESAVEB,ESAVBX,ESAVEA,ESAVAX,EBASAX,EBASBX,ESAVMA,ESVMAX,ESAVMB,ESVMBX
EXTERNAL ESAVTT,ESAVTX,AINTEM
EXTERNAL ESAVAD,ESAVES,ESAVSB
EXTERNAL ESIZEZ,EWORDB,EREMAN,EMASK,OPLINE
EXTERNAL EASRJ,EAZRJ,EAQRJ,ESZERO,ESQUOT,EFPLOV
EXTERNAL ELITPC,EAC,LITHLD,ELITHI,ELITLO,EMOVHL,ECONRJ,ECONLJ
EXTERNAL CUROPP
EXTERNAL MOVEI.,MOVEM.,MOVM.,MOVMM.,MOVN.,MOVNI.,MOVSI.
EXTERNAL MUL.,MULI.,IMUL.,IMULI.,IDIV.,DIV.11
EXTERNAL DPB.,LDB.,IDPB.,ILDB.,PUSHJ.,SKIPL.,SKPLE.,BLT.,SETZM.,SETOM.,ANDM.,ORCAM.
EXTERNAL HRLOI.,HRROI.,HRLZI.,HRRZI.,SETZB.,SOJG.,HRLZ.,HRRI.,HRLI.
EXTERNAL ASHC.,SETO.,SETZ.,SKIPA.,TRNE.,TRZ.
EXTERNAL JFCL.,CAILE.,TLO.
EXTERNAL ADDI.,DIV.22,DIV.21,DIV.12
IFE BIS,<
>
EXTERNAL MUL.12,MUL.21,MUL.22
EXTERNAL FIX.,FIX.2,FLOT.1,FLOT.2,FLT.12,FLT.22
EXTERNAL EDIT.S,EDIT.U
EXTERNAL D6MODE,D7MODE,D1MODE,D2MODE,D4MODE,FPMODE,F2MODE,EDMODE,FCMODE,LTMODE,DSMODE,ZERO
EXTERNAL EPJPP,MOVSAC
EXTERNAL XWDLIT,BYTLIT,ASCLIT,SIXLIT,D1LIT,D2LIT,FLTLIT,OCTLIT,XTNLIT,F2LIT
EXTERNAL AS.XWD,AS.BYT,AS.OCT,AC.DAT
EXTERNAL BYTE.S,BYTE.W,CHOP,CHAC,MAXSIZ,EOPHLD
EXTERNAL AS.EXT,AS.CNB,AS.MSC,AS.TAG,AS.LIT,AS.TMP,AS.PAR
EXTERNAL W1LN,W1CP,TCLN,TCCP,POWR10,DPWR10,EDITW1,EDITW2,EDITW3
EXTERNAL AS.DOT,AS.MS2
IFN BIS, EXTERNAL PCXBP2,PCXPTR,USENBT
EXTERNAL PUT.EX,PUT.PJ,PUT.16
END