Trailing-Edge
-
PDP-10 Archives
-
BB-H580E-SB_1985
-
strgen.mac
There are 7 other files named strgen.mac in the archive. Click here to see a list.
; UPD ID= 3534 on 5/8/81 at 12:06 PM by NIXON
TITLE STRGEN FOR COBOL V12C
SUBTTL CODE GENERATORS FOR STRING & UNSTRING C.MCCOMAS
SEARCH COPYRT
SALL
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1974, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
SEARCH P
%%P==:%%P
SEARCH INTERM ;NEED VALUE FOR "TOPS20"
IFE TOPS20, SEARCH MACTEN ;GET DEFS OF "MOVX", ETC.
IFN TOPS20, SEARCH MACSYM
;EDITS
;V12B****************
;NAME DATE COMMENTS
;JEH 01-DEC-82 [1434] Allow UNSTRING to return signs to signed
; destination fields
;JEH 14-JUN-82 [1365] If STRING source is edited and has occurs clause
; wrong size is used, change to external size
;JEH 11-JUN-82 [1364] UNSTRING delimiter has wrong size if figurative
; constant and source is edited
;V12*****************
;NAME DATE COMMENTS
;DMN 1-APR-80 [1004] MAKE ASCII & EBCDIC COLLATING SEQUENCES WORK.
;DAW 1-MAR-79 [646] FIX ERROR MESSAGE ALWAYS POINTS TO LINE 371 IF
; ERROR WAS IN SUBSCRIPTED "COUNT" ITEM IN UNSTRING.
;DMN 29-NOV-78 [604] PUT OUT CORRECT ERROR MESSAGE ON STRING OF NON-NUMERIC TO NUMERIC.
;V10*****************
;NAME DATE COMMENTS
;EHM 12-DEC-77 [524] FIX UNSTRING INTO RECEIVING FIELD WITH DECIMAL PLACES.
;EHM 8-FEB-77 FIX STRING ERROR "RECEIVING ITEM MAY NOT BE EDITED
; OR JUSTIFIED" WHICH COMES OUT AT WRONG PLACE.
;ACK 2-JUN-75 FIX RANDOM ERROR MESSAGES THAT COME OUT SOMETIMES.
;ACK 3-JUN-75 COMP-3/EBCDIC FOR STRING.
;********************
TWOSEG
.COPYRIGHT ;Put COPYRIGHT statement in .REL file.
SALL
RELOC 400000
ENTRY STRGEN ;STRING
ENTRY UNSGEN ;UNSTRING
;EXTERNAL ROUTINES
EXTERN LNKSET
;IN COBCOM
EXTERN CPOPJ,CPOPJ1
;IN CMNGEN
EXTERN PUTASY,PUTASN,PUT.EX,STASHI,STASHL,STASHP,STASHQ,POOLIT,POOL
EXTERN SZDPVA,DEPTSA,NB1PAR,SETOPA,SETOPB,SETOPN,OPNFAT,SUBSCA,GETEMP
EXTERN D.LTCD,BYTE.S
;IN MSCGEN
EXTERN GETTEM,MVAUN0
;IN MOVGEN
EXTERN MXX.,LITD.0
;IN IFGEN
EXTERN HIVQOT,IFSPCS,IFZROS
;IN MESGEN
EXTERN CSEQGN
EXTERN BMPEOP,GETTAG,REFTAG,PUTTAG
EXTERN TEMLOC,TEMNXT,EOPLOC,CUREOP,OPERND
EXTERN EBASEA,ERESA,EINCRA,EMODEA,ESIZEA,EDPLA,ETABLA,EFLAGA,EBYTEA
EXTERN EBASEB,ERESB,EINCRB,EMODEB,ESIZEB,EDPLB,ETABLB,EFLAGB,EBYTEB
EXTERN DA.JST,DA.EDT,DA.EXS,DA.BWZ,AS.CNB,AS.LIT,AS.MSC,TESUBC
EXTERN BYTLIT,OCTLIT,XWDLIT
EXTERN MOVEI.,MOV,MOVEM.,JRST.,POPJ.,SETZM.
EXTERN DSMODE,D1MODE,FPMODE,D7MODE
;IMPURE LOCS
EXTERN NSTRSE,STFLGS,STSSO,STPTO,SDSTIN,STSEST,STSELS,STSENS
EXTERN STSENX,STSETP,CURSSE,CURSRE
EXTERN ONLYEX,ALSTMP
EXTERN ELITPC,PLITPC,LITERR
EXTERN ESIZEZ
EXTERN SAVPR0
EXTERN M.ARG1,M.ARG2,M.ARG3,M.ARG4,LITNN
EXTERN STRSAV
IFN ANS74, EXTERN COLSEQ,COHVLV
DEFINE $CERR,< JSP TE,SIMPER >
SUBTTL HOW STRGEN WORKS
COMMENT \
Please read comments in STRNGL.MAC to understand what
is being generated by STRGEN. The remainder of the text here
assumes you have done that.
STRGEN first reads in all operands having to do with the
STRING or UNSTRING statement into EOPTAB. Then it shuffles them
around to make EOPTAB look like a bunch of operands (OPERATORS
are transformed into the 2-word pair (-1 + first word of operator)).
It also fills in the optional operands as (-2 + 0), so that
everything has a fixed number of operands. This constitutes the
"first pass" of STRING and UNSTRING code generation.
Next, extensive use of the TEM table allows STRGEN to
store some operands away for later code generation, while generating
some code for subscripts, other operands, or to get the initial value
of the item. In this pass, all operands are examined for validity,
and all initial setup code is generated. The operands are read from
EOPTAB, and some are put into TEMTAB for later use.
Next, the code for the runtime routines are generated. A "JRST"
is generated to jump over them. The operands needed for the runtime routines
are all read from TEMTAB entries. (The format of the TEMTAB entries is
explained elsewhere in this STRGEN). Each runtime routine ends with a POPJ
and is called by "PUSHJ'ing" to its tag. The tags are put into the
argument list when it is generated.
Next, the argument list is generated. Most of the information
in the TEMTAB entries is used to write the arguments in the argument list,
which is put into the literal table.
And finally, the "MOVEI 16,addr" and "PUSHJ 17,STR." is generated.
The information in TEMTAB is just left there. (Any code generator may
use TEMTAB for its own use.. each has the responsibility for resetting
it before it is used).
\ ;; end of comment
SUBTTL TEMTAB ENTRY FORMATS FOR STRING
;1) LOCATION STSETP POINTS TO FIRST STRING-SERIES ENTRY.
;
;2) EACH STRING-SERIES ENTRY HAS THE FOLLOWING FORMAT:
; +0/ LINK TO NEXT SS ENTRY, OR 0 IF THIS IS THE LAST
; +1/ LINK TO FIRST SOURCE ENTRY FOR THIS SS
; +2/ DELIMITER INFO FLAGS+BSI.DEL,,%TEMP OR 0
; +3/ %TAG OR 0
; +4/ NUMBER OF SOURCES
; +5-20/ OPERAND (IF NECESSARY TO STORE IT)
;
;3) EACH SOURCE-ENTRY HAS THE FOLLOWING FORMAT:
; +0/ LINK TO NEXT SOURCE ENTRY, OR 0 IF THIS IS THE LAST ONE
; +1/ BSI.SOURCE,,%TEMP OR 0
; +2/ %TAG OR 0
; +3-16/ OPERAND (IF NECESSARY TO STORE IT)
;TEMTAB ENTRY OFFSETS
;SS ENTRY
.SSLNK==0 ;LINK TO NEXT SS ENTRY
.SSLKS==1 ;LINK TO SOURCE ENTRIES FOR THIS SS
.SSFLG==2 ;FLAG WORD
SS%DLS==1B0 ;DELIMITED BY SIZE
SS%DNM==1B1 ;NUMERIC DELIMITER
BSI.DL: POINT 3,.SSFLG(TA),17 ;BSI OF DELIMITER
SPT.DL: POINT 18,.SSFLG(TA),35 ;POINTER TO %LIT FOR DELIMITER
TAG.DL: POINT 18,3(TA),35 ;TAG TO DELIMITER SETUP CODE
NUM.SR: POINT 18,4(TA),35 ;# OF SOURCES
.SSHLN==5 ;LEN OF FIXED PART OF SS ENTRY
.SSOPR==5 ;FIRST WORD OF OPERAND, IF ANY
;SOURCE ENTRY
.SRLNK==0 ;LINK TO NEXT SOURCE ENTRY
.SRFLG==1 ;FLAG WORD
SR%SRN==1B0 ;SOURCE IS NUMERIC
BSI.SR: POINT 3,.SRFLG(TA),17 ;BSI OF SOURCE
SPT.SR: POINT 18,.SRFLG(TA),35 ;PTR TO %LIT FOR SOURCE
TAG.SR: POINT 18,3(TA),35 ;TAG TO SOURCE SETUP CODE
.SRHLN==4 ;LEN OF FIXED PART OF SOURCE ENTRY
.SROPR==4 ;FIRST WORD OF OPERAND, IF ANY
SUBTTL GENERATE A "STRING"
COMMENT \
GENFIL FOR A STRING LOOKS LIKE:
SENDING ITEM 1.1
SENDING ITEM 1.2
...
SENDING ITEM 1.I
DELIMITER 1 (NOT PRESENT IF DELIMITED BY SIZE)
SDELIM OPERATOR (WITH FLAG 9 ON IF DELIMITED BY SIZE)
SENDING ITEM 2.1
SENDING ITEM 2.2
...
SENDING ITEM 2.J
DELIMETER 2 (NOT ...)
SDELIM OPERATOR (WITH ...)
...
SENDING ITEM K.1
SENDING ITEM K.2
...
SENDING ITEM K.L
DELIMITER K (NOT ...)
SDELIM OPERATOR (WITH ...)
RECEIVING ITEM
POINTER ITEM (OPTIONAL)
STRNG OPERATOR (WITH FLAG 10 ON IF THE POINTER ITEM IS PRESENT)
\
;ARRIVE HERE ON AN SDELIM OPERATOR
; FOLLOWED (OPTIONALLY) BY OTHER SDELIM'S WHICH MUST BE FORCIBLY READ
; AND THEN A STRNG OPERATOR WHICH ALSO MUST BE FORCIBLY READ
STRGEN: MOVE W2,W1 ;STORE [-1 + W1] IN EOPTAB
SETO W1, ; JUST AFTER OPERANDS FOR THIS SDELIM
PUSHJ PP,PUSH12##
HRRZ TB,EOPNXT## ;SAVE PTR TO NEXT LOC ON EOPTAB
ADDI TB,1
MOVEM TB,ARGSTR## ;USE THIS AS TEMP STORE
PUSHJ PP,READEM## ;READ NEXT OPERANDS+OPERATOR SET
CAIN W2,SDELIM ;ANOTHER SDELIM? OR A STRNG?
JRST STRGEN ;SDELIM
CAIE W2, STRNG ;WAS IT REALLY A STRING.
POPJ PP, ;NO, FORGET THE WHOLE THING, THE
; ERROR MESSAGE SHOULD HAVE BEEN
; GENERATED BY THE SYNTAX SCAN.
LDB TB,[POINT 1,W1,10] ;IS THERE A POINTER-ITEM?
JUMPN TB,STRG1 ;YES
PUSH PP,W1 ;SAVE STRNG OPERATOR
MOVNI W1,2 ;STORE [-2 + 0] ON EOPTAB
PUSHJ PP,PUSH%T
POP PP,W1 ;RESTORE STRNG OPERATOR
COMMENT \
ALL OPERANDS AND OPERATORS FOR THE STRING HAVE BEEN READ IN.
EOPTAB NOW LOOKS LIKE:
SENDING ITEM 1.1
SENDING ITEM 1.2
...
SENDING ITEM 1.I
DELIMITER 1 (NOT PRESENT IF DELIMITED BY SIZE)
[-1 + W1]
SENDING ITEM 2.1
SENDING ITEM 2.2
...
SENDING ITEM 2.J
DELIMITER 2 (NOT ...)
[-1 + W1]
...
SENDING ITEM K.1
SENDING ITEM K.2
...
SENDING ITEM K.L
DELIMITER K (NOT ...)
[-1 + W1]
RECEIVING ITEM
POINTER ITEM (OR [-2 + 0] IF THERE WAS NO POINTER ITEM)
\
STRG1: SWOFF FEOFF1 ;TURN OFF MOST FLAGS
SETZM STFLGS ; CLEAR FLAGS
SETZM STSSO ;STRING SOURCE-SERIES OFFSET IN TEMTAB
SETZM STPTO ; POINTER ITEM
SETZM STSETP ;PTR TO FIRST SS ENTRY
;CLEAR OUT TEMTAB
MOVE TE,TEMLOC
AOBJN TE,.+1 ;PRETEND 0 ENTRY IS USED
MOVEM TE,TEMNXT
; ARGSTR NOW POINTS TO THE RECEIVING ITEM IN EOPTAB.
;(NOT THE POINTER ITEM, BECAUSE IT WAS USED TO HOLD THE "NEXT LOCATION"
;IN EOPTAB, AND WASN'T UPDATED AFTER THE LAST ARG WAS STORED)
HRRZ TC,ARGSTR ;GET ABS ADDRESS OF RECEIVING ITEM
MOVEM TC,CUREOP ;SAVE IT
HRLM TC,OPERND ;FOR NB1PAR AND SUBSCA
HRRZI TA,(TC) ; MAKE RELATIVE ADDRESS
HRRZ TB,EOPLOC
SUBI TA,(TB)
MOVEM TA,ARGSTR ;SAVE REL. ADDRESS IN ARGSTR
MOVE TB,(TC) ;MAKE SURE RECEIVING ITEM ISN'T
TLNN TB,GNLIT!GNFIGC ; A LITERAL OR FIGURATIVE CONSTANT
JRST STRG2 ;NO, OK
$CERR ;? SYNTAX SCAN SHOULD HAVE GOT IT
;CUREOP (AND "TC") POINTS TO THE RECEIVING ITEM.
STRG2: PUSHJ PP,SETOPA ;SET IT UP AS OPERAND "A"
; IF ERRORS, RETURN TO PHASE E DRIVER
TSWF FANUM ;IF NUMERIC,
JRST STRE1 ;IT'S AN ERROR
;SETUP BSI OF RECEIVING ITEM
HRRZ TE,EMODEA ;GET MODE
CAILE TE,DSMODE ; HAS TO BE DISPLAY IF NON-NUMERIC!
$CERR ;? IMPOSSIBLE ERROR
MOVEM TE,SDSTIN ;STRING DESTINATION INFO
HRRZ TA,ETABLA ;CAN'T BE JUSTIFIED
PUSHJ PP,LNKSET
LDB TE,DA.JST
JUMPN TE,STRE5 ; GO COMPLAIN
LDB TE,DA.EDT ;OR EDITED
JUMPN TE,STRE5
;THE RECEIVING ITEM IS IN "A". IT IS OK.
; (FALL INTO CODE ON NEXT PAGE)
;GENERATE CODE TO STORE BP IN DST.BP, CC IN DST.CC
PUSHJ PP,NB1PAR ;GET BP TO "A" IN AC5
TSWF FERROR
POPJ PP, ;ERRORS, RETURN
;GEN CODE TO STORE BP: "MOVEM AC5,DST.BP"
MOVE CH,[MOVEM.+AC5,,DST.BP##]
PUSHJ PP,PUT.EX
;GEN CODE TO STORE CC
PUSHJ PP,DEPTSA ;DOES "A" HAVE A DEPENDING ITEM?
JRST STRG3 ;NO, GENERATE "MOVEI" TO GET SIZE
MOVEI TE,7 ;USE AC7 TO GET SIZE
SETZM SAVPR0 ;DON'T HAVE TO SAVE %PARAM
PUSHJ PP,SZDPVA ;GET SIZE IN RUNTIME AC7
$CERR ;?? ERRORS.. IMPOSSIBLE
JRST STRG4 ;SKIP OVER "MOVEI"
STRG3: PUSHJ PP,GTCCA ;GEN "MOVEI AC7,SIZE OF A"
;NOW SIZE IS IN AC7, MOVE IT TO DST.CC
STRG4: MOVE CH,[MOVEM.+AC7,,DST.CC##]
PUSHJ PP,PUT.EX
;STORE MAX SIZE IN LH (SDSTIN)
HRRZ TE,ESIZEA
HRLM TE,SDSTIN
;WE ARE NOW DONE WITH THE DESTINATION (RECEIVING) ITEM
; GO ON TO THE POINTER ITEM
;SETUP POINTER ITEM
HRRZ TA,ARGSTR ;POINTER TO RECEIVING ITEM
ADD TA,EOPLOC ;IT WAS RELATIVE, MAKE IT ABSOLUTE
HRRZM TA,CUREOP ;AND CALL BMPEOP TO FIND START OF NEXT
PUSHJ PP,BMPEOP ; OPERAND
$CERR ;? MUST BE THERE (-2,,0) STORED
HRRZ TE,CUREOP ;NEW CUREOP (POINTS TO POINTER ITEM)
MOVE TD,(TE) ;GET 1ST WORD
CAMN TD,[-2] ; -2 MEANS NO POINTER ITEM
JRST STRG4B ;GO GEN CODE TO PUT 1 IN PT.VAL
;MAKE ARGSTR POINT TO REL ADDRESS OF THE "POINTER" ITEM..
HRRZ TD,EOPLOC ;START
SUBI TE,(TD)
MOVEM TE,ARGSTR
;THERE WAS A POINTER ITEM. CUREOP NOW POINTS TO IT.
HRRZ TC,CUREOP ;POINTER IN TC FOR SETOPA
MOVE TD,(TC)
TLNN TD,GNLIT!GNFIGC
JRST STRG4A ;NOT LIT OR FIG. CONST--OK
IFN ANS74, $CERR ;?SYNTAX SCAN SHOULD CATCH THIS
IFN ANS68,< ;COULD BE TALLY
TLNE TD,GNFIGC ;FIG. CONST?
TLNN TD,GNTALY ;YES, IS IT TALLY?
$CERR ;NO, RANDOM FIG. CONST. OR LITERAL
>
;HERE WITH TC POINTING TO THE "POINTER" ITEM
STRG4A: PUSHJ PP,SETOPA ;SET IT UP AS "A"
; (ERRORS RETURN TO PHASE E DRIVER).
TSWF FANUM ;POINTER MUST BE NUMERIC
SKIPE EDPLA ; AND CAN'T HAVE DECIMAL PLACES
JRST STRE2 ;ELSE COMPLAIN AND QUIT
HRRZ TA,EMODEA
CAIN TA,FPMODE ;DISALLOW FLOATING POINT
JRST STRE2
PUSHJ PP,STRGT3 ;GIVE ERROR IF THE "POINTER" ITEM IS EDITED
; (STILL IN STRG4.. CODE - HANDLING POINTER ITEM)
;MAKE SURE IT IS BIG ENOUGH TO BE A POINTER ITEM FOR THIS RECEIVING ITEM
PUSHJ PP,STRT4P ;MAKE TEST
;REMEMBER THERE WAS A POINTER ITEM
STRG4C: MOVEI TE,1B18 ;"POINTER ITEM"
IORM TE,STFLGS ; SET IT IN THE FLAGS
;GET ALL SUBSCRIPTS FOR POINTER ITEM INTO %TEMP
SETOM ONLYEX ;JUST EXAMINE
SETOM ALSTMP ; EVEN COMP SUBSCRIPTS INTO %TEMP
HRRZ TC,CUREOP ;SUBSCA EXPECTS THE "A" OPERAND
HRLM TC,OPERND ; IN LH (OPERND)
PUSHJ PP,SUBSCA
SETZM ONLYEX ;CLEAR FLAGS THAT SUBSCR DOESN'T BOTHER TO
SETZM ALSTMP
TSWF FERROR ;ERRORS?
POPJ PP, ;YES, RETURN
; NOW ALL SUBSCRIPTS ARE IN %TEMP SO THEY WON'T BE AFFECTED BY THE STRING STMT.
;IF THE POINTER ITEM WASN'T SUBSCRIPTED, NO CODE HAS BEEN GENERATED
;BY THE CALL TO SUBSCA ABOVE.
;
;NOTE THAT DEPENDING ITEMS ARE NOT A PROBLEM SINCE THE POINTER ITEM
;IS NUMERIC.
;LOOKING AT POINTER ITEM
;COPY OPERAND TO TEMTAB SO WE CAN GET IT LATER
HRRZ TE,ARGSTR ;REL ADDRESS OF POINTER ITEM
ADD TE,EOPLOC ;GET ABS LOC OF OPERAND
HRRZ TC,TE
MOVE TE,1(TC) ;HOW MANY SUBSCRIPTS AND STUFF TO FOLLOW?
LDB TA,TESUBC
LSH TA,1 ;= THIS MANY WORDS
ADDI TA,2 ;PLUS TWO FOR THE BASE OPERAND
PUSH PP,TA ;SAVE # WORDS TO COPY
PUSHJ PP,GETTEM ; GET THE WORDS IN TEMTAB
HRRZ TB,TA ;TA RETURNED BY GETTEM,
; = REL LOC OF ENTRY IN TEMTAB
HRRM TA,STPTO ; REMEMBER WHERE THE POINTER OPERAND WILL GO
ADD TA,TEMLOC ;MAKE TA BE ABS LOC
;COPY OPERAND TO TEMTAB
POP PP,TD ;TD:= # WORDS TO COPY
HRRZ TB,ARGSTR ; START OF OPERAND IN EOPTAB
ADD TB,EOPLOC
PUSHJ PP,COPYOP ;COPY THE OPERAND
;POINTER ITEM'S OPERAND IS NOW IN TEMTAB.
; NOW RH (STPTO) = REL ADDRESS IN TEMTAB OF THE OPERAND
; LH (STPTO) = 0
;NOW GENERATE CODE TO PUT INITIAL VALUE OF POINTER INTO PT.VAL
SWON FBSIGN ;MAKE PT.VAL A COMP SIGNED FIELD
SWOFF FBSUB ;NOT SUBSCRIPTED
MOVE TE,[^D36,,PT.VAL##]
MOVEM TE,EBASEB
SETZM EINCRB
MOVEI TE,D1MODE ;1-WORD COMP
MOVEM TE,EMODEB
SETZM EFLAGB
SETZM ETABLB
SETZM EBYTEB
SETZM EDPLB
HRRZ TE,ESIZEA ;SAME SIZE
CAILE TE,^D10 ;UNLESS > 10.
MOVEI TE,^D10 ; IN WHICH CASE, WE WILL TRUNCATE TO 10
HRRZM TE,ESIZEB
PUSHJ PP,MXX. ;MOVE "A" TO "B"
TSWF FERROR ;IF ERRORS,
POPJ PP, ;GIVE UP NOW
;GET A TAG WHICH WILL BE ADDRESS OF ROUTINE TO CALL TO STORE NEW POINTER
; VALUE. THE CODE FOR THIS ROUTINE WILL BE GENERATED LATER ON.
PUSHJ PP,GETTAG ;RETURNS TAG IN "CH"
HRLM CH,STPTO ;STORE TAG IN LH(STPTO)
;NOW RH (STPTO) = REL ADDRESS IN TEMTAB OF POINTER ITEM OPERAND
; LH (STPTO) = TAG OF ROUTINE TO CALL TO STORE POINTER VALUE.
JRST STRG5 ;DONE WITH POINTER ITEM (FOR NOW)
;HERE IF THERE WAS NO POINTER ITEM.. GEN CODE TO
; STORE VALUE OF 1 IN PT.VAL.
STRG4B: MOVE CH,[MOVEI.+0,,1]
PUSHJ PP,PUTASY ;"MOVEI 0,1"
MOVE CH,[MOVEM.+0,,PT.VAL##]
PUSHJ PP,PUT.EX ;"MOVEM 0,PT.VAL"
;HERE WHEN DONE WITH POINTER ITEM
STRG5: HRRZ TE,EOPLOC ;START AT THE TOP NOW
ADDI TE,1 ;POINT TO FIRST OPERAND IN EOPTAB
SETZM NSTRSE ;COUNT # OF STRING-SERIES FOUND
;HERE WITH TE POINTING TO EITHER START OF EOPTAB
; OR JUST AFTER THE SDELIM OPERATOR FOR THE LAST
; STRING-SERIES WE PROCESSED.
;FIND SDELIM OPERATOR IF WE CAN, IF THERE ARE NO MORE, EXIT THIS LOOP
STRG6: MOVEM TE,STSEST ;SAVE START OF THIS STRING SERIES
MOVEM TE,STSELS ;SO FAR, THIS IS THE LAST OPERAND IN THIS
; STRING SERIES
SETZM STSENS ;COUNT NUMBER OF SOURCES
MOVEM TE,CUREOP ;READY TO CALL BMPEOP TO FIND THE END
STRG6A: PUSHJ PP,BMPEOP ; GET NEXT ITEM..
JRST STRG77 ;NO MORE, EXIT LOOP
AOS STSENS ;ASSUME WE'VE SEEN ANOTHER SOURCE
; THIS COULD BE A DELIMITER, HOWEVER, IN
; WHICH CASE WE'LL HAVE TO REMEMBER TO
; SUBTRACT ONE FROM THIS COUNTER!
HRRZ TC,CUREOP ;CHECK THIS ITEM OUT
MOVE TD,(TC) ;GET 1ST WORD
CAMN TD,[-1] ; ARE WE AT (-1 + W1) OPERAND?
JRST STRG7 ;YES -- FOUND END OF STRING SERIES
MOVEM TC,STSELS ;SAVE LAST OPERAND IN THE STRING SERIES
JRST STRG6A ;GO GET THE REST, IF ANY
;HERE WHEN WE REACHED THE END OF THE "STRING SERIES"
;CUREOP POINTS TO THE (-1 + W1) ENTRY
STRG7: AOS NSTRSE ;COUNT ANOTHER STRING-SERIES
;AT STRG6 WE STORED THE ABS. LOCATIONS OF "NEXT OPERAND" (STSENX),
; "LAST OPERAND" (STSELS), AND "STARTING OPERAND" (STSEST). NOW WE
; WILL CONVERT THEM TO RELATIVE ADDRESSES SO EXPANDING TABLES WILL
; NOT CAUSE COMPILER BUGS.
;SAVE REL ADDRESS OF START OF NEXT "STRING-SERIES"
HRRZ TD,CUREOP ;GET REL ADDR TO SAVE BEFORE THIS EXPAND
ADDI TD,2 ;NEXT ONE STARTS JUST PAST THE (-1+W1) WORDS
HRRZ TE,EOPLOC
SUBI TD,(TE) ;TD:= OFFSET INTO EOPTAB
MOVEM TD,STSENX ;LOC OF NEXT "STRING-SERIES"
;SAVE REL ADDRESS OF START OF THIS STRING SERIES
HRRZ TD,STSEST
SUBI TD,(TE)
MOVEM TD,STSEST
;SAVE REL ADDRESS OF LAST OPERAND IN THIS STRING SERIES
HRRZ TD,STSELS
SUBI TD,(TE)
MOVEM TD,STSELS
;MAKE AN ENTRY IN TEMTAB FOR THIS STRING-SERIES
; (TO SEE THE FORMAT OF THE TEMTAB ENTRY, GO TO AN EARLY PAGE IN
;THE LISTING OF STRGEN).
;THE FIRST THING IS TO GET A TEMTAB ENTRY FOR THE STRING-SERIES.
; LOOK AT THE DELIMITER TO SEE HOW BIG THE ENTRY HAS TO BE.
HRRZ TC,CUREOP ;LOOK AT W1 TO SEE IF THERE WAS A DELIMITER
MOVE TD,1(TC)
TXNN TD,1B9 ;DELIMITED BY SIZE?
JRST STRG8 ;NO, REAL DELIMITER
;DELIMITED BY SIZE, DON'T HAVE TO STORE AN OPERAND IN TEMTAB
MOVEI TA,.SSHLN ;JUST FIXED SIZE
PUSHJ PP,TLNKSS ;LINK TO LAST SS ENTRY
;NOW CURSSE POINTS TO THE ENTRY WE'VE JUST GOT
HRRZ TA,CURSSE
ADD TA,TEMLOC ;;RH (TA) = ABS POINTER TO ENTRY
;SET FLAG SAYING "DELIMITED BY SIZE"
MOVX TB,SS%DLS
IORM TB,.SSFLG(TA)
;ALL DONE WITH DELIMITER, GO HANDLE SOURCES
JRST STRG9
;HERE IF THERE WAS A REAL DELIMITER. CHECK IT OUT AND
; FIND # WORDS FOR ENTRY IN TEMTAB.
;WE WILL SET CUREOP TO POINT TO THE DELIMITER AND SET IT UP AS "A".
STRG8: SOS STSENS ;FIX COUNTER TO REALLY BE # SOURCES
HRRZ TE,STSELS ;LAST OPERAND WAS THE DELIMITER
ADD TE,EOPLOC ;GET ABS. ADDRESS
HRRZM TE,CUREOP ;TELL PHASE E ROUTINES WHAT WE ARE
HRLM TE,OPERND ; LOOKING AT
MOVE TE,(TE)
TLNE TE,GNLIT!GNFIGC ;LITERAL OR FIG CONST?
JRST STRG8D ;YES
HRRZ TC,CUREOP ;POINT TO THE OPERAND
PUSHJ PP,SETOPA ;SET UP DELIMITER IN "A", IF ERRORS,
; RETURN TO PHASE E DRIVER
TSWT FANUM ;IS THE DELIMITER NUMERIC?
JRST STRG8A ;NO
;IF NUMERIC, THE DELIMITER MUST BE AN INTEGER
HRRZ TE,EMODEA
CAIE TE,FPMODE
SKIPE EDPLA
JRST STRE6
;NUMERIC DELIMITER LOOKS GOOD. WE WILL HAVE TO COPY THE OPERAND
; TO TEMTAB ENTRY, SO FIGURE OUT HOW BIG THE ENTRY HAS TO BE AND CREATE IT.
HRRZ TC,CUREOP ;THE DELIMITER OPERAND
MOVE TE,1(TC) ;HOW MANY SUBSCRIPTS?
LDB TA,TESUBC
LSH TA,1
ADDI TA,2 ;+2 WORDS FOR BASE ITEM
PUSH PP,TA ;SAVE # WORDS IN OPERAND
ADDI TA,.SSHLN ;ADD WORDS FOR REST OF SS ENTRY
PUSHJ PP,TLNKSS ; GET AN SS ENTRY AND PUT IN LINKED LIST
HRRZ TA,CURSSE ;ENTRY WE'VE JUST CREATED
ADD TA,TEMLOC ;GET ABS PTR TO IT
ADDI TA,.SSOPR ;POINT TO THE RIGHT PLACE
;COPY THE OPERAND
HRRZ TB,STSELS ;FIND DELIMITER OPERAND AGAIN
ADD TB,EOPLOC ; BEING CAREFUL BECAUSE IT MAY HAVE MOVED
POP PP,TD ;TD:= # WORDS IN OPERAND
PUSHJ PP,COPYOP ;COPY IT..
;SET "OPERAND IS NUMERIC" FLAG
HRRZ TA,CURSSE
ADD TA,TEMLOC
MOVX TE,SS%DNM ;"NUMERIC DELIMITER"
IORM TE,.SSFLG(TA) ; SET THE FLAG
;GET A TAG WHICH WILL BE ROUTINE TO CALL TO SETUP
; TMP.DL, DLM.CC, AND DLM.BP. THE CODE FOR THIS ROUTINE
; WILL BE GENERATED LATER
PUSHJ PP,GETTAG ;RETURN AS.TAG+N IN CH
HRRZ TA,CURSSE
ADD TA,TEMLOC
DPB CH,TAG.DL ;STORE TAG
JRST STRG9 ;DONE WITH DELIMITER, GO HANDLE SOURCES
;HERE FOR NON-NUMERIC DELIMITER
; IT HAS BEEN SETUP IN "A". WE KNOW IT IS NOT A LITERAL OR FIG CONST.
; THEREFORE IT HAS TO BE SOME KIND OF DISPLAY.
STRG8A: HRRZ TE,EMODEA ;MAKE SURE
CAILE TE,DSMODE
$CERR ;? IMPOSSIBLE!
;FOR NORMAL DATANAMES, WE DON'T HAVE TO COPY THE OPERAND TO TEMTAB.
; (JUST GENERATE %LIT00 POINTER TO BP AND CC).
; HOWEVER, IF IT'S SUBSCRIPTED OR HAS A DEPENDING VARIABLE, WE HAVE
; TO STORE THE OPERAND IN TEMTAB.
;NOTE: SUBSCRIPTS MUST NOT BE PUT INTO %TEMP AT THIS POINT!!!
; ACTUALLY WE WOULD LIKE TO CATCH ALL CONSTANT SUBSCRIPTS,
;BUT THE SUBSCR ROUTINE CAN'T DO IT WITHOUT PUTTING THINGS INTO %TEMP
; (THIS MIGHT BE A GOOD THING TO ENHANCE!)
PUSHJ PP,DEPTSA ;DOES "A" HAVE A DEPENDING VARIABLE?
TSWF FASUB ; NO, BUT IT IS SUBSCRIPTED?
JRST STRG8C ;YUP, HAVE TO COPY OPERAND!
MOVEI TA,.SSHLN ;JUST MAKE THE FIXED-LENGTH ENTRY
PUSHJ PP,TLNKSS
HRRZ TA,CURSSE ;MAKE TA POINT TO ENTRY
ADD TA,TEMLOC ; WE'VE JUST CREATED
;STORE BSI.DELIM
HRRZ TE,EMODEA
DPB TE,BSI.DL
;GEN CODE TO STORE CC AND BP IN LITERALS
HRRZ TE,STSELS ;RESET CUREOP AND OPERND
ADD TE,EOPLOC ;JUST INCASE TLNKSS MADE TABLES EXPAND
HRRM TE,CUREOP
HRLM TE,OPERND
PUSHJ PP,GTLBPC ;GET LITERAL TO BP AND CC FOR "A"
;AS.LIT+N HAS BEEN RETURNED BY GTLBPC IN "TE"
HRRZ TA,CURSSE ;SETUP TA AGAIN TO POINT TO ENTRY
ADD TA,TEMLOC
DPB TE,SPT.DL ;STORE LOC OF 2-WORD BLOCK
JRST STRG9 ;DONE WITH DELIMITER
;HERE WHEN DELIM OPERAND MUST BE COPIED TO TEMTAB ENTRY
STRG8C: HRRZ TC,CUREOP
MOVE TE,1(TC) ;HOW MANY SUBSCRIPTS?
LDB TA,TESUBC
LSH TA,1 ; # WORDS
ADDI TA,2 ;+ 2 FOR BASE ITEM
PUSH PP,TA ;SAVE # WORDS IN THE OPERAND ITSELF
ADDI TA,.SSHLN ;GET # WORDS IN WHOLE TEMTAB SS ENTRY
PUSHJ PP,TLNKSS ;MAKE IT
HRRZ TA,CURSSE ;MAKE TA POINT TO ENTRY
ADD TA,TEMLOC
ADDI TA,.SSOPR ;POINT TO THE RIGHT PLACE
;COPY THE OPERAND
HRRZ TB,STSELS ;FIND IT AGAIN
ADD TB,EOPLOC
POP PP,TD ;TD:= # WORDS TO COPY
PUSHJ PP,COPYOP ;COPY IT..
;GET A TAG FOR ROUTINE TO CALL LATER
;THE ROUTINE WILL SETUP DLM.CC AND DLM.BP
PUSHJ PP,GETTAG ;CH RETURNED IS AS.TAG+N
HRRZ TA,CURSSE
ADD TA,TEMLOC ;TA POINTS TO TEMTAB ENTRY
DPB CH,TAG.DL ;STORE TAG IN ENTRY
;STORE BSI OF DELIMITER
HRRZ TE,EMODEA
DPB TE,BSI.DL
JRST STRG9 ;DONE WITH DELIMITER
;HERE IF DELIMITER IS A LITERAL OR FIG CONST.
STRG8D: HRRZ EACA,SDSTIN ;SET LIT TO MODE OF DESTINATION
; IF POSSIBLE
PUSHJ PP,SETLFC ;SETUP LITERAL OR FIG. CONST.
POPJ PP, ;ERRORS, RETURN
MOVEI TA,.SSHLN ;NEED FIXED-LENGTH TEMTAB ENTRY
PUSHJ PP,TLNKSS
HRRZ TA,CURSSE ;MAKE TA POINT TO CURRENT ENTRY
ADD TA,TEMLOC
;STORE BSI.DELIM
HRRZ TE,EMODEA ; = BSI.DEST
DPB TE,BSI.DL ;STORE BSI OF DELIMITER
;IF "ALL" WAS SPECIFIED, GIVE ERROR
HRRZ TC,STSELS ;FIND OPERAND AGAIN
ADD TC,EOPLOC
MOVE TE,0(TC)
TLNE TE,GNALL ;"ALL" SPECIFIED?
PUSHJ PP,[MOVEM TC,CUREOP ;PREPARE TO POINT TO LITERAL
MOVEI DW,E.273 ;"Improper use of ALL"
PUSHJ PP,OPNFAT
SWOFF FERROR ;TURN OFF "ERROR SEEN" FLAG
POPJ PP,] ;RETURN
;GEN BP AND CC
MOVE TA,[^D36,,AS.MSC] ;SETUP "A" TO POINT TO THE LITERAL
MOVEM TA,EBASEA
HRRZM EACC,EINCRA ;%LIT + N
PUSHJ PP,GTLBPC ;GET TE= PTR TO 2-WORD LITERAL
;STORE PTR TO THE BP AND CC IN THE STRING-SERIES TEMTAB ENTRY
HRRZ TA,CURSSE
ADD TA,TEMLOC
DPB TE,SPT.DL ;STORE %LIT POINTER
; JRST STRG9 ;ALL DONE WITH DELIMITER, GO ON TO SOURCES
;HERE WHEN ALL DONE WITH THE DELIMITER, HANDLE THE SOURCES
STRG9: SKIPG TE,STSENS ;# SOURCES.. AT LEAST ONE?
$CERR ;-- IT'S LIKELY THAT THIS SHOULD BE A POPJ --
;(PHASE D MAY HAVE PARSED IT INCORRECTLY BUT
; FAILED TO TURN OPERAND INTO A "YECCH")
MOVEM TE,M.ARG1 ;M.ARG1 = # SOURCES LEFT TO DO
;STORE # SOURCES IN THIS SS ENTRY
HRRZ TA,CURSSE
ADD TA,TEMLOC
DPB TE,NUM.SR ;STORE # SOURCES
;SETUP FOR INITIAL STRG10 LOOP
HRRZ TE,STSEST ;LOOK AT FIRST SOURCE
MOVEM TE,M.ARG2 ;M.ARG2 = REL EOPTAB PTR TO LAST SOURCE WE DID
SETZM CURSRE ;CLEAR "CURRENT SOURCE" ENTRY
;HERE TO LOOK AT NEXT SOURCE.. TE IS REL EOPTAB PTR OF IT
; M.ARG1 IS # SOURCES LEFT TO DO.
STRG10: ADD TE,EOPLOC ;LOOK AT THIS SOURCE
HRRM TE,CUREOP
HRLM TE,OPERND ;FOR NB1PAR
MOVE TE,(TE) ;LOOK AT FIRST WORD OF OPERAND
TLNE TE,GNLIT!GNFIGC ;LITERAL OR FIG CONST?
JRST STRG20 ;YES
HRRZ TC,CUREOP ;POINT TO THE OPERAND
PUSHJ PP,SETOPA ;SET UP SOURCE IN "A", IF ERRORS, RETURN
; TO PHASE E DRIVER
TSWT FANUM ;NUMERIC SOURCE?
JRST STRG15 ;NO
;SOURCE IS NUMERIC. IT MUST REPRESENT AN INTEGER
HRRZ TE,EMODEA
CAIE TE,FPMODE ;NO FLOATING POINT ALLOWED
SKIPE EDPLA
JRST STRE6 ;"MUST REPRESENT AN INTEGER"
IFN ANS74,<
SKIPGE EFLAGA ;IF SEP. SIGN,
JRST STRG15 ;TREAT AS NON-NUMERIC
>
;NUMERIC SOURCE LOOKS GOOD. WE WILL HAVE TO COPY THE OPERAND
; TO TEMTAB ENTRY, SO FIGURE OUT HOW BIG THE ENTRY HAS TO BE
; AND CREATE IT.
HRRZ TC,CUREOP ;THE SOURCE OPERAND
MOVE TE,1(TC)
LDB TA,TESUBC ;HOW MANY WORDS FOR SUBSCRIPTS?
LSH TA,1 ;TA: = THAT MANY
ADDI TA,2 ;+2 FOR THE BASE ITEM
PUSH PP,TA ;SAVE # WORDS IN OPERAND
ADDI TA,.SRHLN ;ADD WORDS FOR REST OF SOURCE ENTRY
PUSHJ PP,TLNKSR ; GET A SOURCE ENTRY AND PUT IN LINKED LIST
HRRZ TA,CURSRE ;ENTRY WE'VE JUST CREATED
ADD TA,TEMLOC ;TA:= ABS PTR TO IT
ADDI TA,.SROPR ;POINT TO THE RIGHT PLACE
;COPY THE OPERAND
HRRZ TB,M.ARG2 ;FIND SOURCE OPERAND
ADD TB,EOPLOC
POP PP,TD ;TD:= # WORDS IN OPERAND
PUSHJ PP,COPYOP ;COPY THE OPERAND
;SET "OPERAND IS NUMERIC" FLAG
HRRZ TA,CURSRE
ADD TA,TEMLOC
MOVX TE,SR%SRN ;"SOURCE IS NUMERIC"
IORM TE,.SRFLG(TA) ; SET THE FLAG
;GET A TAG WHICH WILL BE ROUTINE TO CALL TO SETUP
; SR.TMP, SRC.CC, AND SRC.BP. THE CODE FOR THIS
; ROUTINE WILL BE GENERATED LATER
PUSHJ PP,GETTAG ;RETURNS CH= AS.TAG+N
HRRZ TA,CURSRE
ADD TA,TEMLOC ;;GET TA:= PTR TO SOURCE ENTRY
DPB CH,TAG.SR ;STORE TAG
JRST STRG30 ;DONE WITH THIS SOURCE, GO ON TO NEXT ONE
;HERE FOR NON-NUMERIC SOURCE
STRG15: HRRZ TE,EMODEA ;MAKE SURE IT'S REALLY DISPLAY
CAILE TE,DSMODE
$CERR ;??? AAAAAH!
;THE SAME RULES APPLY AS FOR NON-NUMERIC DELIMITERS:
;1) SUBSCRIPTS MUST NOT BE PUT INTO %TEMP
;2) %TAG WILL BE USED IF SUBSCRIPTS OR DEPENDING VARIABLES
;3) %LIT00 POINTER WILL BE USED OTHERWISE
PUSHJ PP,DEPTSA ;DOES "A" HAVE A DEPENDING VARIABLE?
TSWF FASUB ; NO, BUT IS IT SUBSCRIPTED?
JRST STRG17 ;YUP, HAVE TO COPY OPERAND
MOVEI TA,.SRHLN ;JUST MAKE THE FIXED-LENGTH ENTRY
PUSHJ PP,TLNKSR ;LINK TO REST OF SOURCES
HRRZ TA,CURSRE ;MAKE TA POINT TO THIS ENTRY
ADD TA,TEMLOC
;STORE BSI.SOURCE
HRRZ TE,EMODEA
DPB TE,BSI.SR
;GEN CODE TO STORE CC AND BP IN LITERALS
HRRZ TE,M.ARG2 ;FIND SOURCE OPERAND AGAIN
ADD TE,EOPLOC
HRRM TE,CUREOP
HRLM TE,OPERND
PUSHJ PP,GTLBPC ;GET LITERAL TO BP AND CC FOR "A"
;AS.LIT+N HAS BEEN RETURNED BY GTLBPC IN "TE"
HRRZ TA,CURSRE ;SETUP TA AGAIN TO POINT TO SOURCE ENTRY
ADD TA,TEMLOC
DPB TE,SPT.SR ;STORE LOC OF 2-WORD BLOCK
JRST STRG30 ;DONE WITH THIS SOURCE
;HERE WHEN SOURCE OPERAND MUST BE COPIED TO SOURCE-ENTRY
;BECAUSE THERE WERE SUBSCRIPTS AND/OR DEPENDING ITEMS
STRG17: HRRZ TC,CUREOP
MOVE TE,1(TC) ;FIND # SUBSCRIPTS
LDB TA,TESUBC
LSH TA,1
ADDI TA,2 ;+2 FOR BASE ITEM
PUSH PP,TA ;SAVE # WORDS IN OPERAND
ADDI TA,.SRHLN ;GET TOTAL # WORDS IN TEMTAB ENTRY
PUSHJ PP,TLNKSR ; LINK TO OTHER SOURCE ENTRIES
HRRZ TA,CURSRE ;MAKE TA POINT TO ENTRY
ADD TA,TEMLOC
ADDI TA,.SROPR
;COPY THE OPERAND
HRRZ TB,M.ARG2 ;FIND IT AGAIN
ADD TB,EOPLOC
POP PP,TD ;TD:= # WORDS TO COPY
PUSHJ PP,COPYOP ;COPY IT..
;GET A TAG FOR ROUTINE TO CALL LATER
; THE ROUTINE WILL SET UP SRC.CC AND SRC.BP
PUSHJ PP,GETTAG ;CH RETURNED IS AS.TAG+N
HRRZ TA,CURSRE
ADD TA,TEMLOC ;TA POINTS TO TEMTAB SOURCE ENTRY AGAIN
DPB CH,TAG.SR ;STORE TAG IN ENTRY
;STORE BSI OF SOURCE
HRRZ TE,EMODEA
DPB TE,BSI.SR
JRST STRG30 ;DONE WITH THIS SOURCE
;HERE IF SOURCE IS LITERAL OR FIG CONST.
STRG20: HRRZ TA,CURSSE
ADD TA,TEMLOC ;POINT TO CURRENT SS ENTRY
MOVE TE,.SSFLG(TA) ;GET FLAG WORD
TXNE TE,SS%DLS ;IF DELIMITED BY SIZE,
SKIPA EACA,SDSTIN ; USE DESTINATION MODE
LDB EACA,BSI.DL ;OTHERWISE USE DELIMITER MODE
PUSHJ PP,SETLFC ;SETUP LITERAL OR FIG. CONST.
POPJ PP, ;ERRORS, RETURN
MOVEI TA,.SRHLN ;;NEED SMALL FIXED-LENGTH TEMTAB ENTRY
PUSHJ PP,TLNKSR
HRRZ TA,CURSRE ;;MAKE TA POINT TO THE ENTRY
ADD TA,TEMLOC
;STORE BSI.SOURCE
HRRZ TE,EMODEA ;;WILL BE = BSI.DEST
DPB TE,BSI.SR
;DON'T ALLOW "ALL 'LITERAL' "
HRRZ TC,M.ARG2 ;FIND OPERAND AGAIN
ADD TC,EOPLOC
MOVE TE,0(TC)
TLNE TE,GNALL ;"ALL" SPECIFIED?
PUSHJ PP,[MOVEM TC,CUREOP ;YES, POINT TO LITERAL
MOVEI DW,E.273 ;"Improper use of ALL"
PUSHJ PP,OPNFAT ;GIVE ERROR
SWOFF FERROR ;TURN OFF ERROR FLAG
POPJ PP,] ;AND GO CATCH SOME MORE IF WE CAN
;GEN BP AND CC
MOVE TA,[^D36,,AS.MSC] ;SETUP "A" TO POINT TO THE LITERAL
MOVEM TA,EBASEA
HRRZM EACC,EINCRA
PUSHJ PP,GTLBPC ;GET TE= PTR TO 2-WORD LITERAL
;STORE PTR TO THE BP AND CC IN THE SOURCE TEMTAB ENTRY
HRRZ TA,CURSRE
ADD TA,TEMLOC ;TA POINTS TO ENTRY
DPB TE,SPT.SR ;STORE %LIT PTR.
; JRST STRG30 ;ALL DONE WITH THIS SOURCE
;HERE WHEN DONE PROCESSING A SOURCE.. BUMP PTR AND LOOP FOR THE REST.
STRG30: SOSG M.ARG1 ;DONE WITH SOURCES?
JRST STRG40 ;YES
HRRZ TC,M.ARG2 ;NO, CALL BMPEOP TO GET TO NEXT ONE
ADD TC,EOPLOC
HRRM TC,CUREOP
PUSHJ PP,BMPEOP
$CERR ;?? CANT HAPPEN
HRRZ TE,CUREOP
HRRZ TD,EOPLOC
SUBI TE,(TD) ;GET TE: = REL LOC OF NEXT OPERAND
MOVEM TE,M.ARG2 ;REMEMBER IT
JRST STRG10 ;GO DO NEXT SOURCE
;HERE WHEN DONE PROCESSING THIS STRING-SERIES
STRG40: MOVE TE,STSENX ;AFTER -1+W1
HRRZ TD,EOPLOC
ADD TE,TD ;GET TE= ABS POINTER TO START OF NEXT SS
JRST STRG6 ;GO PROCESS NEXT SS
;HERE WHEN ALL STRING-SERIES HAVE BEEN PROCESSED.
STRG77: SKIPN NSTRSE ;THERE MUST BE AT LEAST ONE STRING-SERIES..
$CERR ; NO, THIS IS IMPOSSIBLE (PROBABLY PHASE D BUG)
;** ALL ARGS ARE NOW SETUP IN TEMTAB **
;NOW WE CAN START GENERATING ROUTINES.
; USE M.ARG1 AS A FLAG. = 0 UNTIL JUMP HAS BEEN GENERATED AROUND THE
;; %TAGS. THEN IT IS AS.TAG+N FOR THE PLACE TO GO.
SETZM M.ARG1 ;NO JUMP GENERATED YET
;DO THE POINTER ITEM
HLRZ CH,STPTO ;ANY POINTER ITEM?
JUMPE CH,STRG80 ;JUMP IF NONE
PUSHJ PP,PUTJMP ;PUT JRST OVER ROUTINE (WILL BE NECESSARY)
HLRZ CH,STPTO ;GET TAG FOR THE ROUTINE
HRRZ TA,CH ;GET IN TA ALSO
PUSHJ PP,REFTAG ;REFERENCE IT SO /O DOESN'T DELETE IT
PUSHJ PP,PUTTAG ;PUT IT OUT
;GEN A MOVE FROM PT.VAL TO THE POINTER ITEM.
; WE WILL SET UP POINTER ITEM AS "B".
HRRZ TC,STPTO ;GET OFFSET INTO TEMTAB OF THE OPERAND
ADD TC,TEMLOC
PUSHJ PP,CPYOPP ;COPY OP TO TEMP AREA
HRRM TC,CUREOP ;SETUP CUREOP TO POINT TO IT
HRRM TC,OPERND
PUSHJ PP,SETOPB ;SET IT UP AS "B" OPERAND
PUSHJ PP,FAKPTV ;FAKE AN "A" OPERAND TO BE PT.VAL
PUSHJ PP,MXX. ;MOVE "A" TO "B"
TSWF FERROR ;IF ERRORS,
POPJ PP, ;GIVE UP
PUSHJ PP,PUTPPJ ;GENERATE "POPJ" TO FINISH THE ROUTINE
; JRST STRG80 ;DONE WITH POINTER
;HERE WHEN DONE WITH POINTER
;LOOK AT EACH SS TO DO DELIMITER AND SOURCES
STRG80: HRRZ TA,STSETP ;START WITH FIRST SS
;HERE WITH TA:= REL ADDRESS IN TEMTAB OF NEXT SS ENTRY TO DO
STRG81: MOVEM TA,CURSSE ;CURSSE WILL POINT TO CURRENT SS ENTRY
ADD TA,TEMLOC
LDB CH,TAG.DL ;IS THERE A %TAG TO DELIMITER?
JUMPE CH,STRG85 ; JUMP IF NO
;PUT OUT DELIMITER CODE
PUSH PP,CH
PUSHJ PP,PUTJMP ;PUT JRST OVER ROUTINE (IF NECESSARY)
POP PP,CH ;RESTORE OUR TAG
HRRZ TA,CH ;REFERENCE TAG
PUSHJ PP,REFTAG
PUSHJ PP,PUTTAG ;AND PUT IT OUT
HRRZ TA,CURSSE ;MAKE TA POINT TO CURRENT ENTRY
ADD TA,TEMLOC ; AGAIN
LDB TD,BSI.DL ;GET BSI OF DELIMITER
MOVEM TD,M.ARG3 ; PUT IN ARG3 FOR A LITTLE WHILE
MOVX TD,SS%DNM ;WAS DELIMITER NUMERIC?
TDZN TD,.SSFLG(TA)
JRST STRG83 ;NO
;FALL -- DELIMITER WAS NUMERIC
;STILL IN STRG81 ROUTINE.. GENERATING CODE FOR NUMERIC DELIMITER
;GEN CODE TO MOVE IT TO TMP.DL.
HRRZ TC,CURSSE ;PREPARE TO POINT TO OPERAND
ADD TC,TEMLOC
ADDI TC,.SSOPR
PUSHJ PP,CPYOPP ;COPY OPERAND TO SAFE PLACE
HRRM TC,CUREOP ;POINT TO IT
HRLM TC,OPERND ;SET IT UP AS "A"
HRRZ TC,CUREOP ;TC POINTS TO OPERAND FOR "SETOPA"
PUSHJ PP,SETOPA ;IF ERRORS, RETURNS TO PHASE E DRIVER
;SETUP "B" AS TMP.DL
MOVE TE,[^D36,,TMP.DL##]
MOVEM TE,EBASEB
SETZM EINCRB
SWON FBNUM ;THIS TEMP IS NUMERIC! (LEADING 0'S)
SWOFF FBSUB!FBSIGN ;NOT SUBSCRIPTED, OR SIGNED
HRRZ TE,M.ARG3 ;MODE
HRRZM TE,EMODEB
HRRZ TE,ESIZEA ;SAME SIZE AS "A"
HRRZM TE,ESIZEB
SETZM EDPLB ;NO DECIMAL PLACES (S.B. NONE IN "A" EITHER!)
SETZM ETABLB
SETZM EFLAGB
SETZM EBYTEB
PUSHJ PP,MXX. ;GENERATE MOVE
TSWF FERROR ;IF ERRORS,
POPJ PP, ;QUIT
;NOW CODE HAS BEEN GENERATED TO MOVE THE DELIMITER TO THE NUMERIC TEMP.
; WE STILL MUST GENERATE THE STORE OF THE BP AND CC, THEN THIS
;GENERATED SUBROUTINE WILL BE COMPLETE.
;STILL IN STRG81 ROUTINE.. GENERATING CODE FOR NUMERIC DELIMITER
;STORE BP AND CC
MOVE TA,[BYTLIT,,2] ;FIRST MAKE LITERAL BP TO THE ITEM
PUSHJ PP,STASHP
MOVEI TA,TMP.DL## ;POINTING TO TMP.DL
PUSHJ PP,STASHQ
MOVSI TA,440000 ;PARTIAL BYTE PTR
HRRZ TC,EMODEB
MOVE TC,BYTE.S(TC) ;BITS/BYTE
DPB TC,[POINT 6,TA,11] ;STORE IN BP
PUSHJ PP,POOLIT ;PUT OUT REST OF BP AND POOL IT
SKIPE PLITPC ;SKIP IF IT WASN'T POOLED
JRST .+3 ;WAS--GET PLITPC
HRRZ TE,ELITPC ;GET PC
AOSA ELITPC ;BUMP IT AND SKIP
HRRZ TE,PLITPC ; WAS POOLED
IORI TE,AS.LIT ;POINTER TO LITERAL IN TE
MOVE CH,[MOV+AC0+ASINC,,AS.MSC]
PUSHJ PP,PUTASY
HRRZ CH,TE
PUSHJ PP,PUTASN ;GENERATE MOVE 0,[POINTER TO TMP.DL]
MOVE CH,[MOVEM.+AC0,,DLM.BP##]
PUSHJ PP,PUT.EX
;GENERATE STORE OF CC
HRRZ CH,ESIZEB
MOVEM CH,ESIZEA ;PUT SIZE IN "ESIZEA" FOR GTCCA
PUSHJ PP,GTCCA ;GENERATE "MOVEI AC7,SIZE"
MOVE CH,[MOVEM.+AC7,,DLM.CC##]
PUSHJ PP,PUT.EX ;"MOVEM AC7,DLM.CC"
JRST STRG84 ;DONE, GO GEN "POPJ"
;NON-NUMERIC DELIMITER. JUST STORE CC AND BP.
STRG83: HRRZ TC,CURSSE ;PREPARE TO POINT TO OPERAND
ADD TC,TEMLOC
ADDI TC,.SSOPR
PUSHJ PP,CPYOPP ;MOVE OPERAND TO SAFE PLACE
HRRM TC,CUREOP
HRLM TC,OPERND ;FOR NB1PAR
PUSHJ PP,SETOPA ;SET IT UP AS "A"
; (ERRORS RETURN TO PHASE E DRIVER)
PUSHJ PP,NB1PAR ;GET BP TO "A" IN AC5
TSWF FERROR ;IF ERRORS,
POPJ PP, ;GIVE UP
;GEN CODE TO STORE BP: "MOVEM AC5,DLM.BP"
MOVE CH,[MOVEM.+AC5,,DLM.BP##]
PUSHJ PP,PUT.EX
;GEN CODE TO STORE CC
PUSHJ PP,DEPTSA ;DOES IT HAVE A DEPENDING VARIABLE?
JRST STRG86 ;NO, GENERATE "MOVEI" TO GET SIZE
MOVEI TE,7 ;USE AC7 TO GET SIZE
SETZM SAVPR0 ;DON'T HAVE TO SAVE %PARAM
PUSHJ PP,SZDPVA ;GET SIZE IN RUNTIME AC7
$CERR ;??ERRORS
JRST STRG87 ;SKIP OVER "MOVEI"
STRG86: PUSHJ PP,GTCCA ;GENERATE "MOVEI AC7,SIZE"
;NOW SIZE IS IN AC7, MOVE IT TO DLM.CC
STRG87: MOVE CH,[MOVEM.+AC7,,DLM.CC##]
PUSHJ PP,PUT.EX
STRG84: PUSHJ PP,PUTPPJ ;POPJ TO END ROUTINE
;HERE TO LOOK AT SOURCES
STRG85: HRRZ TA,CURSSE ;;GET LINK TO SOURCE ENTRIES
ADD TA,TEMLOC
SKIPN TA,.SSLKS(TA) ;GET LINK TO FIRST SOURCE ENTRY
$CERR ;??NOT SET UP
;HERE WITH TA POINTING TO NEXT SOURCE LINK.
; STORE IT IN CURSRE
STRG88: MOVEM TA,CURSRE ;STORE "CURRENT SOURCE ENTRY"
ADD TA,TEMLOC ;GET PTR TO IT
LDB CH,TAG.SR ;%TAG GENERATED?
JUMPE CH,STRG89 ;JUMP IF NO
;PUT OUT A ROUTINE FOR SOURCE ITEM
PUSH PP,CH
PUSHJ PP,PUTJMP ;PUT JRST OVER ROUTINE (IF NECESSARY)
POP PP,CH ;RESTORE OUR TAG
HRRZ TA,CH ;REFERENCE TAG
PUSHJ PP,REFTAG
PUSHJ PP,PUTTAG ;PUT IT OUT
HRRZ TA,CURSRE ;MAKE TA POINT TO CURRENT ENTRY
ADD TA,TEMLOC
LDB TD,BSI.SR ;GET BSI OF SOURCE
MOVEM TD,M.ARG3 ;PUT IN ARG3 FOR A LITTLE WHILE
MOVX TD,SR%SRN ;WAS SOURCE NUMERIC?
TDZN TD,.SRFLG(TA)
JRST STR88B ;NO
; FALL INTO CODE TO HANDLE NUMERIC SOURCE
;STILL IN STRG88 ROUTINE.. GENERATING CODE FOR NUMERIC SOURCE
;GEN CODE TO MOVE IT TO SR.TMP.
HRRZ TC,CURSRE ;POINT TO THE OPERAND
ADD TC,TEMLOC
ADDI TC,.SROPR
PUSHJ PP,CPYOPP ;MOVE OPERAND TO A SAFE PLACE
HRRM TC,CUREOP ;TC AND CUREOP POINT TO THE OPERAND
HRLM TC,OPERND ;FOR SUBSCA
PUSHJ PP,SETOPA ;SET IT UP AS "A"
;SETUP "B" AS SR.TMP
MOVE TE,[^D36,,SR.TMP##]
MOVEM TE,EBASEB
SETZM EINCRB
SWON FBNUM ;NUMERIC TEMP
SWOFF FBSUB!FBSIGN ;NOT SUBSCRIPTED, OR SIGNED
HRRZ TE,M.ARG3 ;MODE
HRRZM TE,EMODEB
HRRZ TE,ESIZEA ;SAME SIZE AS "A"
HRRZM TE,ESIZEB
SETZM EDPLB ;NO DECIMAL PLACES
SETZM ETABLB ;ALL OTHER THINGS ZERO
SETZM EBYTEB
SETZM EFLAGB
PUSHJ PP,MXX. ;GENERATE MOVE
TSWF FERROR ;IF ERRORS,
POPJ PP, ;QUIT
;STILL IN STRG88 ROUTINE.. GENERATING CODE FOR NUMERIC SOURCE
;STORE BP AND CC
MOVE TA,[BYTLIT,,2]
PUSHJ PP,STASHP
MOVEI TA,SR.TMP## ;POINTER TO SR.TMP
PUSHJ PP,STASHQ
MOVSI TA,440000 ;BUILD REST OF BYTE PTR
HRRZ TC,EMODEB
MOVE TC,BYTE.S(TC) ;BITS/BYTE
DPB TC,[POINT 6,TA,11]
PUSHJ PP,POOLIT ;PUT OUT REST OF BP
SKIPE PLITPC ;WAS IT POOLED?
JRST .+3 ;YES
HRRZ TE,ELITPC ;NO, GET WHERE IT IS
AOSA ELITPC ;BUMP PC AND SKIP
HRRZ TE,PLITPC ;POOLED--GET PC
IORI TE,AS.LIT ;POINTER TO LITERAL IN TE
MOVE CH,[MOV+AC0+ASINC,,AS.MSC]
PUSHJ PP,PUTASY
HRRZ CH,TE
PUSHJ PP,PUTASN ;GENERATE MOVE 0,[POINTER TO SR.TMP]
MOVE CH,[MOVEM.+AC0,,SRC.BP##]
PUSHJ PP,PUT.EX
;GENERATE STORE OF CC
HRRZ CH,ESIZEB ;HERE IT IS
HRRZM CH,ESIZEA ;STORE IN ESIZEA FOR GTCCA
PUSHJ PP,GTCCA ;"MOVEI AC7,SIZE"
MOVE CH,[MOVEM.+AC7,,SRC.CC##]
PUSHJ PP,PUT.EX
JRST STR88E ;GO PUT OUT THE "POPJ" TO END THE ROUTINE
;HERE FOR NON-NUMERIC SOURCE.
STR88B: HRRZ TC,CURSRE
ADD TC,TEMLOC
ADDI TC,.SROPR
PUSHJ PP,CPYOPP ;COPY OPERAND TO A SAFE PLACE
HRRM TC,CUREOP ;TC AND CUREOP POINT TO THE OPERAND
HRLM TC,OPERND ;FOR NB1PAR
PUSHJ PP,SETOPA ;SET OPERAND AS "A"
; (IF ERRORS, RETURNS TO PHASE E DRIVER)
HRRZ TA,ETABLA ;[1365] GET ASSOCIATED DATA ITEM
LDB TE,LNKCOD ;[1365]
CAIE TE,TB.DAT ;[1365] IS IT IN DATAB?
JRST STR8BB ;[1365] NO,CONT
PUSHJ PP,LNKSET ;[1365] YES
LDB TE,DA.EDT ;[1365] IS IT EDITED?
JUMPE TE,STR8BB ;[1365] NO
LDB TE,DA.EXS ;[1365] YES,
MOVEM TE,ESIZEA ;[1365] USE EXTERNAL SIZE
STR8BB: ;[1365]
;STORE BP
PUSHJ PP,NB1PAR ;GET BP IN AC5
TSWF FERROR
POPJ PP, ;IF ERRORS, RETURN
MOVE CH,[MOVEM.+AC5,,SRC.BP##]
PUSHJ PP,PUT.EX
;STORE CC
PUSHJ PP,DEPTSA ;DOES IT HAVE A DEPENDING ITEM?
JRST STR88C ;NO, USE "MOVEI"
MOVEI TE,7 ;USE AC7
SETZM SAVPR0 ;DON'T SAVE %PARAM
PUSHJ PP,SZDPVA ;GET SIZE IN RUNTIME AC7
$CERR ;?ERRORS
JRST STR88D ;SKIP OVER "MOVEI"
STR88C: PUSHJ PP,GTCCA ;GEN "MOVEI AC7,SIZE"
;NOW SIZE OF SOURCE IS IN AC7
STR88D: MOVE CH,[MOVEM.+AC7,,SRC.CC##]
PUSHJ PP,PUT.EX ;STORE IN CC
;GEN "POPJ" TO END THE ROUTINE
STR88E: PUSHJ PP,PUTPPJ
; JRST STRG89 ;DONE WITH THE SOURCE ITEM
;HERE WHEN DONE A SOURCE ITEM. GO ON TO THE NEXT ONE IF THERE ARE ANY
STRG89: HRRZ TA,CURSRE
ADD TA,TEMLOC
SKIPE TA,.SRLNK(TA) ;ANOTHER ONE?
JRST STRG88 ;YES, GO PROCESS IT
;HERE WHEN DONE ALL SOURCE ITEMS FOR THIS SS. GO ON TO NEXT SS
; (IF THERE ARE ANY).
STR89A: HRRZ TA,CURSSE
ADD TA,TEMLOC
SKIPN TA,.SSLNK(TA) ;ANOTHER ONE?
JRST STR89B ;NO
JRST STRG81 ;YES, GO PROCESS IT
;HERE WHEN DONE GENERATING ALL ROUTINES.
; GENERATE %TAG IF NECESSARY TO START OFF STRING STMT.
STR89B: SKIPE CH,M.ARG1 ;"JRST" GENERATED?
PUSHJ PP,PUTTAG ;YES, GENERATE %TAG:
;GENERATE THE ARG LIST IN THE LITERALS
STRG90: HRRZ TE,ELITPC ;SET M.ARG4 TO POINT TO START OF
HRRZM TE,M.ARG4 ; LITERALS INCASE WE DON'T POOL
;FIRST WORD OF ARG LIST: XWD -N,,FLAGS
; WHERE N= NUMBER OF SOURCE-SERIES
MOVE TA,[XWDLIT,,2]
PUSHJ PP,STASHP
MOVN TA,NSTRSE ;-# SOURCE-SERIES
HRLE TA,TA ;PUT IN LH
HRRI TA,AS.CNB ; LARGE CONSTANT
PUSHJ PP,STASHQ
HRL TA,STFLGS ;FLAGS IN RH (STFLGS)
HRRI TA,AS.CNB
PUSHJ PP,STASHQ ;PUT OUT RH OF XWD
AOS ELITPC
;2ND WORD OF ARG LIST: BSI.DEST
MOVE TA,[XWDLIT,,2]
PUSHJ PP,STASHP
SETZ TA, ;LH= 0
PUSHJ PP,STASHQ
HRRZ TA,SDSTIN ;BSI OF DEST IS IN RH (SDSTIN)
PUSHJ PP,STASHQ
AOS ELITPC
;3RD WORD OF ARG LIST: (OPTIONALLY, IF POINTER ITEM GIVEN):
; %TAG TO ROUTINE THAT STORES THE POINTER ITEM VALUE.
SKIPN STPTO ;SKIP IF POINTER ITEM GIVEN
JRST STRG92 ; NO POINTER ITEM, DON'T WRITE 3RD WORD
MOVE TA,[XWDLIT,,2]
PUSHJ PP,STASHP
SETZ TA,
PUSHJ PP,STASHQ
HLRZ TA,STPTO ;AS.TAG+N
PUSHJ PP,STASHQ ;NOTE: TAG REFERENCE MADE EARLIER
AOS ELITPC
;START WRITING SS ENTRIES
STRG92: MOVE TA,STSETP ;POINT TO FIRST SS ENTRY
STRG93: MOVEM TA,CURSSE ;SAVE PTR TO CURRENT SS
;FIRST WORD - OCT M (# OF SOURCES)
ADD TA,TEMLOC
LDB TE,NUM.SR ;GET # SOURCES
MOVEM TE,M.ARG3 ;;SAVE HERE FOR A SECOND
MOVE TA,[OCTLIT,,1]
PUSHJ PP,STASHP
HRRZ TA,M.ARG3
PUSHJ PP,STASHQ
AOS ELITPC
;NOW DELIMITER INFO.. FLAG+BSI.DEL,,%LIT00 OR 0
MOVE TA,[XWDLIT,,2]
PUSHJ PP,STASHP
MOVE TA,CURSSE
ADD TA,TEMLOC
MOVE TE,.SSFLG(TA) ;GET THE WORD TO WRITE OUT
MOVEM TE,M.ARG3 ;SAVE FOR A SEC..
HLLZ TA,TE ;COPY LH = FLAGS & BSI.DEL
HRRI TA,AS.CNB
PUSHJ PP,STASHQ ;OUTPUT IT
HRLZ TA,M.ARG3 ;COPY RH = %LIT00 PTR
SKIPE TA ;UNLESS IT'S 0
HRRI TA,AS.MSC ;; SAY "MISC" ENTRY
PUSHJ PP,STASHQ ;OUTPUT THAT
AOS ELITPC
;MORE DELIMITER INFO.. %TAG OR 0
MOVE TA,CURSSE
ADD TA,TEMLOC
LDB TE,TAG.DL ;GET TAG FOR DELIMITER
JUMPE TE,STRG94 ;JUMP IF NONE
MOVEM TE,M.ARG3 ;SAVE TAG FOR A SEC.
MOVE TA,[XWDLIT,,2]
PUSHJ PP,STASHP ;WRITE AS AN XWD 0,%TAG
SETZ TA,
PUSHJ PP,STASHQ
HRRZ TA,M.ARG3
PUSHJ PP,STASHQ
JRST STRG95 ;SKIP OVER "NO TAG" CODE
STRG94: MOVE TA,[OCTLIT,,1] ;NO TAG, SO STORE "OCT 0"
PUSHJ PP,STASHP
SETZ TA,
PUSHJ PP,STASHQ
STRG95: AOS ELITPC
;NOW LOOP FOR SOURCES, WRITING OUT THE TWO WORDS FOR EACH:
; FLAGS+BSI.SOURCE,,%LIT OR 0
; %TAG OR 0
HRRZ TA,CURSSE
ADD TA,TEMLOC
LDB TE,NUM.SR ;GET # SOURCES
MOVEM TE,M.ARG2 ;M.ARG2= # SOURCES LEFT TO LOOK AT
SKIPN TA,.SSLKS(TA) ;GET LINK TO FIRST SOURCE
$CERR ;?? NONE, DIE
;HERE WITH TA POINTING TO THE NEXT SOURCE ENTRY
STRG96: MOVEM TA,CURSRE ;SAVE CURRENT SOURCE ENTRY
ADD TA,TEMLOC
MOVE TE,.SRFLG(TA) ;GET FLAG WORD
MOVEM TE,M.ARG3 ;SAVE HERE (IT WILL BE WRITTEN OUT)
MOVE TA,[XWDLIT,,2]
PUSHJ PP,STASHP
HLLZ TA,M.ARG3 ;GET LH
HRRI TA,AS.CNB
PUSHJ PP,STASHQ ;WRITE IT OUT
HRLZ TA,M.ARG3 ;%LIT PTR
SKIPE TA ;UNLESS IT'S 0
HRRI TA,AS.MSC ; SAY "MISC" ENTRY
PUSHJ PP,STASHQ ;OUTPUT THAT
AOS ELITPC
;WRITE %TAG OR 0 FOR SOURCE ENTRY
HRRZ TA,CURSRE
ADD TA,TEMLOC
LDB TE,TAG.SR
JUMPE TE,STRG97 ;JUMP IF NO SOURCE TAG
MOVEM TE,M.ARG3 ;SAVE IT FOR A SEC
MOVE TA,[XWDLIT,,2]
PUSHJ PP,STASHP ;WRITE AS AN XWD 0,%TAG
SETZ TA,
PUSHJ PP,STASHQ
HRRZ TA,M.ARG3
PUSHJ PP,STASHQ
JRST STR97A ;SKIP OVER "NO TAG" CODE
STRG97: MOVE TA,[OCTLIT,,1] ;NO TAG, WRITE "OCT 0"
PUSHJ PP,STASHP
SETZ TA,
PUSHJ PP,STASHQ
STR97A: AOS ELITPC
;HERE WHEN DONE WITH THIS SOURCE
HRRZ TA,CURSRE
ADD TA,TEMLOC
SOSG M.ARG2 ;ANY MORE SOURCES?
JRST STRG98 ;NO
SKIPN TA,.SRLNK(TA) ;GET LINK TO NEXT SOURCE ENTRY
$CERR ;?? IT WASN'T SET UP.. COMPLAIN
JRST STRG96 ;GO PROCESS IT
;NO MORE SOURCES -- MAKE SURE NO MORE LINKS
STRG98: SKIPE .SRLNK(TA) ;BETTER BE NO MORE LINKS
$CERR ;ELSE ?COMPILER ERROR
;GO ON TO NEXT SS ENTRY, IF THERE ARE MORE
HRRZ TA,CURSSE
ADD TA,TEMLOC
SKIPE TA,.SSLNK(TA) ;SKIP IF NO MORE
JRST STRG93 ;ELSE GO BACK WITH TA POINTING TO IT
;ALL DONE GENERATING ARG LIST
PUSHJ PP,POOL ;POOL IT IF WE CAN...!
;GENERATE "MOVEI 16,ARG.LIST"
; "PUSHJ 17,STR. OR STR.O"
SKIPN TE,PLITPC ;DID WE POOL?
HRRZ TE,M.ARG4 ;NO, GET STARTING LITERAL
MOVEM TE,LITNN ;STORE ADDRESS OF ARGS
SKIPE PLITPC ;DID WE POOL?
JRST [HRRZ TE,M.ARG4 ;YES, RESTORE START OF LITERALS
MOVEM TE,ELITPC
JRST .+1]
MOVEI TA,%STR.## ;GENERATE "MOVEI" AND "PUSHJ"
TLNE W1,(GWFL9) ; "WITH OVERFLOW" CLAUSE?
MOVEI TA,%STR.O## ;YES, CALL OTHER ROUTINE
PJRST CSEQGN ;RETURN FROM STRING CODE GEN
;COPYOP -- ROUTINE TO COPY OPERAND TO TEMTAB ENTRY
;CALL:
; TA POINTS TO TEMTAB ENTRY
; TB POINTS TO OPERAND IN EOPTAB
; TD IS # OF WORDS TO TRANSFER
; PUSHJ PP,COPYOP
; <RETURN HERE>
; USES TA,TB
COPYOP: HRL TA,TB ;FROM,,TO
HRRZ TB,TA
ADDI TB,-1(TD)
BLT TA,(TB) ;COPY THE WORDS
POPJ PP, ;AND RETURN
;CPYOPP -- ROUTINE TO COPY OPERAND FROM TEMTAB ENTRY
; TO TEMP AREA (GUARDS AGAINST TABLES EXPANDING)
;CALL:
; TC POINTS TO OPERAND IN TEMTAB
; PUSHJ PP,CPYOPP
; <RETURN HERE>
;RETURNS:
; TC/ STRSAV
; STRSAV/ THE OPERAND
; USES:
; TA,TB,TD,TE
CPYOPP: MOVE TE,1(TC) ;FIND # SUBSCRIPTS
LDB TD,TESUBC
LSH TD,1
ADDI TD,2 ;TD= # WORDS IN OPERAND TO COPY
MOVEI TA,STRSAV ;COPY TO HERE
MOVE TB,TC ;FROM HERE
MOVEI TC,STRSAV ;POINT TO HERE WHEN YOU RETURN
PJRST COPYOP ;COPY OPERAND AND RETURN
;GTCCA - ROUTINE TO GENERATE A MOVEI OF THE CHARACTER COUNT
; IN ESIZEA
;CALL: ESIZEA/ THE LENGTH
; PUSHJ PP,GTCCA
; <RETURN HERE AFTER GENERATING THE "MOVEI 7,CHAR-COUNT"
GTCCA: HRRZ CH,ESIZEA ;GET SIZE
CAILE CH,77777
JRST [HRLI CH,MOVEI.+AC7
PJRST PUTASY] ;GENEREATE MOVEI AND RETURN
;IT WAS A LARGE CONSTANT.. HAVE TO PUT 2 WORDS IN ASY FILE
MOVE CH,[MOVEI.+AC7+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
HRRZ CH,ESIZEA
PJRST PUTASN ;FINISH INSTRUCTION AND RETURN
;TLNKSS - GET AN SS ENTRY AND PUT IN LINKED LIST.
;CALL: TA/ # OF WORDS IN TEMTAB TO GET
; PUSHJ PP,TLNKSS
; <RETURN HERE>
;INPUT:
; STSETP/ POINTS TO FIRST SS ENTRY, OR 0
; CURSSE/ POINTER TO PREVIOUS ENTRY, UNLESS C(STSETP)= 0
;RETURNS:
; TEMTAB ENTRY GENERATED, AND ZEROED
; STSETP SET UP IF IT WAS 0
; LINK SET UP IN PREVIOUS ENTRY TO POINT TO THIS ONE
; CURSSE SET UP TO POINT TO THIS ENTRY
;ACS USED: TA-TE
TLNKSS: PUSH PP,TA ;SAVE # WORDS
PUSHJ PP,GETTEM ;GET (TA) LOCS IN TEMTAB
;NOW TA= REL LOC
;LINK TO LAST ENTRY
SKIPN STSETP ;IS THIS 1ST SS?
JRST STRTSS ;YES
HRRZ TB,CURSSE ; NO, LINK LAST ONE TO THIS ONE
ADD TB,TEMLOC
MOVEM TA,.SSLNK(TB) ;LAST ENTRY'S LINK POINTS TO THIS ONE
TRNA ;LEAVE INITIAL PTR ALONE
STRTSS: MOVEM TA,STSETP ;1ST ARG--SETUP INITIAL POINTER
MOVEM TA,CURSSE ;MAKE THIS ENTRY THE CURRENT ONE
;ZERO OUT THIS TEMTAB ENTRY
POP PP,TD ;TD:= # WORDS TO CLEAR
ADD TA,TEMLOC ;TA POINTS TO FIRST WORD
SETZM (TA) ;CLEAR FIRST WORD
HRL TA,TA ;MAKE START LOC,,START LOC
HRRZ TB,TA
ADDI TB,-1(TD) ;END LOC
ADDI TA,1 ;START LOC,,START LOC+1
BLT TA,(TB) ;CLEAR OUT TEMTAB ENTRY
POPJ PP, ;DONE, RETURN
;TLNKSR - GET A SOURCE ENTRY AND PUT IN LINKED LIST.
;CALL: TA/ # WORDS IN TEMTAB TO GET
; PUSHJ PP,TLNKSR
; <RETURN HERE>
;INPUT:
; CURSSE/ POINTS TO CURRENT SS ENTRY
; CURSRE/ POINTS TO PREVIOUS SOURCE ENTRY OR 0
;RETURNS:
; TEMTAB ENTRY GENERATED AND ZEROED
; LINK IN SS ENTRY SET UP IF IT WAS 0
; CURSRE SET UP TO POINT TO THIS ENTRY
;ACS USED: TA-TE
TLNKSR: PUSH PP,TA ;SAVE # WORDS TO GET
PUSHJ PP,GETTEM ;GET C(TA) WORDS IN TEMTAB
; NOW TA:= REL LOC
;LINK TO LAST ENTRY
HRRZ TB,CURSSE
ADD TB,TEMLOC
SKIPN .SSLKS(TB) ;SOURCE LINK SETUP?
JRST STRTSR ;NO, SETUP 1ST ONE
HRRZ TB,CURSRE ;LINK LAST ONE TO THIS ONE
ADD TB,TEMLOC
MOVEM TA,.SRLNK(TB)
TRNA ;SKIP SET OF INITIAL PTR
STRTSR: MOVEM TA,.SSLKS(TB) ;1ST SOURCE--SETUP INITIAL PTR IN SS ENTRY
MOVEM TA,CURSRE ;MAKE THIS ENTRY THE CURRENT SOURCE
;ZERO OUT THIS TEMTAB ENTRY
POP PP,TD ;TD:= # WORDS TO CLEAR
ADD TA,TEMLOC ;TA POINTS TO FIRST WORD
SETZM (TA) ;CLEAR FIRST WORD
HRL TA,TA ;START LOC,,START LOC
HRRZ TB,TA
ADDI TB,-1(TD) ;TB:= END LOC
ADDI TA,1 ;TA:= BLT PTR
BLT TA,(TB) ;CLEAR OUT TEMTAB ENTRY
POPJ PP, ;DONE, RETURN
;SETUP DELIMITER OR SOURCE IF LIT OR FIG. CONST.
;CALL: CUREOP POINTS TO OPERAND
; EACA/ MODE TO PUT ITEM IN (D6MODE, D7MODE, OR D9MODE)
; PUSHJ PP,SETLFC
;
;RETURNS:
; +1 IF ERRORS
; +2 IF OK WITH LITERAL PUT IN LITAB
; EACC POINTING TO THE LITERAL
; EMODEA = MODE
; ESIZEA = CC
SETLFC: HRRZ TA,CUREOP
MOVE TC,0(TA) ;LOOK AT OPERAND FLAGS
TLNN TC,GNLIT ;BETTER BE LIT OR FIG CONST.
$CERR ; ELSE WE SHOULDN'T HAVE BEEN CALLED!
TLNN TC,GNFIGC ;FIG CONST.?
JRST SETLFL ;NO, LITERAL
;THE ANS68 COMPILER CONVERTS FIG. CONSTS TO 1-CHAR LITERALS IN PHASE C
; WHEN COMPILING THE "STRING" STATEMENT.
; BUT THIS CODE SHOULD PROBABLY BE LEFT IN FOR ANS68 ANYWAY
; INCASE SOMEDAY THAT CHANGES.
TLNN TC,GNFCS!GNFCZ!GNFCQ!GNFCHV!GNFCLV
JRST BADLIT ;? FUNNY KIND OF LITERAL.. PARSE ERROR (?)
; GET THE APPROPRIATE CHARACTER IN THE
;MODE OF THE DESTINATION
TLNE TC,GNFCS ;SPACE
HRRZ EACC,IFSPCS(EACA)
TLNE TC,GNFCZ ;ZERO
HRRZ EACC,IFZROS(EACA)
TLNE TC,GNFCQ ;QUOTE
HRRZ EACC,HIVQOT(EACA)
TLNE TC,GNFCLV ;LOW-VALUES
MOVEI EACC,0
TLNE TC,GNFCHV ;HIGH-VALUES
HLRZ EACC,HIVQOT(EACA)
IFN ANS74,<
SKIPLE COLSEQ ;[1004] PROGRAM COLLATING SEQUENCE = ALPHABET-NAME?
TLNN TC,GNFCLV!GNFCHV ;AND LOW-VALUES OR HIGH-VALUES
JRST SETLF2 ;NO, HAVE CORRECT CHAR IN EACC
TLNE TC,GNFCHV ;HIGH-VALUES?
MOVE EACC,COHVLV(EACA) ;GET HIGH-VALUES CHARACTER
TLNE TC,GNFCLV ;LOW-VALUES?
MOVE EACC,COHVLV+3(EACA) ;GET LOW-VALUES CHARACTER
>;END IFN ANS74
;HERE WITH CHARACTER OF THE FIG. CONST IN EACC
;SETUP LITERAL TO BE 1-CHAR.
SETLF2: MOVEI TE,1 ;1-CHAR
MOVEM TE,ESIZEZ
HRL TA,D.LTCD(EACA) ;GET LITAB CODE
HRRI TA,1 ;ONE WORD LITERAL
PUSHJ PP,STASHP
SETZ TA,
DPB EACC,[POINT 6,TA,5
POINT 7,TA,6
POINT 9,TA,8](EACA)
PUSHJ PP,POOLIT
SKIPN EACC,PLITPC
MOVE EACC,ELITPC
SKIPN PLITPC
AOS ELITPC
IORI EACC,AS.LIT ;FINISH SETTING UP EACC
MOVEI TE,1 ;SET ESIZEA TO 1
MOVEM TE,ESIZEA
MOVEM EACA,EMODEA ;SET EMODEA TO MODE OF THE ITEM
JRST CPOPJ1 ;GIVE OK RETURN
;SUBROUTINE SETLFL (CONT'D)
;HERE IF WE GOT A LITERAL
SETLFL: HRRZM EACA,EMODEB ;SAVE MODE TO COERCE LITERAL INTO FOR LITD.
MOVE TC,CUREOP ;HAVE A LITERAL, CALL SETOPN
MOVEI LN,EBASEA
PUSHJ PP,SETOPN
TSWF FERROR
POPJ PP, ;IF ERRORS, TAKE THE ERROR RETURN
HRRZ EACA,EMODEB ;GET MODE
JUMPN EACA,SETL1A ;JUMP IF NOT SIXBIT
;CHECK LITERAL FOR ASCII CHARACTERS. IF THERE ARE SOME, IT MUST
; BE CREATED AS AN ASCII LITERAL.
MOVE TA,EBYTEA ;GET BP TO LITERAL
HRRZ TC,ESIZEA ;GET SIZE OF LITERAL
SETL1B: ILDB TE,TA ;GET NEXT CHARACTER OF LITERAL
CAIL TE,40 ;IS CHARACTER CONVERTIBLE TO SIXBIT?
CAILE TE,137
JRST [MOVEI EACA,D7MODE ;NO, USE ASCII
HRRM EACA,EMODEB
JRST SETL1A]
SOJG TC,SETL1B ;LOOP FOR ALL CHARACTERS
SETL1A: MOVE TD,ESIZEA ;COPY SIZE TO B
MOVEM TD,ESIZEB ;SET UP FOR LITD. CALL
MOVEM TD,ESIZEZ
SETZM LITERR ;INCASE ERRORS CONVERTING
PUSHJ PP,LITD.0 ;MAKE THE LITERAL, NO IMMEDIATE MODE
TSWF FERROR
POPJ PP, ;ERRORS
SKIPE LITERR ; IF CONVERSION ERRORS,
$CERR ;?WE SHOULD HAVE PREVENTED THIS
HRRZ EACC,EINCRA ;%LIT00+N
HRRZ TE,EMODEB
HRRM TE,EMODEA ;SET MODE OF ITEM
JRST CPOPJ1
BADLIT: MOVEI DW,E.123 ;"1-CHAR NON-NUM LITERAL EXPECTED"
JRST OPNFAT
;ROUTINE TO STORE BP AND CC OF ITEM IN "A" IN THE LITERAL TABLE.
;CALL:
; "A" SET UP, NOT SUBSCRIPTED, NO DEPENDING VARIABLES
; PUSHJ PP,GTLBPC
; <RETURNS HERE>
;ON RETURN,
; TE/ %LITNN+M (POINTER TO THE 2-WORD LITERAL)
GTLBPC: PUSH PP,ELITPC ;SAVE LITERAL PC NOW
MOVE TA,[BYTLIT,,2] ; PREPARE TO WRITE BP
PUSHJ PP,STASHP
HRRZ TA,EBASEA
PUSHJ PP,STASHQ
HLRZ TA,ERESA
ROT TA,-6 ;GET DD0000,,0 FOR RESIDUE
HRRZ TC,EMODEA
MOVE TC,BYTE.S(TC) ;BITS/BYTE
DPB TC,[POINT 6,TA,11] ;STORE IN BP
HRR TA,EINCRA ;GET INCREMENT IF ANY
PUSHJ PP,STASHQ ;FINISH BP
AOS ELITPC
;NOW CC
MOVE TA,[OCTLIT,,1]
PUSHJ PP,STASHP
;IF EDITED, USE EXTERNAL SIZE
HRRZ TA,ETABLA
LDB TE,LNKCOD## ;MAKE SURE ITS A DATAB
CAIE TE,TB.DAT##
JRST GTLBP1 ;ITS NOT, LEAVE AS IS
PUSHJ PP,LNKSET
LDB TE,DA.EDT ;EDITED?
JUMPE TE,GTLBP1 ;NO
LDB TE,DA.EXS ;YES, GET EXTERNAL SIZE
MOVEM TE,ESIZEA ; USE THAT FOR THE SIZE
GTLBP1: HRRZ TA,ESIZEA
PUSHJ PP,POOLIT ;POOL THE TWO-WORD CHUNK
AOS ELITPC
POP PP,TE ;GET OLD LITERAL PC
SKIPN PLITPC ;DID WE POOL?
JRST .+3 ;NO, TE POINTS TO THE LITERAL
MOVEM TE,ELITPC ;WE DID, RESTORE LITERAL PC
MOVE TE,PLITPC ; GET TE= WHERE WE STORED IT
IORI TE,AS.LIT ;MAKE TE LOOK LIKE A LITERAL ADDRESS
POPJ PP, ;DONE, RETURN
;PUTJMP - ROUTINE TO GET A TAG AND GENERATE "JRST %TAG"
;; AND STORE AS.TAG+N IN M.ARG1
;HOWEVER IF THERE IS ALREADY SOMETHING IN M.ARG1
; IT JUST POPJ'S.
PUTJMP: SKIPE M.ARG1 ;DID IT ALREADY?
POPJ PP, ;YES, RETURN
PUSHJ PP,GETTAG ;NO, GET A TAG
MOVEM CH,M.ARG1 ;SAVE IT
HRLI CH,JRST. ;GENERATE "JRST" TO IT
PUSHJ PP,PUTASY ;WRITE INSTRUCTION
HRRZ TA,CH
PJRST REFTAG ;REFERENCE THE TAG AND RETURN
;GEN "POPJ 17," TO END ROUTINE
PUTPPJ: MOVSI CH,POPJ.+AC17
PJRST PUTASY ;WRITE OUT THE POPJ
;FAKPTV - FAKE "PT.VAL" AS "A" OPERAND
; "B" IS ASSUMED TO BE SETUP WITH THE POINTER OPERAND TO MOVE IT TO.
FAKPTV: MOVE TE,[^D36,,PT.VAL##]
JRST FAK1WC ;GO TO COMMON CODE
;FAKTLV - FAKE "TL.VAL" AS "A" OPERAND
; SAME AS FAKPTV EXCEPT A DIFFERENT EXT. LOC.
FAKTLV: MOVE TE,[^D36,,TL.VAL##]
JRST FAK1WC ;GO TO COMMON CODE
;FAKCTV - FAKE "CT.VAL" AS "A" OPERAND
FAKCTV: MOVE TE,[^D36,,CT.VAL##]
FAK1WC: MOVEM TE,EBASEA
SWOFF FASIGN!FASUB ;NOT SUBSCRIPTED OR SIGNED
SWON FANUM ;BUT NUMERIC
SETZM EINCRA
MOVEI TE,D1MODE
MOVEM TE,EMODEA
SETZM EFLAGA
SETZM EDPLA
SETZM ETABLA
SETZM EBYTEA
HRRZ TE,ESIZEB ;SAME SIZE
CAILE TE,^D10 ;UNLESS > 10.
MOVEI TE,^D10 ; IN WHICH CASE, WE WILL TRUNCATE TO 10
HRRZM TE,ESIZEA
POPJ PP, ;DONE,RETURN
SUBTTL GENERATE AN "UNSTRING"
;MORE EXTERNAL LOCS IN IMPURE, USED ONLY BY "UNSTRING"
EXTERN UNSNMF,USENII,UNSFLG,UNSTLY
EXTERN UNSDLE,CURDE,CURUS
;DEFINITIONS FOR "UNSTRING"
;LOCATION UNSDLE POINTS TO THE FIRST DELIMITER ENTRY IN TEMTAB (0 IF NONE)
; EACH DELIMITER-ENTRY HAS THE FOLLOWING FORMAT:
; +0/ LINK TO NEXT DELIMITER-ENTRY, OR 0 IF THIS IS THE LAST
; +1/ FLAGS+BSI.DEL,,%LIT OR 0
; +2/ %TAG OR 0
; +3-17/ OPERAND (IF NECESSARY TO STORE IT)
;DEL-E DEFS
.DELNK==0
.DEFLG==1
DE%NUM==1B0 ;DELIMITER IS NUMERIC
DE%ALL==1B1 ;"ALL" SPECIFIED
.DETAG==2
BSI.DE: POINT 3,.DEFLG(TA),17 ;BSI OF DELIMITER ITEM
DPL.DL: POINT 18,.DEFLG(TA),35 ;POINTER TO %LIT FOR DELIMITER
DE.TAG: POINT 18,.DETAG(TA),35 ;TAG OF ROUTINE TO CALL TO SETUP %TEMP
.DEOPR==3 ;PTR TO OPERAND, IF IT WAS STORED
.DEHLN==4 ;LENGTH OF DE ENTRY
;LOCATION STSETP POINTS TO THE FIRST UNSTRING-SERIES ENTRY.
;
;EACH UNSTRING-SERIES ENTRY HAS THE FOLLOWING FORMAT:
; +0/ LINK TO NEXT UNSTRING-SERIES ENTRY, OR 0
; +1/ FLAGS+BSI.SR,,%LIT ;SOURCE
; +2/ %TAG1,,%TAG2 ;TAG1 SETS UP %TEMP, TAG2 STORES DELIM AWAY
; ; FROM OU.TMP
; +3/ PTR TO SOURCE OPERAND OR 0
; +4/ FLAGS+BSI.DS,,%LIT ;DELIMITER STORE
; +5/ %TAG1,,%TAG2 ;TAG1 SETS UP %TEMP, TAG2 STORES DELSTORE AWAY
; ; FROM OU.TMP
; +6/ PTR TO DELSTORE OPERAND OR 0
; +7/ %TAG ;IF COUNT ITEM PRESENT, ROUTINE TO STORE IT
; ; FROM CT.VAL.
; +8/ PTR TO COUNT ITEM OPERAND OR 0
.USLNK==0 ;LINK TO NEXT UNSTRING-SERIES ENTRY
.USFLG==1 ;FLAG WORD
US%NUR==1B0 ;NUMERIC RECEIVING ITEM
US%RRJ==1B1 ;RECEIVING ITEM IS RIGHT-JUSTIFIED
US%GDS==1B2 ;GOT A DELIMITER-STORE OPERAND
US%GCT==1B3 ;GOT A COUNT ITEM
BSI.UR: POINT 3,.USFLG(TA),17 ;BSI OF UNSTRING RECEIVING ITEM
DPL.UR: POINT 18,.USFLG(TA),35 ;POINTER TO %TEMP OR %LIT OR 0
.USRTG==2 ;RECEIVING TAG
TAG.UR: POINT 18,.USRTG(TA),17 ;TAG TO SETUP %TEMP WITH BP AND CC
TAG.OR: POINT 18,.USRTG(TA),35 ;TAG TO STORE DELIM AWAY IF NUMERIC
.USPTR==3 ;POINTER TO RECEIVING ITEM OPERAND, OR 0
.USDSF==4 ;DELIMITER STORE FLAG WORD
DS%NUM==1B0 ;DELIMITER STORE IS NUMERIC
DS%JST==1B1 ;DELIMITER STORE IS RIGHT-JUSTIFIED (SET IF NUMERIC,TOO)
BSI.DS: POINT 3,.USDSF(TA),17 ;BSI OF DELIMITER-STORE
UPT.DS: POINT 18,.USDSF(TA),35 ;%LIT POINTER
.USDTG==5 ;TAGS FOR DELIMITER-STORE
TAG.DT: POINT 18,.USDTG(TA),17 ;TAG TO SETUP %TEMP WITH BP AND CC
TAG.SD: POINT 18,.USDTG(TA),35 ;TAG TO STORE DELIM AWAY IF NUMERIC
.USPTD==6 ;POINTER TO DELIM STORE OPERAND OR 0
.USCTT==7 ;TAG FOR COUNT ITEM
TAG.CT: POINT 18,.USCTT(TA),35 ;TAG TO STORE COUNT ITEM
.USPTC==10 ;PTR TO COUNT OPERAND OR 0
.USHLN==11 ;LENGTH OF UNSTRING-SERIES ENTRY
COMMENT \
GENFIL FOR AN UNSTRING LOOKS LIKE:
DELIMITER ITEM 1 (OPTIONAL)
UDELIM OPERATOR (OPTIONAL - NOT PRESENT IF DELIMITER ITEM 1 ISN'T)
DELIMITER ITEM 2 (OPTIONAL)
UDELIM OPERATOR (OPTIONAL - NOT ...)
...
DELIMITER ITEM I (OPTIONAL)
UDELIM OPERATOR (OPTIONAL - NOT ...)
RECEIVING ITEM 1
RECEIVING ITEM 1 DELIMITER (OPTIONAL)
COUNT ITEM 1 (OPTIONAL)
UNSDES OPERATOR (WITH FLAG 9 ON IF RECEIVING ITEM 1 DELIMITER IS
PRESENT AND FLAG 10 ON IF COUNT ITEM 1 IS PRESENT)
RECEIVING ITEM 2
RECEIVING ITEM 2 DELIMITER (OPTIONAL)
COUNT ITEM 2 (OPTIONAL)
UNSDES OPERATOR (WITH ...)
...
RECEIVING ITEM J
RECEIVING ITEM J DELIMITER (OPTIONAL)
COUNT ITEM J (OPTIONAL)
UNSDES OPERATOR (WITH ...)
SENDING ITEM
POINTER ITEM (OPTIONAL)
TALLYING ITEM (OPTIONAL)
UNSTR OPERATOR (WITH FLAG 10 ON IF POINTER ITEM IS PRESENT AND
FLAG 11 ON IF TALLYING ITEM IS PRESENT)
\
;ARRIVE HERE ON A UDELIM OPERATOR OR AN UNSDES OPERATOR
;ADDITIONAL FOLLOWING OPERATORS MUST BE FORCIBLY READ IN
;THE SEQUENCE IS: [UDELIM]...UNSDES[UNSDES]...UNSTR
UNSGEN: SETZM ARGCTR## ;INIT DELIMITER COUNT
IFN FT68274,<
HRLOI TB,377777 ;LOAD WITH LARGEST POSITIVE NO.
MOVEM TB,CVTSAL##
>
HRRZ TB,EOPLOC ;SAVE ADDR OF FIRST OPERAND
ADDI TB,1 ; IN CASE UNSDES OPERATOR
MOVEM TB,ARGSTR##
CAIN W2,UNSDES ;NO UDELIM'S?
JRST UNSG1 ;NONE
UNSG0: MOVE W2,W1 ;STORE [-1 + W1] ON EOPTAB
SETO W1, ; TO MARK UDELIM OPERATOR
PUSHJ PP,PUSH12
AOS ARGCTR ;COUNT THIS DELIMITER
HRRZ TB,EOPNXT ;SAVE ADDR OF NEXT EOPTAB ENTRY
ADDI TB,1 ; IN CASE UNSDES OPERATOR
MOVEM TB,ARGSTR##
PUSHJ PP,READEM ;READ NEXT OPERAND+OPERATOR SET
CAIN W2,UDELIM ;ANOTHER UDELIM? OR UNSDES?
JRST UNSG0 ;UDELIM
UNSG1: CAIE W2,UNSDES ;WAS IT REALLY A UNSDES?
POPJ PP, ;NO, FORGET THE WHOLE THING, THE
; ERROR MESSAGE SHOULD HAVE BEEN
; GENERATED BY THE SYNTAX SCAN.
HRLZS ARGCTR ;MOVE DELIM CT TO LH, INIT DEST CT IN RH
UNSG2: LDB TB,[POINT 2,W1,10] ;GET DEL-STORE & COUNTER-ITEM FLAGS
PUSHJ PP,FIXOPS ;IF NOT BOTH PRESENT, STORE %TEMP PTRS
MOVE W2,W1 ;STORE [-1 + W1] ON EOPTAB
SETOI W1, ; TO MARK UNSDES OPERATOR
PUSHJ PP,PUSH12
AOS ARGCTR ;COUNT THIS DESTINATION, DEL-STORE & COUNTER
HRRZ TB,EOPNXT ;SAVE ADDR OF NEXT EOPTAB ENTRY
ADDI TB,1 ; IN CASE UNSTR OPERATOR
MOVEM TB,ARGSTR##
PUSHJ PP,READEM ;READ NEXT OPERAND+OPERATOR SET
CAIN W2,UNSDES ;ANOTHER UNSDES? OR UNSTR?
JRST UNSG2 ;UNSDES
CAIE W2,UNSTR ;WAS IT REALLY AN UNSTR?
POPJ PP, ;NO, FORGET THE WHOLE THING, THE
; ERROR MESSAGE SHOULD HAVE BEEN
; GENERATED BY THE SYNTAX SCAN.
LDB TB,[POINT 2,W1,11] ;GET POINTER & TALLY-ITEM FLAGS
PUSHJ PP,FIXOPS ;IF NOT BOTH, STORE %TEMP PTRS
COMMENT \
ALL OF THE OPERANDS AND OPERATORS FOR THE UNSTRING HAVE BEEN READ IN.
EOPTAB NOW LOOKS LIKE:
DELIMITER ITEM 1 (OPTIONAL)
[-1 + W1] (OPTIONAL - NOT PRESENT IF DELIMITER ITEM 1 ISN'T)
DELIMITER ITEM 2 (OPTIONAL)
[-1 + W1] (OPTIONAL - NOT ...)
...
DELIMITER ITEM I (OPTIONAL)
[-1 + W1] (OPTIONAL - NOT ...)
RECEIVING ITEM 1
RECEIVING ITEM 1 DELIMITER (OR [-2 + 0] IF THERE WAS NO
RECEIVING ITEM 1 DELIMITER)
COUNT ITEM 1 (OR [-2 + 0] IF THERE WAS NO COUNT ITEM 1)
[-1 + W1]
RECEIVING ITEM 2
RECEIVING ITEM 2 DELIMITER (OR [-2 + 0] IF ...)
COUNT ITEM 2 (OR [-2 + 0] IF ...)
[-1 + W1]
...
RECEIVING ITEM J
RECEIVING ITEM J DELIMITER (OR [-2 + 0] IF ...)
COUNT ITEM J (OR [-2 + 0] IF ...)
[-1 + W1]
SENDING ITEM
POINTER ITEM (OR [-2 + 0] IF THERE WAS NO POINTER ITEM.)
TALLYING ITEM (OR [-2 + 0] IF THERE WAS NO TALLYING ITEM)
\
SETZM STSETP ;CLEAR POINTER TO INTO ITEMS
SETZM UNSDLE ;CLEAR POINTER TO DELIMITER ENTRIES
SETZM UNSFLG ;CLEAR UNSTRING FLAGS
MOVE TE,TEMLOC ;CLEAR OUT TEMTAB
AOBJN TE,.+1
MOVEM TE,TEMNXT
;BUILD POINTER TO SENDING ITEM
;ARGSTR NOW POINTS TO THE SENDING ITEM
HRRZ TC,ARGSTR
HRRZM TC,CUREOP
HRLM TC,OPERND ;FOR SUBSCA AND NB1PAR
PUSHJ PP,SETOPA ;SET IT UP AS "A"
; (ERRORS RETURN TO PHASE E DRIVER)
;THE SENDING ITEM MUST BE A DATANAME
SETZM UNSNMF ;ASSUME IT'S NOT NUMERIC
TSWF FANUM ; IS IT NUMERIC?
SETOM UNSNMF ;YES
;CAN BE NUMERIC, BUT MUST BE AN INTEGER
HRRZ TE,EMODEA
CAIE TE,FPMODE
SKIPE EDPLA
JRST STRE6 ;'MUST REPRESENT AN INTEGER'
;IF EDITED, USE EXTERNAL SIZE
HRRZ TA,ETABLA
PUSHJ PP,LNKSET
LDB TE,DA.EDT ;EDITED?
JUMPE TE,UNSG2C ;NO
LDB TE,DA.EXS ;YES, GET EXTERNAL SIZE
MOVEM TE,ESIZEA ; USE THAT FOR THE SIZE
;GENERATE CODE TO SETUP BP IN SRC.BP, CC IN SRC.CC
; IF NUMERIC, GENERATE CODE TO MOVE IT TO SR.TMP
UNSG2C: SKIPN UNSNMF ;SKIP IF NUMERIC
JRST UNSG3 ;NO, ALPHANUMERIC
HRRZ TE,EMODEA ;GET MODE OF "A" NOW
CAIG TE,DSMODE ; IF ALREADY SOME KIND OF DISPLAY,
JRST UNSG2B ;USE THAT SAME MODE
;LET'S MAKE IT ALL ASCII. (THEN ALL LITERALS WILL WORK)
MOVEI TE,D7MODE ;GET ASCII MODE
UNSG2B: HRRM TE,USENII ;STORE IN MODE
MOVEM TE,EMODEB ;STORE IN "B"
;SET UP "B" TO BE SR.TMP
HRRZ TE,ESIZEA ;SAME SIZE AS "A"
MOVEM TE,ESIZEB
MOVE TE,[^D36,,SR.TMP##]
MOVEM TE,EBASEB
SETZM EINCRB
SETZM EDPLB
SETZM ETABLB
SETZM EFLAGB
SETZM ETABLB
SWON FBNUM ;A NUMERIC TEMP
SWOFF FBSUB!FBSIGN ;NOT SUBSCRIPTED, OR SIGNED
PUSHJ PP,MXX. ;GENERATE THE MOVE
TSWF FERROR ; IF ERRORS,
POPJ PP, ;DIE
;GEN CODE TO STORE BP AND CC
;FIRST CC. NO DEPENDING VARIABLES, BECAUSE IT IS NUMERIC
HRRZ CH,ESIZEB ;GET SIZE
HRRZM CH,ESIZEA ;STORE IN ESIZEA FOR GTCCA
PUSHJ PP,GTCCA ;GEN "MOVEI AC7,SIZE"
MOVE CH,[MOVEM.+AC7,,SRC.CC##]
PUSHJ PP,PUT.EX
;NOW BP
UNSG2A: MOVE TA,[BYTLIT,,2] ;FIRST MAKE LITERAL BP TO THE ITEM
PUSHJ PP,STASHP
MOVEI TA,SR.TMP## ;POINTING TO SR.TMP
PUSHJ PP,STASHQ
MOVSI TA,440000 ;PARTIAL BYTE PTR
HRRZ TB,EMODEB ;GET MODE OF ITEM
MOVE TB,BYTE.S(TB) ;BITS/BYTE
DPB TB,[POINT 6,TA,11]
PUSHJ PP,POOLIT ;PUT OUT REST OF BP AND POOL IT
SKIPE PLITPC ;SKIP IF NOT POOLED
JRST .+3 ;WAS--GET PLITPC
HRRZ TE,ELITPC ;NO, GET ELITPC
AOSA ELITPC ;BUMP IT AND SKIP
HRRZ TE,PLITPC ;(WAS POOLED)
IORI TE,AS.LIT ;POINTER TO LITERAL IN TE
MOVE CH,[MOV+AC0+ASINC,,AS.MSC]
PUSHJ PP,PUTASY
HRRZ CH,TE
PUSHJ PP,PUTASN ;GENERATE "MOVE 0,[POINTER TO SR.TMP]"
MOVE CH,[MOVEM.+AC0,,SRC.BP##]
PUSHJ PP,PUT.EX
JRST UNSG4 ;DONE WITH SENDING ITEM
;HERE IF SENDING ITEM IS NON-NUMERIC
UNSG3: HRRZ TE,EMODEA ;MUST BE SOME KIND OF DISPLAY
CAILE TE,DSMODE ; MAKE A SANITY CHECK...
$CERR ;OOPS--INSANITY
HRRZM TE,USENII ;REMEMBER MODE
;GEN CODE TO STORE BP AND CC
PUSHJ PP,NB1PAR ;GET BP TO "A" IN AC5
TSWF FERROR ; ANY ERRORS?
POPJ PP, ;YES, GIVE UP
;TO STORE BP: "MOVEM AC5,SRC.BP"
MOVE CH,[MOVEM.+AC5,,SRC.BP##]
PUSHJ PP,PUT.EX
;STORE CC
PUSHJ PP,DEPTSA ;DOES "A" HAVE A DEPENDING ITEM?
JRST UNSG3A ;NO, GENERATE "MOVEI" TO GET SIZE
MOVEI TE,7 ;USE AC7 TO GET SIZE
SETZM SAVPR0 ;DON'T SAVE %PARAM
PUSHJ PP,SZDPVA ;GET SIZE IN RUNTIME AC7
$CERR ;?? ERRORS
JRST UNSG3B ;SKIP OVER "MOVEI"
UNSG3A: PUSHJ PP,GTCCA ;GEN "MOVEI AC7,SIZE"
;NOW SIZE IS IN AC7, MOVE IT TO SRC.CC
UNSG3B: MOVE CH,[MOVEM.+AC7,,SRC.CC##]
PUSHJ PP,PUT.EX
;HERE WHEN DONE WITH SENDING ITEM
UNSG4: HRRZ TE,ESIZEA ;STORE MAX SIZE IN LH (USENII)
HRLM TE,USENII
;GO ON TO THE POINTER ITEM
HRRZ TC,ARGSTR ;POINTER TO SENDING ITEM
HRRZM TC,CUREOP ; CALL BMPEOP TO FIND START OF NEXT
PUSHJ PP,BMPEOP ;OPERAND.. THE "POINTER" ITEM
$CERR ;? MUST BE THERE (-2,,0) STORED
;MAKE ARGSTR POINT TO REL ADDRESS OF THE POINTER ITEM
HRRZ TD,EOPLOC ;START
HRRZ TE,CUREOP
SUBI TE,(TD)
MOVEM TE,ARGSTR
HRRZ TE,CUREOP ;NEW CUREOP (POINTS TO POINTER ITEM)
MOVE TD,(TE) ;GET 1ST WORD
CAMN TD,[-2] ; -2 MEANS NO POINTER ITEM
JRST UNSG5 ;GO GEN CODE TO STORE 1 TO PT.VAL
;THERE WAS A POINTER ITEM. CUREOP NOW POINTS TO IT.
HRRZ TC,CUREOP ;POINTER IN TC FOR SETOPA
MOVE TD,(TC)
TLNN TD,GNLIT!GNFIGC
JRST UNSG4A ;NOT LIT OR FIG CONST.. OK
IFN ANS74, $CERR ;?SYNTAX SCAN SHOULD CATCH THIS
IFN ANS68,< ;COULD BE TALLY
TLNE TD,GNFIGC ;FIG. CONST?
TLNN TD,GNTALY ;YES, IS IT TALLY?
$CERR ;NO, RANDOM FIG. CONST. OR LITERAL
>
;HERE WITH TC POINTING TO THE "POINTER" ITEM
UNSG4A: PUSHJ PP,SETOPA ;SET IT UP AS "A"
; (ERRORS RETURN TO PHASE E DRIVER)
TSWF FANUM ;POINTER MUST BE NUMERIC
SKIPE EDPLA ; AND CAN'T HAVE DECIMAL PLACES
JRST STRE2
HRRZ TE,EMODEA ;DISALLOW FLOATING-POINT
CAIN TE,FPMODE
JRST STRE2
PUSHJ PP,STRGT3 ;GIVE ERROR IF THE "POINTER" ITEM IS EDITED
PUSHJ PP,STRGT4 ;SEE IF SIZE IS BIG ENOUGH
;REMEMBER THERE WAS A POINTER ITEM
UNSG4B: MOVEI TE,1B18 ;"POINTER ITEM"
IORM TE,UNSFLG ; SET IT IN THE FLAGS
;GET ALL SUBSCRIPTS INTO %TEMP, SO THEY WON'T BE AFFECTED BY THE STATEMENT.
SETOM ONLYEX
SETOM ALSTMP
HRRZ TC,CUREOP ;SUBSCA DOESN'T BELIEVE CUREOP,
HRLM TC,OPERND ; WE HAVE TO PUT IT HERE.
PUSHJ PP,SUBSCA ;GEN SUBSCRIPT CODE IF NECESSARY
SETZM ONLYEX
SETZM ALSTMP
TSWF FERROR ;IF ERRORS,
POPJ PP, ;GIVE UP
; COPY OPERAND TO TEMTAB SO WE CAN GET IT LATER
HRRZ TE,ARGSTR ;REL ADDR OF POINTER ITEM
ADD TE,EOPLOC ;GET ABS LOC OF OPERAND
HRRZ TC,TE
MOVE TE,1(TC) ;HOW MANY SUBSCRIPTS AND STUFF TO FOLLOW?
LDB TA,TESUBC
LSH TA,1
ADDI TA,2 ;TOTAL # WORDS TO COPY
PUSH PP,TA ;SAVE #
PUSHJ PP,GETTEM ; GET THE WORDS IN TEMTAB
HRRZ TB,TA ;TA RETURNED BY GETTEM,
; = REL LOC OF ENTRY IN TEMTAB
HRRM TA,STPTO ;REMEMBER WHERE IT IS STORED
ADD TA,TEMLOC ;MAKE TA BE ABS LOC
;COPY OPERAND TO TEMTAB
POP PP,TD ;TD:= # WORDS TO COPY
HRRZ TB,ARGSTR ; START OF OPERAND IN EOPTAB
ADD TB,EOPLOC
PUSHJ PP,COPYOP ;COPY IT..
;POINTER ITEM'S OPERAND IS NOW IN TEMTAB.
; NOW RH (STPTO) = REL ADDRESS IN TEMTAB OF THE OPERAND
; LH (STPTO) = UNDEFINED
;NOW GENERATE CODE TO PUT INITIAL VALUE OF POINTER INTO PT.VAL
SWON FBSIGN!FBNUM ;SET UP "B" AS PT.VAL
SWOFF FBSUB
MOVE TE,[^D36,,PT.VAL##]
MOVEM TE,EBASEB
SETZM EINCRB
MOVEI TE,D1MODE ;1-WORD COMP
MOVEM TE,EMODEB
SETZM EFLAGB
SETZM ETABLB
SETZM EBYTEB
SETZM EDPLB
HRRZ TE,ESIZEA ;SAME SIZE
CAILE TE,^D10 ;UNLESS > 10
MOVEI TE,^D10 ; IN WHICH CASE, WE WILL TRUNCATE TO 10
HRRZM TE,ESIZEB
PUSHJ PP,MXX. ;MOVE "A" TO PT.VAL
TSWF FERROR
POPJ PP, ;DIE IF ERRORS
;GET A TAG WHICH WILL BE ADDRESS OF ROUTINE TO CALL TO STORE THE
; NEW POINTER VALUE. THE CODE FOR THIS ROUTINE WILL BE GENERATED LATER.
PUSHJ PP,GETTAG
HRLM CH,STPTO ;STORE TAG IN LH (STPTO)
;NOW RH (STPTO) = REL ADDRESS IN TEMTAB OF POINTER ITEM OPERAND
; LH (STPTO) = TAG OF ROUTINE TO CALL TO STORE POINTER VALUE.
JRST UNSG6 ;DONE WITH POINTER ITEM (FOR NOW)
;HERE IF THERE WAS NO POINTER ITEM.. GEN CODE TO
; STORE VALUE OF 1 IN PT.VAL
UNSG5: SETZM STPTO ;CLEAR "POINTER" INFO
MOVE CH,[MOVEI.+AC0,,1]
PUSHJ PP,PUTASY ;"MOVEI 0,1"
MOVE CH,[MOVEM.+AC0,,PT.VAL##]
PUSHJ PP,PUT.EX ;"MOVEM 0,PT.VAL"
;HERE WHEN DONE WITH POINTER ITEM.
; GEN CODE FOR THE TALLYING ITEM
UNSG6: HRRZ TE,ARGSTR ;GET PTR TO "POINTER" ITEM
ADD TE,EOPLOC
HRRM TE,CUREOP ;READY TO CALL BMPEOP
PUSHJ PP,BMPEOP
$CERR ;?MUST BE THERE (-2,,0) STORED
HRRZ TE,CUREOP ;NEW CUREOP (POINTS TO TALLYING ITEM)
MOVE TD,(TE) ;GET 1ST WORD
CAMN TD,[-2] ;-2 MEANS NO TALLYING ITEM
JRST UNSG7 ;GO GEN CODE TO PUT 0 IN TL.VAL
;MAKE ARGSTR POINT TO REL ADDRESS OF THE "TALLYING" ITEM
HRRZ TD,EOPLOC
SUBI TE,(TD)
MOVEM TE,ARGSTR
;THERE WAS A TALLYING ITEM. CUREOP NOW POINTS TO IT.
HRRZ TC,CUREOP ;POINTER IN TC FOR SETOPA
MOVE TD,(TC)
TLNN TD,GNLIT!GNFIGC
JRST UNSG6A ;NOT LIT OR FIG CONST.. OK
IFN ANS74, $CERR ;?SYNTAX SCAN SHOULD CATCH THIS
IFN ANS68,< ;COULD BE TALLY
TLNE TD,GNFIGC ;FIG. CONST?
TLNN TD,GNTALY ;YES, IS IT TALLY?
$CERR ;NO, RANDOM FIG. CONST. OR LITERAL
>
;HERE WITH TC POINTING TO THE TALLYING ITEM
UNSG6A: PUSHJ PP,SETOPA ;SET IT UP AS "A"
; (ERRORS RETURN TO PHASE E DRIVER)
TSWF FANUM ;MUST BE NUMERIC
SKIPE EDPLA ; AND CAN'T HAVE ANY DECIMAL PLACES
JRST STRE2
HRRZ TA,EMODEA
CAIN TA,FPMODE ;CAN'T BE COMP-1
JRST STRE2
PUSHJ PP,STRGT3 ;GIVE ERROR IF THE "TALLYING" ITEM IS EDITED
PUSHJ PP,STRGT4 ;MAKE SURE TALLYING ITEM IS BIG ENOUGH
;REMEMBER THERE WAS A TALLYING ITEM
UNSG6B: MOVEI TE,1B19 ;"TALLYING ITEM"
IORM TE,UNSFLG ; SET IT IN THE FLAGS
;GET ALL SUBSCRIPTS INTO %TEMP SO THEY WON'T BE AFFECTED BY THE
; STRING STATEMENT
SETOM ONLYEX
SETOM ALSTMP
HRRZ TC,CUREOP
HRLM TC,OPERND ;PUT WHERE SUBSCA NEEDS IT
PUSHJ PP,SUBSCA
SETZM ONLYEX
SETZM ALSTMP
TSWF FERROR
POPJ PP, ;ERRORS, RETURN
;COPY OPERAND TO TEMTAB SO WE CAN GET IT LATER
HRRZ TE,ARGSTR
ADD TE,EOPLOC ;GET ABS LOC OF OPERAND
HRRZ TC,TE
MOVE TE,1(TC) ;FIND # WORDS TO COPY
LDB TA,TESUBC
LSH TA,1
ADDI TA,2
PUSH PP,TA ;SAVE THE #
PUSHJ PP,GETTEM ; GET THE SPACE IN TEMTAB
HRRZ TB,TA ;REL ADDR
HRRM TA,UNSTLY ; REMEMBER WHERE THE TALLYING OPERAND IS
ADD TA,TEMLOC ;TA: = PTR TO TEMTAB ENTRY
;COPY OPERAND
POP PP,TD ;TD:= # WORDS TO COPY
HRRZ TB,ARGSTR ;GET START OF OPERAND AGAIN
ADD TB,EOPLOC ; INCASE IT GOT MOVED BY GETTEM
PUSHJ PP,COPYOP ;COPY IT..
;TALLYING ITEM'S OPERAND IS NOW IN TEMTAB.
; NOW LH (UNSTLY) = UNDEFINED
; RH (UNSTLY) = REL ADDR IN TEMTAB OF THE TALLYING OPERAND
;NOW GENERATE CODE TO PUT INITIAL VALUE OF TALLYING ITEM IN TL.VAL
SWON FBNUM!FBSIGN ;TL.VAL IS SIGNED AND NUMERIC
SWOFF FBSUB ;NOT SUBSCRIPTED
MOVE TB,[^D36,,TL.VAL##]
MOVEM TB,EBASEB
SETZM EINCRB
MOVEI TE,D1MODE ;1-WORD COMP
MOVEM TE,EMODEB
SETZM EFLAGB
SETZM EDPLB
SETZM EBYTEB
SETZM ETABLB
HRRZ TE,ESIZEA ;SAME SIZE AS "A"
CAILE TE,^D10 ;UNLESS TOO BIG
MOVEI TE,^D10
HRRZM TE,ESIZEB
PUSHJ PP,MXX. ;MOVE "A" TO "B"
TSWF FERROR
POPJ PP, ;GIVE UP IF ERRORS
;GET A TAG WHICH WILL BE ADDRESS OF ROUTINE TO CALL TO STORE
; NEW TALLYING VALUE IN THE TALLY ITEM. CODE GENERATED LATER ON..
PUSHJ PP,GETTAG
HRLM CH,UNSTLY
;NOW LH (UNSTLY) = TAG
; RH (UNSTLY) = ADDR IN TEMTAB OF OPERAND
JRST UNSG8 ;DONE WITH TALLYING ITEM (FOR NOW)
;NO TALLYING ITEM.. GEN CODE TO MOVE 0 TO TL.VAL
UNSG7: MOVE CH,[SETZM.,,TL.VAL##]
PUSHJ PP,PUT.EX
SETZM UNSTLY ;CLEAR TALLY INFO
;HERE WHEN DONE WITH TALLYING ITEM
; DO THE DELIMITERS
UNSG8: MOVEI TE,1 ;AIM AT FIRST DELIMITER
MOVEM TE,ARGSTR ;OR NEXT OPERAND, IF NO DELIMITERS
HLRZ TE,ARGCTR ;GET # DELIMITERS
MOVEM TE,M.ARG1 ;M.ARG1= # DELIMITERS LEFT TO DO
JUMPE TE,UNSG20 ;JUMP IF NO DELIMITERS TO DO
;HERE WITH ARGSTR POINTING AT THE NEXT DELIMITER (REL ADDR IN EOPTAB)
UNSG9: HRRZ TE,ARGSTR
ADD TE,EOPLOC ;MAKE ABS ADDR
HRRM TE,CUREOP ;SETUP CUREOP
HRLM TE,OPERND ;AND OPERND
HRRZ TC,TE ;GET READY TO CALL SETOPA
MOVE TD,(TC) ;GET 1ST WORD OF OPERAND
TLNE TD,GNLIT!GNFIGC ;LITERAL OR FIG. CONST?
JRST UNSG12 ;YES
PUSHJ PP,SETOPA ; PUT DELIMITER IN "A"
; (RETURNS TO PHASE E DRIVER IF ERRORS)
;SET UP ANOTHER DELIMITER ENTRY
PUSHJ PP,TLNKDE ;LINK ANOTHER DELIMITER ENTRY
TSWT FANUM ;SKIP IF NUMERIC DELIMITER
JRST UNSG11 ;NON-NUMERIC
;IF NUMERIC, THE DELIMITER MUST REPRESENT AN INTEGER
HRRZ TE,EMODEA
CAIE TE,FPMODE
SKIPE EDPLA
JRST STRE6
;SET "DELIMITER IS NUMERIC" FLAG
HRRZ TA,CURDE ;CURRENT DELIMITER ENTRY
ADD TA,TEMLOC ;GET ABS ADDRESS
MOVX TE,DE%NUM ;"DELIMITER IS NUMERIC"
IORM TE,.DEFLG(TA) ;SET FLAG IN DE ENTRY
;STORE BSI (WHICH WILL BE THE BSI OF THE SENDING ITEM)
HRRZ TE,USENII
DPB TE,BSI.DE
;IF SUBSCRIPTED, WE WILL HAVE TO COPY THE OPERAND.
TSWT FASUB ;SUBSCRIPTED?
JRST UNSG10 ;NO, PUT BP AND CC IN %LIT
HRRZ TC,CUREOP ;THE DELIMITER OPERAND
MOVE TE,1(TC) ;HOW MANY SUBSCRIPTS?
LDB TA,TESUBC
LSH TA,1
ADDI TA,2
PUSH PP,TA ;SAVE # WORDS
PUSHJ PP,GETTEM ;GET WORDS IN TEMTAB
HRRZ TE,TA ;GET REL POINTER
;SET UP LINK IN DE ENTRY
HRRZ TD,CURDE
ADD TD,TEMLOC
MOVEM TA,.DEOPR(TD)
;COPY THE OPERAND
ADD TA,TEMLOC ;TA POINTS TO TEMTAB ENTRY
HRRZ TB,ARGSTR ;FIND DELIMITER OPERAND AGAIN
ADD TB,EOPLOC ; (GETTEM MAY HAVE MOVED IT)
POP PP,TD ;TD:= # WORDS TO MOVE
PUSHJ PP,COPYOP ;COPY IT..
;HERE WHEN DONE COPYING THE OPERAND AND SETTING UP THE LINK TO IT
;IF SUBSCRIPTED, BP AND CC WILL GO IN %TEMP.
MOVEI TE,2 ;GET 2 WORDS IN %TEMP
PUSHJ PP,GETEMP ;%TEMP+NN IN EACC
;STORE %TEMP POINTER IN DE ENTRY
HRRZ TA,CURDE
ADD TA,TEMLOC
DPB EACC,DPL.DL ;STORE POINTER
;GET TAG TO USE TO GEN CODE
PUSHJ PP,GETTAG
HRRZ TA,CURDE
ADD TA,TEMLOC
DPB CH,DE.TAG
JRST UNSG15 ;DONE WITH THIS DELIMITER
;NUMERIC DELIMITER, CAN PUT BP AND CC DIRECTLY INTO %LIT.
; BUT FIRST, HAVE TO MOVE IT TO AN UNSIGNED NUMERIC TEMP.
UNSG10: HRRZ TE,USENII ;CONVERT TO BSI OF SENDING ITEM
PUSHJ PP,MVAUN0 ;MOVE "A" TO AN UNSIGNED TEMP
;NOW THE %TEMP IS IN "A"
PUSHJ PP,GTLBPC ;PUT BP AND CC IN %LIT
HRRZ TA,CURDE ;;STORE %LIT IN DE ENTRY
ADD TA,TEMLOC
DPB TE,DPL.DL
JRST UNSG15 ;DONE WITH THIS DELIMITER
;HERE IF DELIMITER WAS A NON-NUMERIC DATANAME
UNSG11: HRRZ TE,EMODEA ;CHECK FOR SOME KIND OF DISPLAY
CAILE TE,DSMODE
$CERR ;?INSANITY
;STORE BSI IN ENTRY
HRRZ TA,CURDE
ADD TA,TEMLOC
DPB TE,BSI.DE
;IF SUBSCRIPTING OR DEPENDING VARIABLES, WE HAVE TO
; GET A TAG, COPY OPERAND, AND PUT BP AND CC IN %TEMP.
; ELSE WE CAN JUST PUT IT IN %LIT.
PUSHJ PP,DEPTSA ;DEPENDING VARIABLES?
TSWF FASUB ; AND/OR SUBSCRIPTING?
JRST UNS11A ;YES, DO LOTS OF WORK
;PUT THE STUFF IN %LIT
PUSHJ PP,GTLBPC ;PUT IN %LIT
HRRZ TA,CURDE
ADD TA,TEMLOC
DPB TE,DPL.DL
JRST UNSG15 ;DONE WITH THIS DELIMITER
;NON-NUMERIC DELIMITER, WITH SUBSCRIPTING AND/OR DEPENDING ITEM
UNS11A: PUSHJ PP,GETTAG ;WELL, GET A TAG
HRRZ TA,CURDE
ADD TA,TEMLOC
DPB CH,DE.TAG ;STORE THE TAG AWAY
;COPY OPERAND TO TEMTAB
HRRZ TA,ARGSTR
ADD TA,EOPLOC
MOVE TE,1(TA) ;FIND HOW MANY SUBSCRIPT WORDS
LDB TA,TESUBC
LSH TA,1
ADDI TA,2 ;+2 FOR BASE ITEM
PUSH PP,TA ;SAVE # WORDS TO COPY
PUSHJ PP,GETTEM ;GET THE WORDS IN TEMTAB
HRRZ TB,CURDE ;STORE LINK IN DE ENTRY
ADD TB,TEMLOC
MOVEM TA,.DEOPR(TB)
POP PP,TD ;# WORDS TO COPY
ADD TA,TEMLOC ;TA:= START OF TEMTAB BLOCK
HRRZ TB,ARGSTR ;POINT TO OPERAND AGAIN
ADD TB,EOPLOC
PUSHJ PP,COPYOP ;COPY IT..
;GET 2 TEMP LOCS TO USE FOR BP AND CC OF THIS DELIMITER
MOVEI TE,2
PUSHJ PP,GETEMP
;STORE %TEMP POINTER IN DE ENTRY
HRRZ TA,CURDE
ADD TA,TEMLOC
DPB EACC,DPL.DL ;STORE POINTER TO %TEMP
JRST UNSG15 ;DONE WITH THIS DELIMITER
;HERE IF DELIMITER WAS LITERAL OR FIG. CONST
UNSG12: HRRZ EACA,USENII ;USE MODE OF SENDING ITEM, IF POSSIBLE
PUSHJ PP,SETLFC ;SET IT UP
POPJ PP, ;ERRORS, RETURN TO PHASE E DRIVER
PUSH PP,EACC ;SAVE %LIT PTR
PUSHJ PP,TLNKDE ;GET A DE ENTRY
POP PP,EACC ;RESTORE %LIT PTR
HRRZM EACC,EINCRA
MOVE TE,[^D36,,AS.MSC]
MOVEM TE,EBASEA
SETZM ETABLA ;[1364] ZERO LINK TO SOURCE FIELD
PUSHJ PP,GTLBPC ;PUT 2-WORD ENTRY IN LITERAL TABLE
HRRZ TA,CURDE
ADD TA,TEMLOC
DPB TE,DPL.DL ;STORE %LIT PTR
HRRZ TE,EMODEA ;GET MODE
DPB TE,BSI.DE ;STORE IT IN ENTRY
; JRST UNSG15 ;DONE WITH THIS DELIMITER
;HERE WHEN DONE THIS DELIMITER
UNSG15: HRRZ TE,ARGSTR ;POINT TO NEXT DELIMITER
ADD TE,EOPLOC
HRRM TE,CUREOP
PUSHJ PP,BMPEOP
$CERR ;?ERROR
MOVE TC,CUREOP ;CHECK FOR "ALL" FLAG
MOVE TC,1(TC) ;GET OPERAND WORD
TLNE TC,(GWFL9) ;IS 'ALL' FLAG ON?
JRST [MOVE TA,CURDE ;YES, SET IT IN THE ENTRY
ADD TA,TEMLOC
IFN FT68274,<
MOVE TD,ESIZEA ;GET SIZE OF ALL LITERAL
CAMGE TD,CVTSAL ;SMALLEST SO FAR?
MOVEM TD,CVTSAL ;YES
>
MOVX TD,DE%ALL
IORM TD,.DEFLG(TA)
JRST .+1]
PUSHJ PP,BMPEOP ;SKIP THE UNSDEL 'OPERATOR'
$CERR ;?ERROR
HRRZ TE,CUREOP
HRRZ TD,EOPLOC
SUBI TE,(TD) ;GET NEW REL PTR
MOVEM TE,ARGSTR ;SAVE IN ARGSTR
SOSLE M.ARG1 ; ANY MORE DELIM'S?
JRST UNSG9 ;YES, LOOP
;HERE WHEN DONE THE DELIMITERS
;ARGSTR NOW POINTS TO THE FIRST RECEIVING ITEM
UNSG20: HRRZ TE,ARGCTR ;GET # DESTINATIONS
MOVEM TE,M.ARG1 ;M.ARG1 = # DESTS LEFT TO DO
;HERE WITH ARGSTR POINTING TO THE NEXT RECEIVING ITEM
UNSG21: HRRZ TC,ARGSTR ;POINT TO IT
ADD TC,EOPLOC
HRRM TC,CUREOP
HRLM TC,OPERND ;FOR SUBSCA
MOVE TD,(TC) ;LOOK AT RECEIVING ITEM
TLNE TD,GNLIT!GNFIGC ;BETTER NOT BE A LITERAL OR FIG CONST.
$CERR ; ** PHASE D SHOULD CATCH THIS **
PUSHJ PP,SETOPA ;SET UP RECEIVING ITEM AS "A"
; ERRORS RETURN TO PHASE E DRIVER
PUSHJ PP,TLNKUS ;GET ANOTHER UNSTRING-SERIES ENTRY
TSWT FANUM ;RECEIVING ITEM NUMERIC?
JRST UNSG25 ;NO, NON-NUMERIC
;RECEIVING ITEM IS NUMERIC. IT MAY BE ANY KIND OF NUMERIC, TOO.
; WE WILL HAVE TO GENERATE A ROUTINE TO STORE IT IN THE PROPER PLACE.
PUSHJ PP,GETTAG ;GET A TAG FOR ROUTINE
HRRZ TA,CURUS ;STORE IN ENTRY
ADD TA,TEMLOC
DPB CH,TAG.OR ;STORE TAG FOR RECEIVING ITEM
;SET "NUMERIC" BIT
MOVX TE,US%NUR!US%RRJ ;NUMERIC (THEREFORE RIGHT-JUSTIFIED)
;RECEIVING ITEM
IORM TE,.USFLG(TA)
;COPY OPERAND
HRRZ TE,ARGSTR ;POINT TO OPERAND
ADD TE,EOPLOC
MOVE TE,1(TE) ;FIND SUBSC COUNT
LDB TA,TESUBC
LSH TA,1
ADDI TA,2 ;# WORDS TO COPY
PUSH PP,TA ;SAVE # WORDS TO COPY
PUSHJ PP,GETTEM ;GET A TEMTAB ENTRY FOR THE OPERAND
HRRZ TE,TA
HRRZ TA,CURUS ;STORE POINTER IN THE ENTRY
ADD TA,TEMLOC
MOVEM TE,.USPTR(TA) ;POINTER TO RECEIVING ITEM'S OPERAND
POP PP,TD ;TD:= # WORDS TO COPY
HRRZ TA,TE ;GET ABS PLACE TO PUT IT
ADD TA,TEMLOC
HRRZ TB,ARGSTR ;TB POINTS TO OPERAND NOW
ADD TB,EOPLOC
PUSHJ PP,COPYOP ;COPY IT..
;GET 2-WORD %LIT ENTRY WHICH WILL POINT TO OU.TMP
;FAKE "A" UP AS OU.TMP
MOVE TE,[^D36,,OU.TMP##]
MOVEM TE,EBASEA
SETZM EINCRA
HRRZ TE,USENII ;BSI OF THE SENDING ITEM
MOVEM TE,EMODEA
;LEAVE SAME SIZE AS THE NUMERIC ITEM.
; (DECIMAL PLACES AND EDITED ITEMS MAY REQUIRE SPECIAL PROCESSING HERE!)
MOVN TE,EDPLA ;GET # DECIMAL PLACES
ADDB TE,ESIZEA ; FAKE SIZE = SIZE - DEC PLACES
JUMPG TE,UNSG24 ;JUMP IF ANY SIZE LEFT AT ALL
;DIAG.-- ZEROES PUT INTO ...
SETZM ESIZEA ;CLEAR SIZE
UNSG24: PUSHJ PP,GTLBPC ;GET 2-WORD %LIT ENTRY
HRRZ TA,CURUS ;STORE %LIT POINTER IN ENTRY
ADD TA,TEMLOC
DPB TE,DPL.UR
;STORE BSI OF IT
HRRZ TE,USENII
DPB TE,BSI.UR
JRST UNSG30 ;DONE WITH RECEIVING ITEM
;HERE IF RECEIVING ITEM IS NON-NUMERIC.
UNSG25: HRRZ TE,EMODEA ;SANITY CHECK
CAILE TE,DSMODE ; TO MAKE SURE IT'S DISPLAY
$CERR ;?? YUK, A BUG.
;STORE BSI IN TEMTAB ENTRY
HRRZ TA,CURUS
ADD TA,TEMLOC
DPB TE,BSI.UR
;STORE RIGHT-JUSTIFY FLAG IF WE SHOULD
HRRZ TA,ETABLA
PUSHJ PP,LNKSET
LDB TE,DA.JST
JUMPE TE,UNSG26 ;NOT RIGHT-JUSTIFIED
HRRZ TA,CURUS
ADD TA,TEMLOC
MOVX TE,US%RRJ ;RECEIVING ITEM IS RIGHT-JUSTIFIED
IORM TE,.USFLG(TA) ;SET THE FLAG
UNSG26: PUSHJ PP,DEPTSA ;DOES IT HAVE A DEPENDING VARIABLE?
TSWF FASUB ;OR SUBSCRIPTED?
JRST UNSG27 ;YES, STORE OPERAND, AND SUCH
;BUILD POINTER IN LITAB
PUSHJ PP,GTLBPC ;PUT IN %LIT
HRRZ TA,CURUS
ADD TA,TEMLOC
DPB TE,DPL.UR ;STORE POINTER TO %LIT
JRST UNSG30 ;DONE WITH RECEIVING ITEM
;HERE FOR NON-NUMERIC RECEIVING ITEM WITH SUBSCRIPTS OR DEPENDING VARIABLES.
UNSG27: PUSHJ PP,GETTAG ;GET A TAG
HRRZ TA,CURUS
ADD TA,TEMLOC
DPB CH,TAG.UR ;STORE IT
;COPY OPERAND TO TEMTAB
HRRZ TA,ARGSTR
ADD TA,EOPLOC
MOVE TE,1(TA)
LDB TA,TESUBC
LSH TA,1
ADDI TA,2
PUSH PP,TA
PUSHJ PP,GETTEM
HRRZ TB,CURUS
ADD TB,TEMLOC
MOVEM TA,.USPTR(TB) ;STORE LINK TO RECEIVING ITEM OPERAND
POP PP,TD ;# WORDS TO COPY
ADD TA,TEMLOC ;TA:=START OF TEMTAB BLOCK
HRRZ TB,ARGSTR
ADD TB,EOPLOC
PUSHJ PP,COPYOP ;COPY IT..
;GET 2 %TEMP LOCS AND USE FOR BP AND CC
MOVEI TE,2
PUSHJ PP,GETEMP
HRRZ TA,CURUS
ADD TA,TEMLOC
DPB EACC,DPL.UR ;STORE PTR TO %TEMP
; JRST UNSG30 ;DONE WITH RECEIVING ITEM
;HERE WHEN DONE WITH RECEIVING ITEM
UNSG30: HRRZ TE,ARGSTR ;GET READY TO CALL BMPEOP
ADD TE,EOPLOC
HRRM TE,CUREOP
PUSHJ PP,BMPEOP ;GO GET THE DELIMITER-STORE OPERAND
$CERR ;?? (-2 + 0) STORED
HRRZ TE,CUREOP ;GET ARGSTR POINTING TO
HRRZ TD,EOPLOC ; THE DELIM-STORE OPERAND NOW
SUBI TE,(TD)
MOVEM TE,ARGSTR ;. .
HRRZ TC,CUREOP
MOVE TD,(TC) ;GET 1ST WORD
CAMN TD,[-2] ; IF -2, THERE IS NO DELIMITER STORE
JRST UNSG40 ;"DONE DELIMITER STORE"
TLNE TD,GNLIT!GNFIGC ;CAN'T BE A LITERAL OR FIG. CONST.
$CERR ;** PHASE D SHOULD HAVE CAUGHT IT **
HRRZ TA,CURUS ;SET FLAG SAYING WE GOT A DELIMITER STORE
ADD TA,TEMLOC
MOVX TE,US%GDS ;"GOT A DELIMITER-STORE ITEM"
IORM TE,.USFLG(TA)
;TC, AND CUREOP STILL POINT AT THE DELIMITER-STORE OPERAND
PUSHJ PP,SETOPA ;SET IT UP AS "A" OPERAND
; (ERRORS RETURN TO PHASE E DRIVER)
IFN FT68274,<
;TEST TO SEE IF DELIMITER-STORE IS BIGGER THAN SMALLEST ALL LITERAL DELIMITER
MOVE TE,ESIZEA ;GET STORE SIZE
CAMG TE,CVTSAL ;BIGGER THAN DELIMITER?
JRST UNSG31 ;NO, ALL IS WELL
MOVEI DW,E.771 ;YES, WARN USER
PUSHJ PP,OPNWRN
UNSG31:>
TSWT FANUM ;SKIP IF NUMERIC
JRST UNSG35 ;"NON-NUMERIC DELIMITER-STORE"
;DELIMITER-STORE IS NUMERIC.
PUSHJ PP,GETTAG ;GET A TAG FOR ROUTINE TO CALL
HRRZ TA,CURUS
ADD TA,TEMLOC
DPB CH,TAG.SD ;STORE TAG TO STORE DELIM-STORE AWAY
MOVX TE,DS%NUM!DS%JST ;NUMERIC
IORM TE,.USDSF(TA) ;SET FLAGS
;COPY OPERAND
HRRZ TA,ARGSTR
ADD TA,EOPLOC
MOVE TE,1(TA)
LDB TA,TESUBC
LSH TA,1
ADDI TA,2
PUSH PP,TA ;SAVE # WORDS TO COPY
PUSHJ PP,GETTEM
HRRZ TB,CURUS
ADD TB,TEMLOC
MOVEM TA,.USPTD(TB) ;POINTER TO DELIMITER-STORE OPERAND
POP PP,TD ;# WORDS TO COPY
ADD TA,TEMLOC ;TA:= START OF TEMTAB BLOCK
HRRZ TB,ARGSTR
ADD TB,EOPLOC
PUSHJ PP,COPYOP ;COPY IT..
;GET 2-WORD %LIT ENTRY WHICH WILL POINT TO OU.TMP
;FAKE "A" UP AS OU.TMP
MOVE TE,[^D36,,OU.TMP##]
MOVEM TE,EBASEA
SETZM EINCRA
HRRZ TE,USENII ;BSI OF THE SENDING ITEM
MOVEM TE,EMODEA
;LEAVE SAME SIZE AS THE NUMERIC ITEM.
; (DEC. PLACES MAY REQUIRE SPECIAL PROCESSING..!)
PUSHJ PP,GTLBPC ;GET 2-WORD %LIT ENTRY
HRRZ TA,CURUS ;STORE %LIT PTR IN ENTRY
ADD TA,TEMLOC
DPB TE,UPT.DS
;STORE BSI OF IT
HRRZ TE,USENII
DPB TE,BSI.DS
JRST UNSG40 ;DONE WITH DELIMITER ITEM
;HERE IF DELIMITER-STORE IS NON-NUMERIC
UNSG35: HRRZ TE,EMODEA ;SANITY CHECK ON MODE
CAILE TE,DSMODE
$CERR
;STORE BSI IN ENTRY
HRRZ TA,CURUS
ADD TA,TEMLOC
DPB TE,BSI.DS ;STORE BSI OF DELIMITER-STORE
;STORE RIGHT-JUSTIFIED FLAG IF WE SHOULD
HRRZ TA,ETABLA
PUSHJ PP,LNKSET
LDB TE,DA.JST
JUMPE TE,UNSG36 ;JUMP IF NOT JUSTIFIED
HRRZ TA,CURUS ;POINT TO ENTRY AGAIN
ADD TA,TEMLOC
MOVX TE,DS%JST ;"DELIMITER-STORE IS RIGHT-JUSTIFIED"
IORM TE,.USDSF(TA) ; SET FLAG IN ENTRY
UNSG36: PUSHJ PP,DEPTSA ;DEPENDING VARIABLE?
TSWF FASUB ; OR SUBSCRIPTS?
JRST UNSG37 ;YES, COPY OPERAND
;PUT THE STUFF IN %LIT
PUSHJ PP,GTLBPC ;PUT IN %LIT
HRRZ TA,CURUS
ADD TA,TEMLOC
DPB TE,UPT.DS ;STORE %LIT PTR IN ENTRY
JRST UNSG40 ;DONE WITH THE DELIMITER-STORE ITEM
;HERE IF NON-NUMERIC DELIMITER-STORE, WITH SUBSCRIPTS AND/OR DEPENDING VARS
UNSG37: PUSHJ PP,GETTAG ;GET A TAG FOR RUNTIME CALL
HRRZ TA,CURUS
ADD TA,TEMLOC
DPB CH,TAG.DT ;STORE TAG - ROUTINE WILL SETUP BP AND CC
MOVEI TE,2 ;GET 2-WORD LOC IN %TEMP
PUSHJ PP,GETEMP ;%TEMP+NN IN EACC
;STORE ADDR OF %TEMP BLOCK FOR DELIMITER-STORE ITEM
HRRZ TA,CURUS
ADD TA,TEMLOC
DPB EACC,UPT.DS
;COPY THE OPERAND
HRRZ TA,ARGSTR
ADD TA,EOPLOC
MOVE TE,1(TA)
LDB TA,TESUBC
LSH TA,1
ADDI TA,2
PUSH PP,TA ;SAVE # WORDS IN OPERAND
PUSHJ PP,GETTEM
HRRZ TB,CURUS
ADD TB,TEMLOC
MOVEM TA,.USPTD(TB) ;POINTER TO DEL-STORE OPERAND
POP PP,TD ;# WORDS TO COPY
ADD TA,TEMLOC ;TA:= START OF TEMTAB BLOCK
HRRZ TB,ARGSTR
ADD TB,EOPLOC ;TB:= START OF OPERAND
PUSHJ PP,COPYOP ;COPY IT...
; JRST UNSG40 ;DONE WITH DELIMITER-STORE ITEM
;HERE WHEN DONE WITH THE DELIMITER-STORE ITEM
UNSG40: HRRZ TE,ARGSTR
ADD TE,EOPLOC
HRRM TE,CUREOP
PUSHJ PP,BMPEOP ;POINT TO COUNT-ITEM
$CERR ;? (-2 + 0) STORED
HRRZ TE,CUREOP ;GET ARGSTR POINTING TO COUNT-ITEM NOW
HRRZ TD,EOPLOC
SUBI TE,(TD)
MOVEM TE,ARGSTR
HRRZ TC,CUREOP
MOVE TD,(TC) ;GET 1ST WORD OF OPERAND
CAMN TD,[-2] ; NO OPERAND?
JRST UNSG50 ;YES, SKIP THIS
IFN ANS74,<
TLNE TD,GNLIT!GNFIGC ;BETTER BE A REAL DATANAME
$CERR ;?SYNTAX SCAN SHOULD CATCH THIS
>
IFN ANS68,< ;COULD BE TALLY
TLNN TD,GNLIT!GNFIGC ;BETTER BE A REAL DATANAME
JRST UNSG42 ;IT IS
TLNE TD,GNFIGC ;FIG. CONST?
TLNN TD,GNTALY ;YES, IS IT TALLY?
$CERR ;NO, RANDOM FIG. CONST. OR LITERAL
UNSG42:>
;COUNT ITEM MUST BE NUMERIC.
PUSHJ PP,SETOPA ;SET IT UP AS "A"
; IF ERRORS, RETURN TO PHASE E DRIVER
TSWT FANUM
JRST STRE2
HRRZ TE,EMODEA ;CAN'T BE FLOATING POINT
CAIE TE,FPMODE
SKIPE EDPLA ;AND NO DECIMAL PLACES!
JRST STRE2
PUSHJ PP,STRGT3 ;GIVE ERROR IF THE "COUNT" ITEM IS EDITED
;SEE IF COUNT ITEM IS BIG ENOUGH TO HOLD ALL THE CHARACTERS IN THE SOURCE.
PUSHJ PP,STRGT4 ;MAKE TEST
;COUNT ITEM SEEMS TO BE OK. STORE OPERAND IN TEMTAB AND GENERATE A TAG.
UNSG41: PUSHJ PP,GETTAG ;GET A TAG FOR RUNTIME ROUTINE
HRRZ TA,CURUS
ADD TA,TEMLOC
DPB CH,TAG.CT ;TAG TO STORE COUNT ITEM
;STORE OPERAND.
HRRZ TA,ARGSTR
ADD TA,EOPLOC
MOVE TE,1(TA)
LDB TA,TESUBC
LSH TA,1
ADDI TA,2
PUSH PP,TA ;SAVE # WORDS TO COPY
PUSHJ PP,GETTEM ;GET THE WORDS IN TEMTAB
HRRZ TB,CURUS
ADD TB,TEMLOC
MOVEM TA,.USPTC(TB) ;SAVE PTR TO "COUNT" ITEM
POP PP,TD ;HO, HUM THIS CODE AGAIN
ADD TA,TEMLOC
HRRZ TB,ARGSTR ;NOT EVEN BOTHERING TO COMMENT
ADD TB,EOPLOC ; IT INTELLIGENTLY..
PUSHJ PP,COPYOP ;COPY IT..
HRRZ TA,CURUS ;POINT AT ENTRY
ADD TA,TEMLOC
MOVX TE,US%GCT ;"GOT A COUNT ITEM"
IORM TE,.USFLG(TA) ; SET FLAG IN ENTRY
; JRST UNSG50 ;DONE WITH "COUNT" ITEM
;HERE WHEN DONE WITH "COUNT" ITEM.
UNSG50: SOSG M.ARG1 ;MORE UNSTRING-SERIES?
JRST UNSG55 ;NO--DONE
HRRZ TE,ARGSTR ;BMPEOP TO NEXT ITEM
ADD TE,EOPLOC
HRRM TE,CUREOP
PUSHJ PP,BMPEOP
$CERR ;??BUT THERE WAS MORE
PUSHJ PP,BMPEOP ;SKIP OVER -1+W1
$CERR
HRRZ TE,CUREOP ;GET ARGSTR POINTING TO NEXT INTO ITEM
HRRZ TD,EOPLOC
SUBI TE,(TD)
MOVEM TE,ARGSTR
JRST UNSG21 ;GO ON TO NEXT UNSTRING-ENTRY
;GO TO UNSG55 ON NEXT PAGE WHEN WE ARE DONE WITH ALL UNSTRING-SERIES.
; THIS IS THE FIRST PASS OF UNSTRING CODE GENERATION.
;ALL ARGS ARE NOW SETUP IN TEMTAB. THE 2ND "PASS"
; IS GENERATING THE RUNTIME ROUTINES WHICH ARE "PUSHJ'D" TO.
;HERE WHEN DONE ALL UNSTRING-SERIES
; ** ALL ARGS ARE NOW SETUP IN TEMTAB **
;NOW WE CAN START GENERATING ROUTINES.
; USE M.ARG1 AS A FLAG... = 0 UNTIL JUMP HAS BEEN GENERATED
;AROUND THE %TAGS. THEN IT IS AS.TAG+N FOR THE PLACE TO GO.
UNSG55: SETZM M.ARG1 ;JUMP NOT GENERATED YET
SKIPN STPTO ;SKIP IF ANY POINTER ITEM
JRST UNS55E ;NO
;GENERATE CODE TO STORE THE POINTER ITEM
PUSHJ PP,PUTJMP ;PUT "JRST" OUT IF NECESSARY
HLRZ CH,STPTO ;GET TAG OF POINTER ROUTINE
HRRZ TA,CH ;REFERENCE IT
PUSHJ PP,REFTAG
PUSHJ PP,PUTTAG ;WRITE IT OUT
;GEN A MOVE FROM PT.VAL TO THE POINTER ITEM.
; WE WILL SETUP THE POINTER ITEM AS "B".
HRRZ TC,STPTO ;GET OFFSET INTO TEMTAB OF THE OPERAND
ADD TC,TEMLOC
PUSHJ PP,CPYOPP ;COPY OPERAND TO A SAFE PLACE
HRRM TC,CUREOP
HRRM TC,OPERND
PUSHJ PP,SETOPB ;SET IT UP AS "B"
;FAKE AN "A" OPERAND TO BE PT.VAL
PUSHJ PP,FAKPTV
PUSHJ PP,MXX. ;MOVE "A" TO "B"
TSWF FERROR ;IF ERRORS,
POPJ PP, ;GIVE UP
;WRITE POPJ TO END ROUTINE
PUSHJ PP,PUTPPJ
;HERE WHEN DONE WITH THE POINTER ITEM ROUTINE
UNS55E: SKIPN UNSTLY ;SKIP IF ANY TALLYING ITEM
JRST UNS55M ;NO
;GENERATE CODE TO STORE THE TALLYING ITEM
PUSHJ PP,PUTJMP ;PUT "JRST" OUT IF NECESSARY
HLRZ CH,UNSTLY ;GET TAG OF TALLYING ROUTINE
HRRZ TA,CH ;REFERENCE IT
PUSHJ PP,REFTAG
PUSHJ PP,PUTTAG ;WRITE IT OUT
;GEN A MOVE FROM TL.VAL TO THE TALLYING ITEM.
HRRZ TC,UNSTLY
ADD TC,TEMLOC
PUSHJ PP,CPYOPP ;COPY OPERAND TO A SAFE PLACE
HRRM TC,CUREOP
HRRM TC,OPERND ;FOR SUBSCB
PUSHJ PP,SETOPB ;SET IT UP AS "B"
PUSHJ PP,FAKTLV ;FAKE "A" AS TL.VAL
PUSHJ PP,MXX. ;GENERATE THE 'MOVE'
TSWF FERROR ;IF ERRORS,
POPJ PP, ;QUIT
PUSHJ PP,PUTPPJ ;WRITE POPJ TO END ROUTINE
;HERE WHEN DONE WITH THE TALLYING ITEM ROUTINE
UNS55M: SKIPN TE,UNSDLE ;ANY DELIMITER ENTRIES?
JRST UNSG70 ;NO, SKIP THIS
MOVEM TE,CURDE ;STORE FIRST ENTRY AS "CURRENT ENTRY"
;HERE WITH THE NEXT DELIMITER ENTRY POINTER IN "CURDE"
UNSG56: HRRZ TA,CURDE ;SEE IF ANY CODE TO GENERATE
ADD TA,TEMLOC
LDB TE,DE.TAG ;ANY TAG?
JUMPE TE,UNSG69 ;NO
PUSH PP,TE ;SAVE TAG
PUSHJ PP,PUTJMP ;PUT "JRST" OVER ROUTINE
POP PP,CH ;RESTORE TAG
HRRZ TA,CH ;REFERENCE IT
PUSHJ PP,REFTAG
PUSHJ PP,PUTTAG ;OUTPUT IT
;SETUP M.ARG2 = PTR TO %LIT OR %TEMP FOR BP AND CC
HRRZ TA,CURDE
ADD TA,TEMLOC
LDB TE,DPL.DL ;GET THE %TEMP OR %LIT WE WILL USE FOR BP AND CC
MOVEM TE,M.ARG2 ;STORE IN M.ARG2 FOR A MINUTE.
;SETUP THE OPERAND AS "A"
HRRZ TA,CURDE
ADD TA,TEMLOC
SKIPN TC,.DEOPR(TA) ;GET PTR TO OPERAND
$CERR ;?? OOPS
ADD TC,TEMLOC
PUSHJ PP,CPYOPP ;COPY OPERAND TO A SAFE PLACE
HRRM TC,CUREOP
HRLM TC,OPERND
PUSHJ PP,SETOPA ;SET IT UP AS "A"
TSWT FANUM ;SKIP IF NUMERIC
JRST UNSG62 ;NON-NUMERIC
;NUMERIC DELIMITER.
;MOVE UNSIGNED TO %TEMP
HRRZ TE,USENII ;GET BSI
PUSHJ PP,MVAUN0 ;MOVE "A" TO UNSIGNED %TEMP
;NOW THE %TEMP IS IN "A"
;GEN CODE TO STORE BP IN THE %TEMP+0
MOVE TA,[BYTLIT,,2] ;PREPARE TO WRITE BP
PUSHJ PP,STASHP
HRRZ TA,EBASEA
PUSHJ PP,STASHQ
HLRZ TA,ERESA
ROT TA,-6
HRRZ TC,EMODEA
MOVE TC,BYTE.S(TC)
DPB TC,[POINT 6,TA,11]
HRR TA,EINCRA ;%TEMP+N
PUSHJ PP,POOLIT ;POOL BYTE PTR
SKIPN TE,PLITPC ;WAS IT POOLED
HRRZ TE,ELITPC ;NO, GET PC
SKIPN PLITPC ;SKIP IF POOLED
AOS ELITPC ;NO, BUMP PC
MOVE CH,[MOV+AC5+ASINC,,AS.MSC]
PUSHJ PP,PUTASY
HRRZ CH,TE
IORI CH,AS.LIT
PUSHJ PP,PUTASN ;"MOVE AC5,[BYTE PTR TO NUMERIC ARG IN %TEMP]"
MOVE CH,[MOVEM.+AC5+ASINC,,AS.MSC]
PUSHJ PP,PUTASY
HRRZ CH,M.ARG2 ;AS.TMP+N
PUSHJ PP,PUTASN ;"MOVEM AC5,%TEMP+0"
;GEN CODE TO GET CC
PUSHJ PP,GTCCA ;GET CHARACTER-COUNT OF "A"
MOVE CH,[MOVEM.+AC7+ASINC,,AS.MSC]
PUSHJ PP,PUTASY
HRRZ CH,M.ARG2 ;GET PTR TO %TEMP
ADDI CH,1 ;ADD 1
PUSHJ PP,PUTASN ;FINISH "MOVEM AC7,%TEMP+1"
PUSHJ PP,PUTPPJ ;GEN POPJ TO END ROUTINE
JRST UNSG69 ;DONE WITH THIS DELIMITER
;HERE FOR NON-NUMERIC DELIMITER
UNSG62: PUSHJ PP,NB1PAR ;GET BP IN AC5
MOVE CH,[MOVEM.+AC5+ASINC,,AS.MSC]
PUSHJ PP,PUTASY
HRRZ CH,M.ARG2 ;PTR TO %TEMP
PUSHJ PP,PUTASN ;FINISH STORING BP
;STORE CC
PUSHJ PP,DEPTSA ;DOES IT HAVE A DEPENDING ITEM?
JRST UNSG64 ;NO, USE "MOVEI"
MOVEI TE,7 ;YES, USE RUNTIME AC7 TO GET SIZE
SETZM SAVPR0 ;DON'T SAVE %PARAM
PUSHJ PP,SZDPVA ;GET SIZE IN RUNTIME AC7
$CERR ;?? NO ERRORS SHOULD OCCUR
JRST UNSG65 ;STORE SIZE AWAY
UNSG64: PUSHJ PP,GTCCA ;PUT FIXED SIZE IN RUNTIME AC7
UNSG65: MOVE CH,[MOVEM.+AC7+ASINC,,AS.MSC]
PUSHJ PP,PUTASY
HRRZ CH,M.ARG2 ;PTR TO %TEMP
ADDI CH,1 ; MAKE IT %TEMP+1
PUSHJ PP,PUTASN ;STORE SIZE THERE
PUSHJ PP,PUTPPJ ;GEN POPJ TO END ROUTINE
;HERE WHEN DONE A DELIMITER
UNSG69: HRRZ TA,CURDE
ADD TA,TEMLOC
SKIPN TE,.DELNK(TA) ;SKIP IF ANY MORE DELIMITERS
JRST UNSG70 ;NO--GO ON TO 'INTO' ITEMS
MOVEM TE,CURDE ;YES, STORE NEXT ONE
JRST UNSG56 ;AND GO PROCESS IT
;HERE WHEN DONE ALL THE DELIMITER ENTRIES
; GENERATE ROUTINES FOR THE 'INTO' ENTRIES
UNSG70: SKIPN TA,STSETP ;POINT TO 1ST ENTRY
$CERR ;?MUST BE AT LEAST 1
;HERE WITH TA POINTING TO NEXT 'INTO' ENTRY
UNSG71: MOVEM TA,CURUS ;SAVE 'CURRENT UNSTRING-SERIES' ENTRY
ADD TA,TEMLOC
LDB CH,TAG.UR ;GET TAG IF THERE.
SKIPN CH ;%TAG1 OR %TAG2: THEY ARE MUTUALLY EXCLUSIVE
LDB CH,TAG.OR ; THIS IS PRESENT IF NUMERIC DESTINATION
JUMPE CH,UNSG74 ;JUMP IF NO ROUTINE TO GENERATE
PUSH PP,CH ;SAVE THE TAG
PUSHJ PP,PUTJMP ; JUMP OVER ROUTINE, IF NECESSARY
POP PP,CH ;RESTORE TAG
HRRZ TA,CH ;REFERENCE IT
PUSHJ PP,REFTAG
PUSHJ PP,PUTTAG ;AND PUT IT OUT
HRRZ TA,CURUS
ADD TA,TEMLOC
SKIPN TC,.USPTR(TA) ;GET PTR TO RECEIVING ITEM OPERAND
$CERR ;??MUST BE THERE
ADD TC,TEMLOC
PUSHJ PP,CPYOPP ;COPY OPERAND TO A SAFE PLACE
HRRM TC,CUREOP
HRLM TC,OPERND
PUSHJ PP,SETOPA ;SET IT UP AS "A"
TSWT FANUM ;SKIP IF NUMERIC
JRST UNSG73 ;NON-NUMERIC
;NUMERIC RECEIVING ITEM. GENERATE CODE TO STORE IT AWAY FROM OU.TMP
HLRZ TC,OPERND ;POINT TO OPERAND AGAIN
HRRM TC,OPERND ;MAKE IT THE "B" OPERAND TOO.
PUSHJ PP,SETOPB ;SET IT UP AS "B"
;FAKE "A" AS OU.TMP
;SAME SIZE AS "B", BUT NO DECIMAL PLACES
MOVE TA,[^D36,,OU.TMP##]
MOVEM TA,EBASEA
SETZM EINCRA
HRRZ TA,USENII ;BSI OF SENDING ITEM
MOVEM TA,EMODEA ; = BSI OF OU.TMP
MOVN TA,EDPLA ;GET # DECIMAL PLACES IN FINAL ITEM
ADDB TA,ESIZEA ; FIXUP THE SIZE
SKIPG TA ;ANY SIZE LEFT?
SETZM ESIZEA ;NO, MAKE IT 0 SIZE
SETZM EDPLA ;NO DECIMAL PLACES
SWOFF FASUB!FASIGN ;NOT SUBSCRIPTED, OR SIGNED
TSWF FBSIGN ;[1434] UNLESS B IS SIGNED -
SWON FASIGN ;[1434] THEN PASS IT ON
SETZM ETABLA
SETZM EBYTEA
SETZM EFLAGA
PUSHJ PP,MXX. ;GEN THE "MOVE"
TSWF FERROR ;IF ERRORS,
POPJ PP, ;RETURN
JRST UNS73E ;DONE ROUTINE
;HERE IF RECEIVING ITEM IS NON-NUMERIC. IT MUST BE SUBSCR OR DEP VARIABLES.
UNSG73: PUSHJ PP,NB1PAR ;GET BP IN RUNTIME AC5
HRRZ TA,CURUS
ADD TA,TEMLOC
LDB TE,DPL.UR ;GET PTR TO %TEMP
SKIPN TE ;GOTTA BE SETUP
$CERR
MOVEM TE,M.ARG2 ;SAVE IN M.ARG2 FOR A SEC.
;TO STORE BP: GEN "MOVEM AC5,%TEMP+0"
MOVE CH,[MOVEM.+AC5+ASINC,,AS.MSC]
PUSHJ PP,PUTASY
HRRZ CH,M.ARG2 ;GET %TEMP
PUSHJ PP,PUTASN
;TO STORE CC: GET SIZE IN RUNTIM AC7
PUSHJ PP,DEPTSA ;DEPENDING VARIABLE?
JRST UNS73A ;NO, GEN "MOVEI"
MOVEI TE,7 ;TO RUNTIME AC7
SETZM SAVPR0 ;DON'T SAVE %PARAM+0
PUSHJ PP,SZDPVA
$CERR ;? YECCH
TRNA
UNS73A: PUSHJ PP,GTCCA ;GEN "MOVEI AC7,<ESIZEA>"
MOVE CH,[MOVEM.+AC7+ASINC,,AS.MSC]
PUSHJ PP,PUTASY
HRRZ CH,M.ARG2 ;ADDRESS OF %TEMP
ADDI CH,1 ; STORE CC IN 2ND WORD
PUSHJ PP,PUTASN
;GEN "POPJ 17," TO END ROUTINE
UNS73E: PUSHJ PP,PUTPPJ ;WRITE OUT THE POPJ
;HERE WHEN DONE GENERATING THE ROUTINE TO HANDLE THE 'INTO' ITEM.
UNSG74: HRRZ TA,CURUS
ADD TA,TEMLOC
MOVE TE,.USFLG(TA) ;GET FLAG WORD
TXNN TE,US%GDS ;GOT A DELIMITER-STORE ITEM?
JRST UNSG78 ;NO, SKIP THIS CODE
LDB TE,TAG.DT ;SETUP %TEMP WITH BP AND CC?
JUMPE TE,UNSG76 ;NO
PUSH PP,TE ;SAVE THE TAG
PUSHJ PP,PUTJMP ; JUMP OVER ROUTINE, IF NECESSARY
POP PP,CH ;RESTORE TAG
HRRZ TA,CH ;REFERENCE IT
PUSHJ PP,REFTAG
PUSHJ PP,PUTTAG ;PUT IT OUT
HRRZ TA,CURUS
ADD TA,TEMLOC
SKIPN TC,.USPTD(TA) ;GET DEL-STORE OPERAND
$CERR ;?? NOT THERE??
ADD TC,TEMLOC
PUSHJ PP,CPYOPP ;COPY OPERAND TO A SAFE PLACE
HRRM TC,CUREOP
HRLM TC,OPERND
PUSHJ PP,SETOPA ;SET IT UP AS "A"
; THE OPERAND IS SUPPOSEDLY NON-NUMERIC WITH SUBSCR AND/OR DEP VAR.
TSWF FANUM ;MAKE SURE NON-NUMERIC
$CERR ;?? BAD COBOL!
PUSHJ PP,NB1PAR ;GET BP IN RUNTIME AC5
HRRZ TA,CURUS
ADD TA,TEMLOC
LDB TE,UPT.DS ;GET %TEMP PTR
MOVEM TE,M.ARG2 ;SAVE IN M.ARG2 FOR A SEC.
;TO STORE BP: GEN "MOVEM AC5,%TEMP+0"
MOVE CH,[MOVEM.+AC5+ASINC,,AS.MSC]
PUSHJ PP,PUTASY
HRRZ CH,M.ARG2
PUSHJ PP,PUTASN
;TO STORE CC: GET SIZE IN RUNTIME AC7
PUSHJ PP,DEPTSA ;DEPENDING VARIABLE?
JRST UNSG75 ;NO, GEN "MOVEI"
MOVEI TE,7 ;TO RUNTIME AC7
SETZM SAVPR0 ;DON'T SAVE %PARAM+0
PUSHJ PP,SZDPVA
$CERR
TRNA
UNSG75: PUSHJ PP,GTCCA ;GEN "MOVEI AC7,<ESIZEA>"
MOVE CH,[MOVEM.+AC7+ASINC,,AS.MSC]
PUSHJ PP,PUTASY
HRRZ CH,M.ARG2 ;ADDRESS OF %TEMP
ADDI CH,1 ;STORE CC IN 2ND WORD
PUSHJ PP,PUTASN
;GEN "POPJ 17," TO END ROUTINE
PUSHJ PP,PUTPPJ ;WRITE OUT THE POPJ
;HERE WHEN DONE GENERATING ROUTINE TO SETUP %TEMP WITH BP AND CC
UNSG76: HRRZ TA,CURUS
ADD TA,TEMLOC
LDB TE,TAG.SD ;STORE DELIM AWAY FROM OU.TMP
JUMPE TE,UNSG78 ;JUMP IF NO
PUSH PP,TE ;SAVE TAG
PUSHJ PP,PUTJMP ; JUMP OVER ROUTINE, IF NECESSARY
POP PP,CH ;RESTORE TAG
HRRZ TA,CH ;REFERENCE IT
PUSHJ PP,REFTAG
PUSHJ PP,PUTTAG ;PUT IT OUT
HRRZ TA,CURUS
ADD TA,TEMLOC
SKIPN TC,.USPTD(TA) ;GET OPERAND
$CERR ;?MUST BE THERE
ADD TC,TEMLOC
PUSHJ PP,CPYOPP ;COPY OPERAND TO A SAFE PLACE
HRRM TC,CUREOP
HRLM TC,OPERND
PUSHJ PP,SETOPB ;SET IT UP AS "B"
;OPERAND IS SUPPOSEDLY NUMERIC. ALSO %LIT HAS BEEN SETUP ALREADY
; TO POINT TO OU.TMP.
TSWT FBNUM ;MAKE SURE
$CERR ;; ?IMPLEMENTER ERROR
;FAKE "A" AS OU.TMP
;SAME SIZE AS "B", BUT NO DECIMAL PLACES
MOVE TA,[^D36,,OU.TMP##]
MOVEM TA,EBASEA
SETZM EINCRA
SETZM EDPLA
SWOFF FASUB!FASIGN ;NOT SUBSCRIPTED, OR SIGNED
SWON FANUM ;BUT NUMERIC
SETZM ETABLA
SETZM EBYTEA
SETZM EFLAGA
HRRZ TE,ESIZEB
HRRZM TE,ESIZEA
HRRZ TE,USENII ;BSI OF SENDING ITEM
HRRZM TE,EMODEA ;IS BSI OF THE DELIMITER STORE
PUSHJ PP,MXX. ;GENERATE THE MOVE
TSWF FERROR ;IF ERRORS,
POPJ PP, ;RETURN
;GEN "POPJ 17," TO END ROUTINE
PUSHJ PP,PUTPPJ ;WRITE OUT THE POPJ
;HERE WHEN DONE WITH THE DELIMITER-STORE ROUTINE GEN.
UNSG78: HRRZ TA,CURUS
ADD TA,TEMLOC
LDB TE,TAG.CT ;TAG TO STORE COUNT ITEM?
JUMPE TE,UNSG84 ;NO, WE ARE DONE
PUSH PP,TE ;SAVE TAG
PUSHJ PP,PUTJMP ; JUMP OVER ROUTINE, IF NECESSARY
POP PP,CH ;RESTORE TAG
HRRZ TA,CH ;REFERENCE IT
PUSHJ PP,REFTAG
PUSHJ PP,PUTTAG ;PUT IT OUT
;GEN CODE TO STORE THE "COUNT" ITEM
HRRZ TA,CURUS
ADD TA,TEMLOC
SKIPN TC,.USPTC(TA) ;GET OPERAND POINTER
$CERR ;?MUST BE THERE
ADD TC,TEMLOC
PUSHJ PP,CPYOPP ;COPY OPERAND TO A SAFE PLACE
HRRM TC,CUREOP
HRRM TC,OPERND
PUSHJ PP,SETOPB ;SET IT UP AS "B"
;FAKE AN "A" OPERAND TO BE CT.VAL
PUSHJ PP,FAKCTV
PUSHJ PP,MXX. ;MOVE 'A' TO 'B'
TSWF FERROR
POPJ PP, ;DIE IF ERRORS
;GEN "POPJ 17," TO END ROUTINE
PUSHJ PP,PUTPPJ ;WRITE OUT THE POPJ
; JRST UNSG84 ;DONE WITH THIS UNSTRING-SERIES ENTRY
;HERE WHEN DONE WITH THIS UNSTRING-SERIES ENTRY
;LOOP IF ANY MORE TO DO
UNSG84: HRRZ TA,CURUS
ADD TA,TEMLOC
SKIPE TA,.USLNK(TA) ;GET LINK IF ANY
JRST UNSG71 ;GOT ONE, GEN ROUTINES IF NECESSARY
;HERE WHEN DONE GENERATING ALL ROUTINES.
; GENERATE %TAG IF NECESSARY TO START OFF UNSTRING STMT.
UNSG85: SKIPN CH,M.ARG1 ;"JRST" GENERATED?
JRST UNSG86 ;NO
PUSHJ PP,PUTTAG ;YES, GENERATE %TAG:
;GENERATE THE ARG LIST IN THE LITERALS
UNSG86: HRRZ TE,ELITPC ;SET M.ARG4 TO POINT TO START OF
HRRZM TE,M.ARG4 ; LITERALS, INCASE WE DON'T POOL
;FIRST WORD OF ARG LIST: -N,,FLAGS
; WHERE N= # OF "INTO" ITEMS
MOVE TA,[XWDLIT,,2]
PUSHJ PP,STASHP
HRRZ TA,ARGCTR ;# OF "INTO" ITEMS
MOVN TA,TA ;GET -#
HRLE TA,TA ;PUT IN LH
HRRI TA,AS.CNB ; LARGE CONSTANT
PUSHJ PP,STASHQ
HRL TA,UNSFLG ;RH= FLAGS
HRRI TA,AS.CNB
PUSHJ PP,STASHQ ;PUT OUT RH OF XWD
AOS ELITPC
;2ND WORD OF ARG LIST: ID-1 ITEM INFO
; ACTUALLY JUST THE BSI.
MOVE TA,[XWDLIT,,2]
PUSHJ PP,STASHP
SETZ TA, ;LH=0
PUSHJ PP,STASHQ
HRRZ TA,USENII ;BSI OF SOURCE IN RH
PUSHJ PP,STASHQ
AOS ELITPC
;3RD WORD OF ARG LIST (OPTIONAL -- ONLY IF THERE WAS A 'POINTER' ITEM.
SKIPN STPTO ;SKIP IF THERE WAS A POINTER ITEM
JRST UNSG87 ;NO, SKIP THIS
MOVE TA,[XWDLIT,,2]
PUSHJ PP,STASHP
SETZ TA, ;0 IF LH
PUSHJ PP,STASHQ
HLRZ TA,STPTO ;AS.TAG+N
PUSHJ PP,STASHQ
AOS ELITPC
;4TH WORD OF ARG LIST (OPTIONAL -- ONLY IF THERE WAS A 'TALLYING' ITEM.
UNSG87: SKIPN UNSTLY ;SKIP IF THERE WAS A TALLYING ITEM
JRST UNSG88 ;NO, SKIP THIS
MOVE TA,[XWDLIT,,2]
PUSHJ PP,STASHP
SETZ TA, ;0 IN LH
PUSHJ PP,STASHQ
HLRZ TA,UNSTLY ;AS.TAG+N
PUSHJ PP,STASHQ
AOS ELITPC
;5TH WORD OF ARG LIST: OCT M
; WHERE M= # OF DELIMITER ITEMS.
UNSG88: MOVE TA,[OCTLIT,,1]
PUSHJ PP,STASHP
HLRZ TA,ARGCTR ;GET # DELIMS
PUSHJ PP,STASHQ ;WRITE IT OUT
AOS ELITPC
;FOR EACH DELIMITER ITEM, STORE
; FLAGS+BSI.DI,,%LIT
; %TAG OR 0
HLRZ TA,ARGCTR ;GET # TO DO
JUMPE TA,UNSG90 ;JUMP IF NONE
SKIPN TA,UNSDLE ;POINT TO 1ST DELIMITER ENTRY
$CERR ;? BUT THERE WAS AT LEAST ONE!
;HERE WITH TA POINTING TO NEXT DELIMITER ENTRY
UNSG89: MOVEM TA,CURDE ;MAKE IT THE "CURRENT" ENTRY
ADD TA,TEMLOC ;POINT TO ENTRY
MOVE TE,.DEFLG(TA) ;GET FLAG WORD
MOVEM TE,M.ARG3 ; STORE IN M.ARG3 FOR A SECOND.
MOVE TA,[XWDLIT,,2]
PUSHJ PP,STASHP ;READY TO WRITE AN XWD
HLLZ TA,M.ARG3 ;GET LH
HRRI TA,AS.CNB ; A LARGE CONSTANT
PUSHJ PP,STASHQ
HRLZ TA,M.ARG3 ;GET RH
SKIPE TA
HRRI TA,AS.MSC ;%LIT OR %TEMP
PUSHJ PP,STASHQ ;WRITE %LIT OR %TEMP OR 0
AOS ELITPC
;MORE DELIMITER INFO: %TAG OR 0
HRRZ TA,CURDE
ADD TA,TEMLOC
LDB TE,DE.TAG
JUMPE TE,UNS89A ;NO TAG, WRITE OCT 0
MOVEM TE,M.ARG3 ;SAVE %TAG FOR A SEC.
MOVE TA,[XWDLIT,,2]
PUSHJ PP,STASHP ;WRITE AS AN XWD 0,%TAG
SETZ TA,
PUSHJ PP,STASHQ
HRRZ TA,M.ARG3
PUSHJ PP,STASHQ
JRST UNS89B ;SKIP OVER "NO TAG" CODE
UNS89A: MOVE TA,[OCTLIT,,1]
PUSHJ PP,STASHP
SETZ TA,
PUSHJ PP,STASHQ
UNS89B: AOS ELITPC
;SEE IF ANY MORE DELIMITER ITEMS
HRRZ TA,CURDE
ADD TA,TEMLOC
SKIPE TA,.DELNK(TA) ;ANY MORE?
JRST UNSG89 ;YES, LOOP FOR 'EM
;HERE WHEN DONE DELIMITER ITEMS
; STORE THE "INTO" ITEM ENTRIES
;
UNSG90: HRRZ TA,ARGCTR ;HOW MANY "INTO" ITEM ENTRIES
SKIPN TA ;MUST BE AT LEAST 1
$CERR
;FOR EACH INTO ITEM, STORE:
; FLAGS+BSI.UR,,%LIT
; %TAG1,,%TAG2
; FLAGS+BSI.DELSTORE,,%LIT ;(ONLY PRESENT IF A DELIM-STORE ITEM)
; %TAG1,,%TAG2 ;..
; %TAG ;(ONLY PRESENT IF A COUNT ITEM)
SKIPN TA,STSETP ;GET PTR TO FIRST
$CERR ;?? MUST BE THERE
;HERE WITH TA POINTING TO NEXT 'INTO' ITEM ENTRY
UNSG91: MOVEM TA,CURUS
ADD TA,TEMLOC ;POINT TO IT
MOVE TE,.USFLG(TA) ;GET FLAGS FOR DELIMITER
MOVEM TE,M.ARG3 ;SAVE IN M.ARG3
;WRITE OUT FLAG WORD
MOVE TA,[XWDLIT,,2]
PUSHJ PP,STASHP
HLLZ TA,M.ARG3 ;LEFT HALF
HRRI TA,AS.CNB
PUSHJ PP,STASHQ
HRLZ TA,M.ARG3
SKIPE TA ;IF 0, LEAVE IT 0
HRRI TA,AS.MSC ; "MISC" FOR %TEMP OR %LIT
PUSHJ PP,STASHQ
AOS ELITPC
;WRITE OUT %TAG1,,TAG2 OR 0'S
HRRZ TA,CURUS
ADD TA,TEMLOC
MOVE TE,.USRTG(TA) ;GET %TAG1,%TAG2
MOVEM TE,M.ARG2 ;STORE IN M.ARG2 FOR A SEC..
MOVE TA,[XWDLIT,,2]
PUSHJ PP,STASHP
HLRZ TA,M.ARG2 ;LH TAG OR 0
PUSHJ PP,STASHQ
HRRZ TA,M.ARG2 ;RH TAG OR 0
PUSHJ PP,STASHQ
AOS ELITPC ;BUMP LITERAL PC
;DONE WITH THE 'INTO' ITEM.. SEE IF OPTIONAL 'DELSTORE' ITEM
UNSG93: MOVE TE,M.ARG3 ;GET FLAGS FROM THE 'INTO' ITEM ENTRY
TXNN TE,US%GDS ;SKIP IF WE GOT A DELSTORE ITEM
JRST UNSG94 ;NO, SKIP THIS
MOVEM TE,M.ARG2 ;SAVE FLAGS IN M.ARG2 NOW
HRRZ TA,CURUS
ADD TA,TEMLOC ;FIND FLAG WORD FOR THE 'DELSTORE' ITEM
MOVE TE,.USDSF(TA) ; GET IT
MOVEM TE,M.ARG3 ;SAVE IN M.ARG3
MOVE TA,[XWDLIT,,2]
PUSHJ PP,STASHP
HLLZ TA,M.ARG3
HRRI TA,AS.CNB ;LARGE CONSTANT
PUSHJ PP,STASHQ
HRLZ TA,M.ARG3
SKIPE TA
HRRI TA,AS.MSC
PUSHJ PP,STASHQ ;%LIT, OR %TEMP, OR 0
AOS ELITPC
HRRZ TA,CURUS
ADD TA,TEMLOC
MOVE TE,.USDTG(TA) ;GET TAG WORD FOR DELIMITER STORE
MOVEM TE,M.ARG3 ;COULD BE %TAG,,%TAG
MOVE TA,[XWDLIT,,2]
PUSHJ PP,STASHP
HLRZ TA,M.ARG3 ;LH TAG OR 0
PUSHJ PP,STASHQ ;WRITE TAG OR 0
HRRZ TA,M.ARG3 ;RH TAG
PUSHJ PP,STASHQ ;WRITE TAG OR 0
AOS ELITPC
SKIPA TE,M.ARG2 ;GET 'INTO ITEM' FLAGS AGAIN
;CHECK FOR COUNT ITEM.. IF PRESENT, WRITE THE %TAG
UNSG94: MOVE TE,M.ARG3 ;GET FLAGS FROM THE 'INTO' ITEM ENTRY
TXNN TE,US%GCT ;SKIP IF WE GOT A 'COUNT' ITEM
JRST UNS94D ;NOPE, DONE
MOVE TA,[XWDLIT,,2] ;READY TO GENERATE A %TAG
PUSHJ PP,STASHP
SETZ TA,
PUSHJ PP,STASHQ
HRRZ TA,CURUS ;FIND THE %TAG
ADD TA,TEMLOC
LDB TA,TAG.CT ;GET TAG FOR COUNT ITEM
SKIPN TA ;MUST BE THERE
$CERR
PUSHJ PP,STASHQ ;WRITE IT OUT
AOS ELITPC ;BUMP LITERAL PC
;HERE WHEN DONE WITH THIS 'INTO' ENTRY
UNS94D: HRRZ TA,CURUS
ADD TA,TEMLOC
SKIPE TA,.USLNK(TA) ;ANY MORE?
JRST UNSG91 ;YES, LOOP
;HERE WHEN DONE WRITING THE ARG LIST TO TEMTAB.
; SEE WHAT WE GOT
UNSG95: PUSHJ PP,POOL ;TRY TO POOL IT
;GENERATE "MOVEI 16,ARG.LIST"
; "PUSHJ 17,UNS. OR UNS.O"
SKIPN TE,PLITPC ;DID WE POOL?
HRRZ TE,M.ARG4 ;NO, GET STARTING LITERAL
MOVEM TE,LITNN ;STORE ADDRESS OF ARG LIST
SKIPE PLITPC ;DID WE POOL?
JRST [HRRZ TE,M.ARG4 ;YES, RESTORE START OF LITERALS
MOVEM TE,ELITPC
JRST .+1]
MOVEI TA,%UNS.## ;GENERATE "MOVEI" AND "PUSHJ"
TLNE W1,(GWFL9) ; HAVE AN "OVERFLOW" CLAUSE?
MOVEI TA,%UNS.O## ;YES, CALL OTHER ROUTINE
PJRST CSEQGN ;RETURN FROM 'UNSTRING' CODE GEN.
SUBTTL ERROR ROUTINES.
STRE1: MOVEI DW,E.373 ;[604] ?IMPROPER USAGE
JRST OPNFAT
STRE2: MOVEI DW,E.264 ;?NOT AN INTEGER DATA ITEM
JRST OPNFAT
;GIVE ERROR IF THE "POINTER" OR "TALLY" ITEM IS EDITED
STRGT3:
IFN ANS68,<
MOVE TE,EBASEA ;CHECK FOR TALLY
CAIN TE,TALLY.##
POPJ PP, ;JUST RETURN
>
HRRZ TA,ETABLA
PUSHJ PP,LNKSET
LDB TE,DA.EDT
JUMPN TE,STRE3
LDB TE,DA.BWZ
JUMPE TE,CPOPJ
STRE3: MOVEI DW,E.464 ;?CANNOT BE AN EDITED ITEM
JRST OPNFAT
;SEE IF ITEM IS BIG ENOUGH TO HOLD ALL THE CHARACTERS IN THE SOURCE.
STRT4P: HLRZ TE,SDSTIN ;MAX SIZE OF RECEIVING ITEM
TRNA
STRGT4: HLRZ TE,USENII ;SIZE OF SENDING ITEM
ADDI TE,1
HRRZ TD,ESIZEA ; SIZE OF PTR
CAIL TD,^D10 ;TEN OR MORE DIGITS IS ALWAYS ENOUGH
POPJ PP,
MOVE TD,POWR10##(TD) ;SEE WHAT THE LARGEST NUMBER IT WILL HOLD IS
CAMLE TD,TE ;SKIP IF NOT BIG ENOUGH
POPJ PP,
STRE4: MOVEI DW,E.465 ;?PTR/CTR TOO SMALL
JRST OPNWRN##
STRE5: MOVEI DW,E.577 ;?RECEIVING ITEM MAY NOT BE EDITED OR JUSTIFIED.
JRST OPNFAT
STRE6: MOVEI DW,E.635 ;"MUST REPRESENT AN INTEGER"
JRST OPNFAT
SUBTTL SUBROUTINES
;FIXOPS - ROUTINE TO PROCESS BOTH UNSDES OPERATOR AND UNSTR OPERATOR
; EACH HAS 1 REQUIRED OPERAND AND 2 OPTIONAL OPERANDS
;CALL:
; ARGSTR/ PTR TO THE REQUIRED OPERAND
; W1 CONTAINS THE CURRENT OPERATOR (WHICH MUST BE PRESERVED)
; IF BIT 34 OF TB IS 0 THE FIRST OPTIONAL OPERAND IS MISSING.
; IF BIT 35 OF TB IS 0 THE SECOND OPTIONAL OPERAND IS MISSING.
FIXOPS: CAIN TB,3 ;BOTH OPERANDS PRESENT?
POPJ PP, ;YES, RETURN
PUSH PP,W1 ;NO, SAVE OPERATOR
MOVNI W1,2 ;GET -2
TRNN TB,3 ;ARE BOTH OPERANDS MISSING?
JRST FIXOP2 ;YES, GO STORE TWO [-2 + 0]'S.
SOJN TB,FIXOP3 ;IF THE 2ND OPERAND IS MISSING,
; GO STORE ONE [-2 + 0]
;FIRST OPERAND IS MISSING.
;MAKE ROOM FOR 2 WORDS IN EOPTAB AND MOVE IT UP
PUSHJ PP,PUSH12 ;MAKE ROOM FOR 2 WORDS
HRRZ TC,ARGSTR## ;GET ADDR OF THE REQUIRED OPERAND
MOVE TE,1(TC) ;GET ITS SUBSCRIPT COUNT
LDB TB,TESUBC
LSH TB,1
ADDI TC,2(TB) ;SKIP TO 2ND
MOVE TE,1(TC) ;2ND WORD OF 2ND OPERAND
LDB TB,TESUBC ;GET 2ND'S SUBSCRIPT COUNT
MOVNI TB,1(TB) ; GET -# OF 2-WORD ENTRIES TO MOVE UP
HRLZI TB,(TB) ;-#,,0
HRRI TB,(TC) ;STARTING WITH THIS WORD
MOVE TA,(TB) ;GET 1ST TWO WORDS
MOVE TD,1(TB)
FIXOP1: EXCH TA,2(TB) ;MOVE UP A WORD PAIR
EXCH TD,3(TB)
AOJ TB,
AOBJN TB,FIXOP1
MOVEM W1,(TC) ;CAN'T USE PUSH%T, CAUSE WE'RE IN THE
SETZM 1(TC) ; MIDDLE OF THE TABLE.
JRST FIXOP4
FIXOP2: PUSHJ PP,PUSH%T ;STORE [-2 + 0] ON EOPTAB AS 1ST OPERAND.
FIXOP3: PUSHJ PP,PUSH%T ;STORE [-2 + 0] ON EOPTAB AS 2ND OPERAND.
FIXOP4: POP PP,W1 ;RESTORE OPERATOR
POPJ PP, ;RETURN
PUSH%T: JFFO W1,PUSH12##
;TLNKDE -- GET A DELIMITER ENTRY AND PUT IN LINKED LIST.
;CALL: PUSHJ PP,TLNKDE
; <RETURN HERE>
;INPUT:
; UNSDLE/ POINTS TO FIRST DE ENTRY, OR 0
; CURDE/ POINTER TO PREVIOUS ENTRY, UNLESS C(UNSDLE) = 0
;RETURNS:
; TEMTAB ENTRY GENERATED, AND ZEROED
; UNSDLE SET UP IF NOT ALREADY
; LINK SET UP IN PREVIOUS ENTRY TO POINT TO THIS ONE
; CURDE SET UP TO POINT TO THIS ENTRY
;ACS USED: TA-TE
TLNKDE: MOVEI TA,.DEHLN ;# WORDS TO GET
PUSH PP,TA ;SAVE # WORDS
PUSHJ PP,GETTEM ;GET (TA) LOCS IN TEMTAB
;LINK TO LAST ENTRY
SKIPN UNSDLE ;IS THIS 1ST DE?
JRST STRTDE ;YES
HRRZ TB,CURDE ;NO, LINK LAST ENTRY TO THIS ONE
ADD TB,TEMLOC
MOVEM TA,.DELNK(TB)
TRNA ;LEAVE INITIAL PTR ALONE
STRTDE: MOVEM TA,UNSDLE ;1ST ARG--SETUP INITIAL POINTER
MOVEM TA,CURDE ;MAKE THIS ENTRY THE CURRENT ONE
;ZERO OUT THIS TEMTAB ENTRY
POP PP,TD ;TD:= # WORDS TO CLEAR
ADD TA,TEMLOC ;TA POINTS TO FIRST WORD
SETZM (TA) ;CLEAR 1ST WORD
HRL TA,TA
HRRZ TB,TA
ADDI TB,-1(TD)
ADDI TA,1
BLT TA,(TB)
POPJ PP, ;DONE, RETURN
;TLNKUS - GET AN UNSTRING-SERIES ENTRY AND PUT IN LINKED LIST.
;CALL: PUSHJ PP,TLNKUS
; <RETURN HERE>
;INPUT:
; STSETP/ POINTS TO FIRST US ENTRY, OR 0
; CURUS/ POINTER TO PREVIOUS ENTRY, UNLESS C(STSETP) = 0
;RETURNS:
; TEMTAB ENTRY GENERATED, AND ZEROED
; STSETP SET UP IF NOT ALREADY
; LINK SET UP IN PREVIOUS ENTRY TO POINT TO THIS ONE
; CURUS SET UP TO POINT TO THIS ENTRY
;ACS USED: TA-TE
TLNKUS: MOVEI TA,.USHLN ;# WORDS TO GET
PUSH PP,TA ;SAVE # WORDS
PUSHJ PP,GETTEM ;GET (TA) LOCS IN TEMTAB
;LINK TO LAST ENTRY
SKIPN STSETP ;IS THIS 1ST U-S?
JRST STRTUS ;YES
HRRZ TB,CURUS ;NO, LINK LAST ENTRY TO THIS ONE
ADD TB,TEMLOC
MOVEM TA,.USLNK(TB)
TRNA ;LEAVE INITIAL PTR ALONE
STRTUS: MOVEM TA,STSETP ;1ST ARG--SETUP INITIAL POINTER
MOVEM TA,CURUS ;MAKE THIS ENTRY THE CURRENT ONE
;ZERO OUT THIS TEMTAB ENTRY
POP PP,TD ;TD:= # WORDS TO CLEAR
ADD TA,TEMLOC ;TA POINTS TO FIRST WORD
SETZM (TA) ;CLEAR 1ST WORD
HRL TA,TA
HRRZ TB,TA
ADDI TB,-1(TD)
ADDI TA,1
BLT TA,(TB)
POPJ PP, ;DONE, RETURN
;$CERR MACRO GENERATES A JSP TE,SIMPER.
; IF THIS MESSAGE EVER COMES OUT, THE PERSON WHO WISHES
;TO FIND OUT HOW IT GOT HERE MERELY HAS TO LOOK AT "TE",
;WHICH WILL CONTAIN THE PC OF THE INSTRUCTION AFTER THE $CERR.
SIMPER: OUTSTR [ASCIZ/? Internal compiler error in STRGEN
/]
JRST KILL##
END