Trailing-Edge
-
PDP-10 Archives
-
BB-H506E-SM
-
cobol/source/squirl.mac
There are 7 other files named squirl.mac in the archive. Click here to see a list.
; UPD ID= 2999 on 7/1/80 at 9:07 AM by WRIGHT
TITLE SQUIRL FOR COBOL V12C
SUBTTL SYNTAX TREE TRACER W.NEELY/CAM/SEB
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
MCS==:MCS
TCS==:TCS
DBMS==:DBMS
DEBUG==:DEBUG
RPW==:RPW
XPNTST==:XPNTST
;EDITS
;NAME DATE COMMENTS
;V12*****************
;JSM 28-MAR-79 [670] FIX NESTED IF . ELSE PROBLEM
;V10*****************
;EHM 11-AUG-77 [506] ADD TEST FOR OVERFLOW OF DATTAB ETC. AND MAKE A CLEAN EXIT.
; 5-JAN-77 [415] ADD TEMTAB TABLE FOR USE
;SSC MAR-5-75 PLACED 6A EDIT %316 DIRECTLY IN V10
;DBT 4/17/75 STRAIGHTEN OUT TABLES INDEXED BY TABLE
; INDICES
;********************
TWOSEG
.COPYRIGHT ;Put COPYRIGHT statement in .REL file.
RELOC 400000
SALL
;THIS ROUTINE READS THE SOURCE PROGRAM AND TRACES IT
;THROUGH THE SYNTAX TREES.
;THE SYNTAX TREES ARE:
; IDTREE & EDTREE IN COBOLB.MAC,
; DDTREE IN COBOLC.MAC
; PDTREE IN COBOLD.MAC
;THE STANDARD FORMAT OF A TREE ENTRY (CALLED A NODE) IS:
;NAME: XWD ACTION-ADDRESS,MISC-CODES
; THE REMAINDER OF THE ENTRY CONSISTS OF HALF WORDS
; WHICH CONTAIN THE ADDRESSES OF OTHER NODES (CALLED SONS)
; TO WHICH SQUIRL CAN NOW BRANCH. THE LAST SON IS
; CALLED THE DEFAULT NODE.
;THE MISC-CODES ARE AS FOLLOWS:
;BITS 18-23 NUMBER OF BRANCHES AT THIS NODE (MINUS 1)
;BIT 24 1 IF THIS IS A PUSH-DOWN NODE
;BIT 25 1 IF THIS ITEM MUST BEGIN AT THE A-MARGIN
;BITS 26-35 THE ITEM-TYPE WHICH GOT SQUIRL TO THIS NODE
;SQUIRL STARTS AT THE FIRST NODE IN THE TREE. IT CALLS GETITM TO
;SCAN THE NEXT SOURCE ITEM AND DETERMINE ITS TYPE (E.G., DATA-NAME,
;RESERVED WORD, LITERAL). SQUIRL THEN COMPARES THIS TYPE-CODE WITH
;THE CODE OF EACH NODE TO WHICH THE CURRENT NODE CAN BRANCH. IF
;IT GETS A MATCH, THE ACTION SPECIFIED BY THAT BRANCH NODE IS
;EXECUTED, THEN THAT SON BECOMES THE CURRENT NODE AND THE PROCESS
;REPEATS.
;IF NO MATCH IS MADE, THE ACTION AT THE LAST (DEFAULT) NODE IS
;EXECUTED, AND THE DEFAULT NODE IS MADE THE CURRENT NODE.
;IF THERE IS ONLY 1 SON (DEFAULT), GETITM IS NOT CALLED.
;IN CERTAIN CASES SQUIRL USES A PART OF THE TREE AS A SUBTREE
;(ARITHMETIC EXPRESSIONS, CONDITIONAL EXPRESSIONS). IN THESE
;CASES THE CALLING NODE IS REFERRED TO AS A PUSH-DOWN NODE. ONCE
;THE SUBTREE IS EXHAUSTED, CONTROL RETURNS TO THE CURRENT NODE.
ENTRY SQURL.
SQURL.: MOVE NODE,(NODPTR) ;GET ADDRESS OF CURRENT NODE
IFN DEBUG,<
PUSHJ PP,PTNOD.## ;IF TRACING, LIST NODE+ACTION+ITEM
PUSHJ PP,PTACT.##
PUSHJ PP,PTTYP.##
>
HLRZ TA,(NODE) ;GET ACTION ADDRESS
JUMPE TA,SQGET ;JUMP IF NULL
CAIG TA,4000 ;IS IT AN ERROR OR AN ACTION?
JRST SQEUUO ;ERROR
PUSHJ PP,(TA) ;OTHERWISE PERFORM ACTION
SQGET: HRRZ NODE,(NODPTR) ;RE-GET ADDRESS OF CURRENT NODE
LDB NSONS,[POINT 6,(NODE),23] ;GET NUMBER OF DESCENDANTS
JUMPE NSONS,SQSHF ;0 IMPLIES DEFAULT ONLY
CAIN NSONS,77
JRST SQG.ER ;-1 IMPLIES NO SONS --- ERROR
MOVEM TYPE,PRVTOK## ;[670] SAVE ASIDE PREV TOKEN FLAG
IFN DBMS,<
SKIPN FINVOK## ;ARE WE IN AN INVOKE?
JRST SQ1 ;NO, PROCEED AS USUAL
MOVEM NODPTR,DBNODE##
PUSHJ PP,GETITM ;GET NEW WORD
SKIPN FINVOK ;RE-GET ITEM IF EOF WAS SEEN
SQ1:
>
PUSHJ PP,GETITM## ;GET NEXT SOURCE ITEM
MOVE NODE,(NODPTR) ;GET ADDRESS OF CURRENT NODE
HRRZ NSONS,(NODE) ;GET # OF DESCENDANT NODES (RIGHT JUSTIFIED)
LSH NSONS,-14
MOVE TA,[POINT 18,1(NODE)] ;SET UP BYTE POINTER TO SONS
MOVEM TA,PNTR## ;& FALL INTO LOOP
SQ2: ILDB SONADR,PNTR ;GET NEXT SON'S ADDRESS
JUMPE SONADR,SQG.ER ;NULL ADDRESS --- ERROR
MOVE SON,(SONADR) ;FIRST WORD OF SON
SOJGE NSONS,SQ2A ;JUMP IF NOT LAST SON
HRRZ NSONS,TYPE ;IF DEFAULT SON, EXIT LOOP WITH SON-TYPE IN NSONS
ANDI NSONS,001777
SQ2.2: SWON FREGWD ;TURN ON REGET WORD FLAG SINCE WE LOOKED
JRST SQ3 ;BUT DIDN'T USE IT
SQ2A: XOR SON,TYPE ;NOT DEFAULT --- COMPARE ITEM-TYPE & SON-TYPE
TRNE SON,AMRGN. ;IS MARGIN REQUIREMENT SAME IN ITEM AND SON?
TRNE TYPE,AMRGN. ;NO --- SKIP IF A-MARGIN REQUIRED
TRNE SON,AMRGN.-1 ;SKIP IF SAME TYPES
JRST SQ2 ;DIFFERENT --- TRY NEXT SON
JRST SQ3 ;SON MATCHES --- EXIT LOOP
;ARRIVE HERE IF ONLY ONE SON
SQSHF:
HLRZ SONADR,1(NODE) ;GET ADDRESS OF SON'S ADDRESS
MOVE SON,(SONADR) ;GET SON'S ADDRESS
SQ3: HRRZM SONADR,(NODPTR) ;MAKE SON THE CURRENT NODE
TRNN SON,004000 ;IS THIS A PUSHDOWN NODE?
JRST SQURL. ;NO
IFN DEBUG,<PUSHJ PP,PTPSH.##> ;LIST NODE PUSHING DOWN FROM
HRRZ SONADR,(NODPTR) ;GET ADDRESS OF CURRENT NODE
HLRZ TA,(SONADR) ;ACTION ADDRESS BECOMES CURRENT NODE
PUSH NODPTR,TA
JRST SQURL. ;GO TO NEW NODE
;BAD NODE CODE
SQG.ER:
IFE DEBUG,<
OUTSTR [ASCIZ /?COMPILER ERROR --- IMPROPER SYNTAX TREE AT PC = /]
>
IFN DEBUG,<
OUTSTR [ASCIZ /?COMPILER ERROR --- IMPROPER SYNTAX TREE AT NODE = /]
MOVE TE,-1(NODE) ;NAME OF NODE
MOVE TD,[POINT 6,TE]
HRRZI TC,6
ILDB CH,TD
ADDI CH," "
OUTCHR CH
SOJG TC,.-3
>
IFE DEBUG,<
MOVEI TE,(NODE) ;ADDRESS OF NODE
MOVE TD,[POINT 3,TE,17]
HRRZI TC,6
ILDB CH,TD
ADDI CH,"0"
OUTCHR CH
SOJG TC,.-3
>
OUTSTR [ASCIZ /
/]
JRST KILL## ;"CATASTROPHE"
;PERFORM ERROR ACTION
SQEUUO: HRLI TA,(EWARNW) ;MAKE EWARNW BE#. INTSRUCTION
XCT TA ;PERFORM THE ERROR UUO
JRST SQGET ;CONTINUE THROUGH TREE
SUBTTL TABLE AND STRING MANIPULATION ROUTINES
ENTRY GETVAL,GETV2,FINDAT
;GETVAL CONVERTS AN ASCII STRING OF CHARACTERS TO THE BINARY
; INTEGER IT REPRESENTS
;THE FIRST CHARACTER MAY BE A SIGN
;AT ENTRY TA==ABS. ADDR. OF CHARACTER STRING
;AND CTR==NUMBER OF CHARACTERS IN STRING
;AT EXIT TC==VALUE
;NO VALIDITY CHECKING OF THE INPUT IS PERFORMED
GETVAL: MOVE TD,[POINT 7,(TA)]
GETV2: SETZ TC, ;VALUE
HRRZI TE,1 ;SIGN
ILDB TB,TD ;FIRST CHARACTER
CAIN TB,53 ;+ SIGN?
JRST ENDLP ;YES
CAIE TB,55 ;- SIGN?
JRST GO ;NO
SETO TE, ;YES
JRST ENDLP
GETLP: ILDB TB,TD ;DIGIT
GO: ANDI TB,17 ;VALUE
IMULI TC,12 ;NUMBER*10.
ADD TC,TB ;+ DIGIT
ENDLP: SOSLE CTR##
JRST GETLP
IMUL TC,TE ;SIGN
POPJ PP,
;FIND AN ITEM IN DATAB
;ITEM SPECIFIED IN TBLOCK AS FOLLOWS:
;TBLOCK+0: USED TO STORE CURRENT DATAB LINK
; 1: # OF QUALIFIERS
; 2: INDEX TO QUALIFIERS
; 3: LINK TO MATCHING ITEM
; 4: W2 CONTENTS FOR DATA-NAME
; 5: NAMTAB LINK TO 1ST QUAL.
; 6: NAMTAB LINK TO 2ND QUAL.
; ETC.
;RETURNS WITH DATAB LINK IN TE
;OR WITH DW, LN, CP SET IF THERE WAS AN ERROR
FINDAT: LDB TA,[POINT 15,TBLOCK+4,15] ;GET 1ST DATAB LINK FOR ITEM
MOVEI TB,CD.DAT
PUSHJ PP,FNDLNK##
JRST FINDE1 ;NOT DEFINED
SETZM CTR ;CLR MATCH CTR
FIND11: MOVEM TB,TBLOCK## ;SAVE DATAB LINK OF ITEM
HLRZ TC,TB ;TC ALWAYS HAS LINK IN RIGHT HALF
SETZM TBLOCK+2 ;INIT QUALIFIER INDEX
SKIPN TBLOCK+1 ;ANY QUALIFIERS?
JRST FIND8 ;NO, THIS IS A MATCH
FIND5: AOS TB,TBLOCK+2 ;AIM AT NEXT QUALIFIER
CAMLE TB,TBLOCK+1 ;FINISHED ALL QUALS?
JRST FIND8 ;YES, WE HAVE A MATCH
HRRZ TD,TBLOCK+4(TB) ;NO, GET NAMTAB LINK OF NEXT QUAL
FIND6: HRRZI TA,(TC) ;AIM AT DATAB ENTRY
ANDI TA,077777
ADD TA,DATLOC##
LDB TC,DA.BRO## ;GET FATHER/BROTHER LINK
JUMPE TC,FIND14 ;DOESN'T HAVE ONE
LDB TB,DA.FAL## ;IS IT A FATHER LINK?
JUMPE TB,FIND6 ;NO, KEEP GOING
MOVEI TA,(TC) ;GET FATHERS NAME
ANDI TA,077777
TRNN TC,700000 ;IS THIS A DATAB OR A FILTAB LINK?
JRST FIND3 ;FILTAB
ADD TA,DATLOC##
LDB TB,DA.NAM##
CAIE TB,(TD) ;DOES NAME MATCH ONE WE WANT?
JRST FIND6 ;NO
JRST FIND5 ;YES, TRY NEXT QUAL.
FIND3: MOVEI TE,(TA) ;SAVE EXTRA COPY OF TA
MOVE TB,TBLOCK+2 ;MAKE SURE NO QUALS ABOVE THIS
CAMGE TB,TBLOCK+1
JRST FIND15 ;FILE CAN'T BE A MATCH SINCE THERE ARE MORE QUALS
HRRZ TB,FILLOC## ;OK, GET ABS. FILTAB PTR
ADDI TA,(TB)
HRRZ TB,FILNXT## ;IS PTR IN FILTAB RANGE?
CAILE TA,(TB)
JRST FIND14 ;NO
LDB TB,FI.NAM## ;WHAT'S HIS NAME?
CAIE TB,(TD) ;IS IT WHAT WE WANT?
JRST FIND14 ;NO
IFE RPW,<
FIND8: >
AOS CTR ;COUNT MATCHING ITEM
MOVE TA,TBLOCK ;& SAVE LINK TO IT
MOVEM TA,TBLOCK+3
FIND14:
IFN RPW,<
HRRZ TA,RPWLOC## ;MAKE ABS PTR TO RPWTAB
ADDI TA,(TE)
HRRZ TB,RPWNXT## ;IS PTR IN RPWTAB RANGE?
CAILE TA,(TB)
JRST FIND15 ;NO
LDB TB,RW.NAM## ;FIND HIS NAME
CAIE TB,(TD) ;DOES IT MATCH?
JRST FIND15 ;NO
FIND8: AOS CTR ;COUNT MATCHING ITEM
MOVE TA,TBLOCK ;& SAVE LINK TO IT
MOVEM TA,TBLOCK+3
>
FIND15:
MOVE TA,TBLOCK ;GET NEXT DATAB ITEM IN SAME-NAME CHAIN
PUSHJ PP,FNDNXT##
JRST FIND10 ;NO MORE OF THIS NAME
JRST FIND11 ;OK, TRY THIS ONE FOR A MATCH
FIND10: MOVE TE,CTR
JUMPE TE,FINDE1 ;IF CTR = 0, ITEM IS NOT DEFINED
SOJG TE,FINDE2 ;IF CTR > 1, QUALIFICATION IS AMBIGUOUS
HLRZ TE,TBLOCK+3 ;IF CTR = 1, GET DATAB LINK TO THE MATCH
SETZ DW, ;NO ERRORS
POPJ PP,
FINDE1: HRRZI DW,E.104 ;UNDEFINED
FINDEX: LDB LN,[POINT 13,TBLOCK+4,28]
LDB CP,[POINT 7,TBLOCK+4,35]
POPJ PP,
FINDE2: HRRZI DW,E.332 ;INSUFFICIENT QUALIFICATION
JRST FINDEX
END