.TITLE EVALUATE PARSED LINE .SUBTITLE DATA STORAGE AREA .ENABLE DEBUG .PSECT IMPURE_DATA,RD,WRT,NOSHR,LONG,NOEXE,GBL,CON,NOVEC DESCRIPTER: .LONG 0,0 COMMON_DESCRIPTER: ;V1.11 .LONG 0,0 ;V1.11 COMMON_NAME_STRING: ;V1.11 .BLKB 32 ;V1.11 BLANK_COMMON_STRING: ;V1.17 .BYTE 14 ;V1.17 .ASCII /(BLANK_COMMON)/ ;V1.17 .REPEAT 18 ;V1.17 .BYTE 0 ;V1.17 .ENDR ;V1.17 FIELD_COUNT: .LONG 0 ;V3.00 CURRENT_TYPE_POINTER: ;V3.05 .LONG 0 ;V3.05 ARG2: .LONG 0 ARG3: .LONG 0 ARG4: .LONG 0 ARG5: .LONG 0 ;V3.00 LABEL_STORAGE: .BLKB 6 PARREN_LEVEL: .LONG 0 TEMPORARY_FLAG: .LONG 0 OTHER_FLAG: .LONG 0 CALLED_ARG_NUMBER: ;V2.08 .LONG 0 ;V2.08 ENTRY_POINT_POINTER: ;V2.09 .LONG 0 ;V2.09 ARG_INSERT_EQ: .LONG 6 ;V1.15 .ADDRESS DESCRIPTER,ARG2,ARG3,ARG4 ;V1.15 .LONG -1 ;V1.15 EQ_LOC: .LONG 0 ;V1.15 .PSECT PURE_DATA,RD,NOWRT,SHR,GBL,NOEXE,GBL,CON,NOVEC ARG_FREE: .LONG 2 .ADDRESS ARG2,ARG3 ARG_INSERT: .LONG 6 ;V1.15 .ADDRESS DESCRIPTER,ARG2,ARG3,ARG4,COMMON_DESCRIPTER ;V1.11 .LONG -1 ;V1.15 ARG_INSERT_CALLING_ARG: ;V2.09 .LONG 8 ;V2.09 .ADDRESS DESCRIPTER,ARG2,ARG3,ARG4 ;V2.09 .LONG -1,-1 ;V2.09 .ADDRESS CALLED_ARG_NUMBER,ENTRY_POINT_POINTER ;V2.09 ARG_INSERT_CALL_ARG: .LONG 7 ;V2.08 .ADDRESS DESCRIPTER,ARG2,ARG3,ARG4 ;V2.08 .LONG -1,-1 ;V2.08 .ADDRESS CALLED_ARG_NUMBER ;V2.08 ARG_RECORD: ;V3.00 .LONG 5 ;V3.00 .ADDRESS DESCRIPTER,ARG2,ARG3,ARG4,ARG5 ;V3.00 ARG_FLAG: .LONG 1 .ADDRESS DESCRIPTER DEF_BLOCK_DATA: .ASCID /BLOCK_DATA/ TAXING: .ASCID /INDEX-E-Unknown Line Type or Syntax Error/ ST_SYN: .ASCID /INDEX-E-Structured Variable Syntax Error/ ;V3.00 NO_DICTIONARY: ;V3.00 .ASCID /INDEX-W-CDD "DICTIONARY" Directive not Supported/ ;V3.00 .PAGE .SUBTITLE EVALUATION DISPATCH TABLE .SUBTITLE COMMON LINE EVALUATION CODE .SUBTITLE GET LABEL DEFINITIONS .PSECT CODE,RD,NOWRT,SHR,EXE,GBL,CON,NOVEC .ENTRY EVAL,^M CLRL ENTRY_POINT_POINTER ;V2.09 CLRL CALLED_ARG_NUMBER ;V2.09 CLRL CURRENT_TYPE_POINTER ;V3.05 ; STEP ONE-SCAN THE SOURCE LINE TABLE FOR LABELS AND ENTER IN SYMBOL TABLE MOVL #,R11 ;GET STARTING ADDRESS 1$: ADDL2 #136,R11 ;GO TO NEXT SOURCE LINE TSTL (R11) ;SEE IF IN USE BEQL 50$ ;NO-DONE SCAN ADDL3 #4,R11,R10 ;GET START OF LINE ADDL3 #5,R10,R9 ;SET BOUNDRY AT COLL 6 MOVAL LABEL_STORAGE,R8 CLRL R7 ;CLEAR LEADING ZERO FLAG CLRL R6 ;CLEAR CHR COUNTER 2$: CMPB #^A/ /,(R10) ;CHECK FOR BLANK SKIP BEQL 10$ CMPB #9,(R10) ;TAB TERMINATES BEQL 20$ TSTL R7 ;CHECK LEADING ZERO FLAG BNEQ 3$ CMPB #^A/0/,(R10) ;CHECK CHR AS LEADING ZERO BEQL 10$ 3$: CMPB #^A/0/,(R10) ;SEE IF NUMBER BGTR 20$ ;NON_NUMBER TERMINATES CMPB #^A/9/,(R10) BLSS 20$ INCL R7 ;SET LEADING ZERO FLAG MOVB (R10),(R8)+ ;SAVE LABEL INCL R6 10$: INCL R10 ;UPDATE TO NEXT CHR CMPL R10,R9 ;SEE IF FOUND END YET BLSS 2$ ;NO-CONTINUE 20$: TSTL R6 ;SEE IF LABEL TO STORE BEQL 30$ ;NO MOVL R6,DESCRIPTER ;SET UP CALL FOR LOAD OF SYMBOL MOVAL LABEL_STORAGE,DESCRIPTER+4 MOVL #TOKEN_EVAL_LABEL,ARG2 MOVL (R11),ARG3 MOVL #0,ARG4 CALLG ARG_INSERT,STORE_SYMBOL 30$: BRW 1$ 50$: .PAGE .SUBTITLE EVALUATION DISPATCH TABLE LOGICAL_IF_LOOP_BACK: SUBL3 #5000,EVALUATION_ROUTINE_TOKEN,R0 ;V1.31 INCL LINE_TYPE_STAT[R0] ;V1.31 CASEL EVALUATION_ROUTINE_TOKEN,#5000,# ;V1.23 100$: .WORD PARSE_ACCEPT-100$ .WORD PARSE_ASSIGN-100$ .WORD PARSE_ARITH-100$ .WORD PARSE_BACKSPACE-100$ .WORD PARSE_BLOCKDATA-100$ .WORD PARSE_BYTE-100$ .WORD PARSE_BYTE_FUNCTION-100$ .WORD PARSE_CALL-100$ .WORD PARSE_CALLED_BY_ARG-100$ .WORD PARSE_CALLING_ARG-100$ .WORD PARSE_CHARACTER-100$ .WORD PARSE_CHARACTER_FUNCTION-100$ .WORD PARSE_CLOSE-100$ .WORD PARSE_COMMON-100$ .WORD PARSE_COMMON_NAME-100$ .WORD PARSE_COMPLEX-100$ .WORD PARSE_COMPLEX_FUNCTION-100$ .WORD PARSE_CONTINUE-100$ .WORD PARSE_DATA-100$ .WORD PARSE_DECODE-100$ .WORD PARSE_DEFINEFILE-100$ .WORD PARSE_DELETE_COMPLEX-100$ .WORD PARSE_DICTIONARY-100$ ;V3.00 .WORD PARSE_DIMENSION-100$ .WORD PARSE_DO-100$ .WORD PARSE_DOUBLE_PRECISION-100$ .WORD PARSE_DOUBLE_PRECISION_FN-100$ .WORD PARSE_DOUBLE_COMPLEX-100$ .WORD PARSE_DOUBLE_CPLX_FUNCTION-100$ .WORD PARSE_EQUIVALENCE-100$ .WORD PARSE_ELSE-100$ .WORD PARSE_ELSEIF-100$ .WORD PARSE_ENCODE-100$ .WORD PARSE_END-100$ .WORD PARSE_ENDDO-100$ .WORD PARSE_ENDFILE-100$ .WORD PARSE_ENDIF-100$ .WORD PARSE_ENDMAP-100$ ;V3.00 .WORD PARSE_ENDSTRUCTURE-100$ ;V3.00 .WORD PARSE_ENDUNION-100$ ;V3.00 .WORD PARSE_ENTRY-100$ .WORD PARSE_ERROR-100$ .WORD PARSE_EXTERNAL-100$ .WORD PARSE_FORMAT-100$ .WORD PARSE_FIND_COMPLEX-100$ .WORD PARSE_FUNCTION-100$ .WORD PARSE_GOTO-100$ .WORD PARSE_IF-100$ .WORD PARSE_INQUIRE-100$ .WORD PARSE_IMPLICITNONE-100$ .WORD PARSE_IMPLICIT-100$ .WORD PARSE_INCLUDE-100$ .WORD PARSE_INTEGER-100$ .WORD PARSE_INTEGER_FUNCTION-100$ .WORD PARSE_INTRINSIC-100$ .WORD PARSE_LABEL-100$ .WORD PARSE_LOCAL_FUNCTION-100$ .WORD PARSE_LOGICAL-100$ .WORD PARSE_LOGICAL_FUNCTION-100$ .WORD PARSE_MAP-100$ ;V3.00 .WORD PARSE_NAMELIST-100$ .WORD PARSE_NAMELIST_NAME-100$ .WORD PARSE_OPEN-100$ .WORD PARSE_OPTION-100$ .WORD PARSE_PARAMETER-100$ .WORD PARSE_PAUSE-100$ .WORD PARSE_PRINT-100$ .WORD PARSE_PROGRAM-100$ .WORD PARSE_QUAD-100$ .WORD PARSE_QUAD_FUNCTION-100$ .WORD PARSE_READ_SIMPLE-100$ .WORD PARSE_READ_COMPLEX-100$ .WORD PARSE_REAL-100$ .WORD PARSE_REAL_FUNCTION-100$ .WORD PARSE_REWRITE_COMPLEX-100$ .WORD PARSE_RECORD-100$ ;V3.00 .WORD PARSE_RETURN-100$ .WORD PARSE_REWIND-100$ .WORD PARSE_SAVE-100$ .WORD PARSE_STOP-100$ .WORD PARSE_STRUCTURE-100$ ;V3.00 .WORD PARSE_SUBROUTINE-100$ .WORD PARSE_TYPE-100$ .WORD PARSE_UNION-100$ ;V3.00 .WORD PARSE_UNLOCK-100$ .WORD PARSE_USED-100$ .WORD PARSE_VIRTUAL-100$ .WORD PARSE_VOLITILE-100$ ;V3.00 .WORD PARSE_WRITE_SIMPLE-100$ .WORD PARSE_WRITE_COMPLEX-100$ .SUBTITLE START OF INDIVIDUAL KEY WORD PARSING ROUTINES .PAGE .SUBTITLE ACCEPT,READ_SIMPLE/TYPE/PRINT/WRITE_SIMPLE ; ALL THESE ARE HANDLED THE SAME-TOKEN IS IN EVALUATION_ROUTINE_TOKEN ; ALL ELSE IS IDENTICAL PARSE_ACCEPT: PARSE_READ_SIMPLE: MOVL #,TEMPORARY_FLAG BRB PARSE_SIO PARSE_PRINT: PARSE_TYPE: PARSE_WRITE_SIMPLE: MOVL #,TEMPORARY_FLAG PARSE_SIO: MOVAL LINE_TOKEN_QUEUE,R11 ;GET THE LINE TOKEN QUEUE MOVL R11,R10 ;USE A COPY OF ADDRESS MOVL @(R10),R10 ;GET SYMBOL AFTER KEY WORD ; THIS IS EITHER AN IDENTIFIER OR NUMBER IN THE FORMAT ; POSITION-GET EITHER CMPW #TOKEN_ASTERISK,12(R10) ;BUT NOT ASTERISK BEQL 1$ MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER CLRL DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER MOVL EVALUATION_ROUTINE_TOKEN,ARG2 ;MENMONIC TOKEN MOVL 8(R10),ARG3 ;LINE NUMBER MOVL #SYMBOL_FLAG_USED,ARG4 ;FLAGS CALLG ARG_INSERT,STORE_SYMBOL CALLS #0,CHECK_RECORD ;V3.00 ; THE REST OF THE LINE, ONLY IDENTIFIERS ARE STORED 1$: MOVL (R10),R10 ;GET NEXT TOKEN CMPL R10,R11 ;ARE WE DONE?? BEQL 100$ CMPW #TOKEN_IDENTIFIER,12(R10) ;IS IT A TOKEN BNEQ 1$ ;NO GO TO NEXT TOKEN MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 ;MENMONIC TOKEN ;V1.8 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL TEMPORARY_FLAG,ARG4 ;CLEAR FLAG CALLG NULL,PARSE_CALLED_FUNCTION ;V1.3 BLBS R0,2$ ;V1.3 CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL ;V1.3 CALLS #0,CHECK_RECORD ;V3.00 2$: BRW 1$ ;V1.3 100$: RET .PAGE .SUBTITLE NO FURTHER PARSEING REQUIRED ARGUMENT/CONTINUE .SUBTITLE ELSE/ENDDO/ENDIF/IMPLICIT .SUBTITLE PAUSE/STOP/USED/COMMON_NAME/CONTINUE .SUBTITLE ; THESE ITEMS FOR THE PURPOSE OF CROSS REFERENCEING DO NOT ; CONTAIN AN INFORMATION WORTH SAVEING OR ARE DUMMYS MEANT ONLY FOR ; THE DECLARATION OF MNEMONICS ACTUALLY USED ELSEWARE PARSE_CALLED_BY_ARG: PARSE_CALLING_ARG: PARSE_COMMON_NAME: PARSE_CONTINUE: PARSE_ELSE: PARSE_ENDIF: PARSE_ENDDO: PARSE_LABEL: PARSE_LOCAL_FUNCTION: PARSE_NAMELIST_NAME: PARSE_PAUSE: PARSE_STOP: PARSE_USED: PARSE_ENDMAP: ;V3.00 PARSE_ENDUNION: ;V3.00 PARSE_ENDSTRUCTURE: ;V3.00 PARSE_UNION: ;V3.00 PARSE_MAP: ;V3.00 RET .PAGE ;V3.05 .SUBTITLE IMPLICT NONE ;V3.05 PARSE_IMPLICITNONE: ;V3.05 ; SET ALL DEFAULTS FOR ALL VARS TO NULL ;V3.05 OFFSET=0 ;V3.05 .REPEAT 26 ;V3.05 MOVL #TYPE_NIL,L^DEFAULT_TYPES+OFFSET ;V3.05 OFFSET=OFFSET+4 ;V3.05 .ENDR ;V3.05 RET ;V3.05 .PAGE ;V3.05 .SUBTITLE IMPLICIT ;V3.05 PARSE_IMPLICIT: ;V3.05 MOVAL LINE_TOKEN_QUEUE,R11 ;GET POINTER TO TOKENS ;V3.05 MOVL @(R11),R10 ;GET POINTER TO FIRST TYPE ;V3.05 ; GET THE TYPE TO SET THE DEFAULT TO ;V3.05 IMPLICIT_LOOP: ;V3.05 MOVZWL 14(R10),R8 ;GET SIZE OF STRING ;V3.05 SUBL2 #16,R8 ;V3.05 BGTR 1$ ;JUST IN CASE-THIS IS ERROR ;V3.05 JMP PARSE_ERROR ;TAX COLLECTOR ;V3.05 1$: ;V3.05 .MACRO CHECK_TYPE NAME_TOKEN,FOUND_IT_DEST,?A ;V3.05 MULL3 #<'NAME_TOKEN'-1>,#8,R9 ;GET OFFSET INTO KEYWORD TABLE ;V3.05 CMPW L^KEY_WORD_TABLE(R9),R8 ;MUST BE SAME SIZE ;V3.05 BNEQ A ;NO-FORGET IT ;V3.05 CMPC3 R8,16(R10),@L^KEY_WORD_TABLE+4(R9);SEE IF FOUND IT ;V3.05 BNEQ A ;NOPE ;V3.05 BRW FOUND_IT_DEST ;YES ;V3.05 A: ;V3.05 .ENDM ;V3.05 CHECK_TYPE TOKEN_BYTE,IMPLICIT_BYTE ;V3.05 CHECK_TYPE TOKEN_CHARACTER,IMPLICIT_CHARACTER ;V3.05 CHECK_TYPE TOKEN_COMPLEX,IMPLICIT_COMPLEX ;V3.05 CHECK_TYPE TOKEN_DOUBLECOMPLEX,IMPLICIT_DOUBLECOMPLEX ;V3.05 CHECK_TYPE TOKEN_DOUBLEPRECISION,IMPLICIT_DOUBLEPRECISION ;V3.05 CHECK_TYPE TOKEN_INTEGER,IMPLICIT_INTEGER ;V3.05 CHECK_TYPE TOKEN_LOGICAL,IMPLICIT_LOGICAL ;V3.05 CHECK_TYPE TOKEN_REAL,IMPLICIT_REAL ;V3.05 BRW PARSE_ERROR ;NO MATCH-ERROR ;V3.05 ; SET POINTER TO DESCRIPTER FOR NEW TYPE ;V3.05 IMPLICIT_BYTE: ;V3.05 MOVAL TYPE_B_1,R9 ;V3.05 BRW IMPLICIT_LETTER ;V3.05 IMPLICIT_CHARACTER: ;V3.05 MOVAL TYPE_CHR,R9 ;V3.05 BRW IMPLICIT_LETTER ;V3.05 IMPLICIT_COMPLEX: ;V3.05 ; SEE IF IT IS SIMPLE COMPLEX OR *8 OR *16 ;V3.05 MOVL (R10),R8 ;GET NEXT TOKEN ;V3.05 CMPW #TOKEN_LEFT_PARREN,12(R8) ;SIMPLE FORM ?? ;V3.05 BEQL 1$ ;YES ;V3.05 CMPW #TOKEN_OCTAL_BYTES,12(R8) ;SINGLE PRECISION ;V3.05 BEQL 1$ ;YES ;V3.05 CMPW #TOKEN_HEX_BYTES,12(R8) ;DOUBLE PRECISION ;V3.05 BEQL 2$ ;YES ;V3.05 BRW PARSE_ERROR ;NO-ERROR ;V3.05 1$: MOVAL TYPE_C_F,R9 ;SET SIMPLE FLOATING TYPE ;V3.05 BRW IMPLICIT_LETTER ;V3.05 2$: ;SEE IF D.P. IS D OR G FORMAT ;V3.05 BITL #OPTION_G_FLOATING_FLAG,FLAG_WORD+4 ;V3.05 BEQL 3$ ;YES-G_FORM ;V3.17 MOVAL TYPE_C_G,R9 ;V3.05 BRW IMPLICIT_LETTER ;V3.05 3$: MOVAL TYPE_C_D,R9 ;V3.05 BRW IMPLICIT_LETTER ;V3.05 IMPLICIT_DOUBLECOMPLEX: ;V3.05 BITL #OPTION_G_FLOATING_FLAG,FLAG_WORD+4 ;V3.05 BEQL 3$ ;YES-G_FORM ;V3.17 MOVAL TYPE_C_G,R9 ;V3.05 BRW IMPLICIT_LETTER ;V3.05 3$: MOVAL TYPE_C_D,R9 ;V3.05 BRW IMPLICIT_LETTER ;V3.05 IMPLICIT_DOUBLEPRECISION: ;V3.05 BITL #OPTION_G_FLOATING_FLAG,FLAG_WORD+4 ;V3.05 BEQL 3$ ;YES-G_FORM ;V3.17 MOVAL TYPE_R_G,R9 ;V3.05 BRW IMPLICIT_LETTER ;V3.05 3$: MOVAL TYPE_R_D,R9 ;V3.05 BRW IMPLICIT_LETTER ;V3.05 IMPLICIT_INTEGER: ;V3.05 ; SEE IF IT IS SIMPLE INTEGER OR *2 OR *4 ;V3.05 MOVL (R10),R8 ;GET NEXT TOKEN ;V3.05 CMPW #TOKEN_LEFT_PARREN,12(R8) ;SIMPLE FORM ?? ;V3.05 BEQL 1$ ;YES ;V3.05 CMPW #TOKEN_TWO_BYTES,12(R8) ;WORD PRECISION ;V3.05 BEQL 2$ ;YES ;V3.05 CMPW #TOKEN_FOUR_BYTES,12(R8) ;LONG PRECISION ;V3.05 BEQL 3$ ;YES ;V3.05 BRW PARSE_ERROR ;NO-ERROR ;V3.05 3$: MOVAL TYPE_I_4,R9 ;SET LONG INTEGER TYPE ;V3.05 BRW IMPLICIT_LETTER ;V3.05 2$: MOVAL TYPE_I_2,R9 ;SET WORD INTEGER TYPE ;V3.05 BRW IMPLICIT_LETTER ;V3.05 1$: ;SEE IF *2 OR *4 ;V3.05 BITL #OPTION_NOI4_FLAG,FLAG_WORD+4 ;V3.05 BNEQ 4$ ;YES-*2_FORM ;V3.05 MOVAL TYPE_I_4,R9 ;V3.05 BRW IMPLICIT_LETTER ;V3.05 4$: MOVAL TYPE_I_2,R9 ;V3.05 BRW IMPLICIT_LETTER ;V3.05 IMPLICIT_LOGICAL: ;V3.05 ; SEE IF IT IS SIMPLE LOGICAL OR *1 OR *2 OR *4 ;V3.05 MOVL (R10),R8 ;GET NEXT TOKEN ;V3.05 CMPW #TOKEN_LEFT_PARREN,12(R8) ;SIMPLE FORM ?? ;V3.05 BEQL 1$ ;YES ;V3.05 CMPW #TOKEN_TWO_BYTES,12(R8) ;WORD PRECISION ;V3.05 BEQL 2$ ;YES ;V3.05 CMPW #TOKEN_FOUR_BYTES,12(R8) ;LONG PRECISION ;V3.05 BEQL 3$ ;YES ;V3.05 CMPW #TOKEN_ONE_BYTE,12(R8) ;BYTE ;V3.05 BEQL 5$ ;V3.05 BRW PARSE_ERROR ;NO-ERROR ;V3.05 5$: MOVAL TYPE_L_1,R9 ;SET BYTE LOGICAL TYPE ;V3.05 BRW IMPLICIT_LETTER ;V3.05 3$: MOVAL TYPE_L_4,R9 ;SET LONG LOGICAL TYPE ;V3.05 BRW IMPLICIT_LETTER ;V3.05 2$: MOVAL TYPE_L_2,R9 ;SET WORD LOGICAL TYPE ;V3.05 BRW IMPLICIT_LETTER ;V3.05 1$: ;SEE IF *2 OR *4 ;V3.05 BITL #OPTION_NOI4_FLAG,FLAG_WORD+4 ;V3.05 BNEQ 4$ ;YES-*2_FORM ;V3.05 MOVAL TYPE_L_4,R9 ;V3.05 BRW IMPLICIT_LETTER ;V3.05 4$: MOVAL TYPE_L_2,R9 ;V3.05 BRW IMPLICIT_LETTER ;V3.05 IMPLICIT_REAL: ;V3.05 ; SEE IF IT IS *4 *8 OR *16 ;V3.05 MOVL (R10),R8 ;GET NEXT TOKEN ;V3.05 CMPW #TOKEN_LEFT_PARREN,12(R8) ;SIMPLE FORM ?? ;V3.05 BEQL 1$ ;YES ;V3.05 CMPW #TOKEN_FOUR_BYTES,12(R8) ;SINGLE PRECISION ;V3.05 BEQL 1$ ;YES ;V3.05 CMPW #TOKEN_HEX_BYTES,12(R8) ;QUAD PRECISION ;V3.05 BEQL 2$ ;YES ;V3.05 CMPW #TOKEN_OCTAL_BYTES,12(R8) ;DOUBLE PRECISION ;V3.05 BEQL 4$ ;V3.05 BRW PARSE_ERROR ;NO-ERROR ;V3.05 1$: MOVAL TYPE_R_F,R9 ;SET SIMPLE FLOATING TYPE ;V3.05 BRW IMPLICIT_LETTER ;V3.05 2$: MOVAL TYPE_R_H,R9 ;SET QUAD FLOATING TYPE ;V3.05 BRW IMPLICIT_LETTER ;V3.05 4$: ;SEE IF D.P. IS D OR G FORMAT ;V3.05 BITL #OPTION_G_FLOATING_FLAG,FLAG_WORD+4 ;V3.05 BEQL 3$ ;YES-G_FORM ;V3.17 MOVAL TYPE_R_G,R9 ;V3.05 BRW IMPLICIT_LETTER ;V3.05 3$: MOVAL TYPE_R_D,R9 ;V3.05 BRW IMPLICIT_LETTER ;V3.05 IMPLICIT_LETTER: ;V3.05 ; R9 POINTS TO THE STRING DESCRIPTER OF THE TYPE,SKIP TO TOKEN FOLLOWING ;V3.05 ; THE LEFT PARREN ;V3.05 1$: MOVL (R10),R10 ;V3.05 CMPL R10,R11 ;SEE IF AT END OF LINE ;V3.05 BNEQ 2$ ;V3.05 RET ;V3.05 2$: CMPW #TOKEN_LEFT_PARREN,12(R10) ;V3.05 BNEQ 1$ ;V3.05 MOVL (R10),R10 ;V3.05 CMPL R10,R11 ;V3.05 BNEQ 3$ ;V3.05 RET ;V3.05 3$: CMPW #TOKEN_IDENTIFIER,12(R10) ;MUST BE IDENTIFIER ;V3.05 BEQL 4$ ;YES ;V3.05 BRW PARSE_ERROR ;OOPS ;V3.05 4$: MOVZBL 16(R10),R8 ;GET STARTING LETTER ;V3.05 MOVL R8,R7 ;DEFAULT STOP LETTER ;V3.05 MOVL (R10),R6 ;GET NEXT TOKEN ;V3.05 CMPW #TOKEN_MINUS,12(R6) ;SEE IF RANGE DEFINED ;V3.05 BNEQ 10$ ;NO-JUST ONE LETTER ;V3.05 MOVL @(R10),R10 ;GET TOKEN FOLLOWING "-" ;V3.05 CMPL R10,R11 ;V3.05 BNEQ 5$ ;V3.05 BRW PARSE_ERROR ;V3.05 5$: CMPW #TOKEN_IDENTIFIER,12(R10) ;MUST BE IDENTIFIER ;V3.05 BEQL 6$ ;YES ;V3.05 BRW PARSE_ERROR ;OOPS ;V3.05 6$: MOVZBL 16(R10),R7 ;GET STOP LETTER ;V3.05 10$: ; TIME TO START RESET OF DEFAULT TYPE ;V3.05 ; R11 ADDR OF LINE_TOKEN_QUEUE HEADER ;V3.05 ; R10 POINTER TO CURRENT QUEUE ELEMENT ;V3.05 ; R9 POINTER TO TYPE STRING DESCRIPTER ;V3.05 ; R8 CONTAINS START LETTER ;V3.05 ; R7 CONTAINS STOP LETTER ;V3.05 ; NOW SET UP OFFSETS FOR START AND STOP ;V3.05 SUBL2 #^A/A/,R8 ;V3.05 SUBL2 #^A/A/,R7 ;V3.05 CMPL R8,R7 ;V3.05 BLEQ 12$ ;V3.05 MOVL R7,R6 ;V3.05 MOVL R8,R7 ;V3.05 MOVL R6,R8 ;V3.05 12$: MULL2 #4,R8 ;V3.05 MULL2 #4,R7 ;V3.05 11$: MOVL R9,L^DEFAULT_TYPES(R8) ;V3.05 ADDL2 #4,R8 ;V3.05 CMPL R8,R7 ;V3.05 BLEQ 11$ ;V3.05 ; THIS ONE HAS BEEN SET UP-NOW SEE IS ANOTHER SET TO DO IN THIS SET? ;V3.05 MOVL (R10),R10 ;V3.05 CMPL R10,R11 ;V3.05 BNEQ 13$ ;V3.05 RET ;V3.05 13$: CMPW #TOKEN_RIGHT_PARREN,12(R10) ;V3.05 BEQL 50$ ;DONE THIS SET-GO SEE IF ANOTHER SET ;V3.05 CMPW #TOKEN_COMMA,12(R10) ;MUST BE HERE ;V3.05 BEQL 20$ ;V3.05 BRW PARSE_ERROR ;V3.05 20$: MOVL (R10),R10 ;SKIP PAST COMMA-SHOULD BE IDENTIFIER ;V3.05 CMPL R10,R11 ;SEE IF DONE ;V3.05 BNEQ 21$ ;V3.05 RET ;V3.05 21$: BRW 3$ ;GO DO NEXT SEQUENCE IN SET ;V3.05 ; END OF SET-SEE IF ANOTHER SET COMEING ;V3.05 50$: MOVL (R10),R10 ;SKIP PARREN-SHOULD BE END OF LINE OR COMMA ;V3.05 CMPL R10,R11 ;SEE IF DONE ;V3.05 BNEQ 51$ ;V3.05 RET ;V3.05 51$: CMPW #TOKEN_END_OF_LINE,12(R10) ;V3.05 BNEQ 52$ ;V3.05 RET ;V3.05 52$: CMPW #TOKEN_COMMA,12(R10) ;V3.05 BEQL 53$ ;V3.22 BRW PARSE_ERROR ;V3.05 53$: MOVL (R10),R10 ;SKIP COMMA-SHOULD BE IDENT ;V3.05 CMPL R10,R11 ;SEE IF DONE ;V3.05 BNEQ 54$ ;V3.05 RET ;V3.05 54$: BRW IMPLICIT_LOOP ;GO DO NEXT SET ;V3.05 .PAGE ;V3.00 .SUBTITLE OPTION ;V3.00 ; PARSE THE OPTION COMMAND TO SEE IF THE /EXTENDSOURCE COMMAND ;V3.00 ; WAS ISSUED ;V3.00 PARSE_OPTION: ;V3.00 ; NEEDS TO CHECK FOR THE FOLLOWING SWITCHES AND (RE)SET THE OPTION FLAGS ;V3.05 ; AS REQUIRED IN THE FLAG_WORD ;V3.05 MOVAL LINE_TOKEN_QUEUE,R11 ;GET START OF LINE TOKEN QUEUE ;V3.00 MOVL @(R11),R10 ;GET TOKEN FOLLOWING "OPTION" TOKEN ;V3.00 1$: CMPL R10,R11 ;SEE IF DONE ;V3.00 BNEQ 2$ ;NO-CONTINUE CHECK ;V3.00 CALLG NULL,SET_DEFAULT_VAR_TYPE ;V3.05 RET ;V3.00 2$: CMPW #TOKEN_SLASH,12(R10) ;SEE IF START OF SWITCH SEQUENCE ;V3.05 BEQL 1002$ ;V3.05 BRW 3$ ;V3.05 1002$: MOVL (R10),R10 ;GET NEXT TOKEN ;V3.05 CMPL R10,R11 ;SEE IF DONE ;V3.05 BNEQ 5$ ;V3.05 CALLG NULL,SET_DEFAULT_VAR_TYPE ;V3.05 RET ;V3.05 5$: CMPW #TOKEN_IDENTIFIER,12(R10) ;SEE IF A TEXT STRING ;V3.05 BEQL 1005$ ;V3.05 BRW 3$ ;NO ;V3.05 1005$: MOVAL 16(R10),R9 ;GET ADDR OF STRING ;V3.05 CVTWL 14(R10),R8 ;CALC LENGTH OF STRING ;V3.00 SUBL2 #16,R8 ;V3.00 ; CHECK OPTIONS WITH ATLEAST 4 CHRS ;V3.05 CMPL #4,R8 ;V3.05 BGTR 6$ ;V3.05 CMPL #^A/NOEX/,(R9) ;"NOEXTEND_SOURCE" ;V3.05 BNEQ 7$ ;NO ;V3.05 BICL #OPTION_EXTEND_SOURCE_FLAG,FLAG_WORD+4 ;V3.05 BRB 3$ ;V3.05 7$: CMPL #^A/NOI4/,(R9) ;"NOI4" ;V3.05 BNEQ 8$ ;NO ;V3.05 BISL #OPTION_NOI4_FLAG,FLAG_WORD+4 ;V3.05 BRB 3$ ;V3.05 8$: CMPL #^A/NOG_/,(R9) ;"NOG_FLOATING" ;V3.05 BNEQ 9$ ;NO ;V3.05 BICL #OPTION_G_FLOATING_FLAG,FLAG_WORD+4 ;V3.05 BRB 3$ ;V3.05 9$: CMPL #^A/EXTE/,(R9) ;"EXTEND_SOURCE" ;V3.05 BNEQ 10$ ;NO ;V3.05 BISL #OPTION_EXTEND_SOURCE_FLAG,FLAG_WORD+4 ;V3.05 BRB 3$ ;V3.05 10$: CMPL #^A/G_FL/,(R9) ;"G_FLOAT" ;V3.05 BNEQ 6$ ;NO ;V3.05 BISL #OPTION_G_FLOATING_FLAG,FLAG_WORD+4 ;V3.05 BRB 3$ ;V3.05 6$: CMPL #2,R8 ;ROOM FOR I4? ;V3.05 BGTR 3$ ;NO ;V3.05 CMPW #^A/I4/,(R9) ;"I4" ;V3.05 BNEQ 11$ ;NO ;V3.21 BICL #OPTION_NOI4_FLAG,FLAG_WORD+4 ;V3.05 BRB 3$ ;V3.21 11$: ; OTHER SWITCH NOT NEEDED BY INDEX ;V3.21 3$: MOVL (R10),R10 ;NEXT TOKEN ;V3.00 BRW 1$ ;AND TRY AGAIN ;V3.05 .PAGE ;V3.00 .SUBTITLE STRUCTURE STATEMENT ;V3.00 PARSE_STRUCTURE: ;V3.00 CLRL PARREN_LEVEL ;V3.00 CLRL FIELD_COUNT ;V3.00 MOVAL LINE_TOKEN_QUEUE,R11 ;GET THE START OF THE QUEUE ;V3.00 MOVL @(R11),R10 ;GET TOKEN FOLLOWING STRUCTURE STATEMENT;V3.00 1$: CMPL R10,R11 ;SEE IF DONE ;V3.00 BNEQ 2$ ;NO-CONTINUE CHECK ;V3.00 RET ;V3.00 2$: CMPW #TOKEN_SLASH,12(R10) ;SEE IF DEF STRUTURE ;V3.03 BEQL 11$ ;YES ;V3.03 CMPB #1,STRUCTURE_LEVEL ;SEE IF THERE SHOULD HAVE BEEN ONE HERE LV3.05 BEQL 10002$ ;V3.05 BRW 12$ ;NO ;V3.03 10002$: CLRB STRUCTURE_LEVEL ;V3.05 CLRB STRUCTURE_COUNT ;V3.05 BRW PARSE_ERROR ;V3.05 11$: MOVL (R10),R10 ;GET NAME OF STRUCTURE ;V3.03 CMPL R10,R11 ;SEE IF DONE ;V3.03 BNEQ 13$ ;V3.03 RET ;V3.03 13$: CMPW #TOKEN_IDENTIFIER,12(R10) ;V3.03 BEQL 14$ ;V3.03 PUSHAL ST_SYN ;V3.03 CALLS #1,G^LIB$PUT_OUTPUT ;V3.03 PUSHAL ST_SYN ;V3.03 CALLS #1,ERROR_LINE ;V3.03 RET ;V3.03 14$: MOVAL 16(R10),DESCRIPTER+4 ;GET ADDR OF STRING ;V3.03 SUBW3 #16,14(R10),DESCRIPTER ;GET LENGTH OF STRING ;V3.03 CLRW DESCRIPTER+2 ;V3.03 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 ;V3.03 MOVL 8(R10),ARG3 ;V3.03 MOVL #SYMBOL_FLAG_STRUCTURE,ARG4 ;V3.03 CALLG ARG_INSERT,STORE_SYMBOL ;V3.03 MOVL (R10),R10 ;GET FINAL SLASH ;V3.03 CMPL R10,R11 ;SEE IF DONE ;V3.03 BNEQ 15$ ;V3.03 RET ;V3.03 15$: CMPW #TOKEN_SLASH,12(R10) ;SEE IF END DEF STRUTURE NAME ;V3.03 BEQL 16$ ;V3.03 PUSHAL ST_SYN ;V3.03 CALLS #1,G^LIB$PUT_OUTPUT ;V3.03 PUSHAL ST_SYN ;V3.03 CALLS #1,ERROR_LINE ;V3.03 16$: BRW 7$ ;V3.03 12$: CMPW #TOKEN_IDENTIFIER,12(R10) ;SEE IF A TEXT STRING ;V3.03 BEQL 1002$ ;V3.00 BRW 3$ ;NO ;V3.00 1002$: MOVAL 16(R10),DESCRIPTER+4 ;GET ADDR OF STRING ;V3.00 SUBW3 #16,14(R10),DESCRIPTER ;GET LENGTH OF STRING ;V3.00 CLRW DESCRIPTER+2 ;V3.00 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 ;V3.00 MOVL 8(R10),ARG3 ;V3.00 MOVL #,ARG4 ;V3.00 TSTL FIELD_COUNT ;V3.00 BEQL 9$ ;V3.00 BISL #SYMBOL_FLAG_COMMON_STRUCTURE,ARG4 ;V3.00 9$: MOVL (R10),R0 ;GET NEXT ELELEMT ;V3.00 CMPL R0,R11 ;V3.00 BEQL 5$ ;V3.00 CMPW #TOKEN_LEFT_PARREN,12(R0) ;V3.00 BNEQ 5$ ;V3.00 BISL #SYMBOL_FLAG_ARRAY,ARG4 ;V3.00 5$: TSTL PARREN_LEVEL ;V3.00 BEQL 8$ ;V3.00 BISL #SYMBOL_FLAG_ARRAY_ELEMENT,ARG4 ;V3.00 8$: CALLG ARG_INSERT,STORE_SYMBOL ;V3.00 CALLS #0,CHECK_RECORD ;V3.00 BRB 10$ ;V3.00 3$: CMPW #TOKEN_LEFT_PARREN,12(R10) ;V3.00 BNEQ 6$ ;V3.00 INCL PARREN_LEVEL ;V3.00 BRB 7$ ;V3.00 6$: CMPW #TOKEN_RIGHT_PARREN,12(R10) ;V3.00 BNEQ 7$ ;V3.00 DECL PARREN_LEVEL ;V3.00 BRW 7$ ;V3.00 10$: CMPB #1,STRUCTURE_LEVEL ;V3.00 BGEQ 7$ ;V3.00 TSTL PARREN_LEVEL ;V3.00 BNEQ 7$ ;V3.00 INCL FIELD_COUNT ;V3.00 7$: MOVL (R10),R10 ;V3.00 BRW 1$ ;V3.00 .PAGE ;V3.00 .SUBTITLE RECORD DEFINITION ;V3.00 PARSE_RECORD: ;V3.00 ; GET THE NAME OF THE STRUCTURE BEING ELABORATED ;V3.00 CLRL PARREN_LEVEL ;V3.00 MOVAL LINE_TOKEN_QUEUE,R11 ;GET THE START OF THE QUEUE ;V3.00 MOVL @(R11),R10 ;GET TOKEN FOLLOWING RECORD STATEMENT ;V3.00 1$: CMPL R10,R11 ;SEE IF DONE ;V3.00 BNEQ 2$ ;NO-CONTINUE CHECK ;V3.00 RET ;V3.00 2$: CMPW #TOKEN_IDENTIFIER,12(R10) ;SEE IF A TEXT STRING ;V3.00 BNEQ 3$ ;NO ;V3.00 MOVAL 16(R10),DESCRIPTER+4 ;GET ADDR OF STRING ;V3.00 SUBW3 #16,14(R10),DESCRIPTER ;GET LENGTH OF STRING ;V3.00 CLRW DESCRIPTER+2 ;V3.00 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 ;V3.00 MOVL 8(R10),ARG3 ;V3.00 TSTB STRUCTURE_LEVEL ;V3.06 BNEQ 21$ ;V3.06 MOVL #,ARG4 ;V3.06 BRB 22$ ;V3.06 21$: MOVL #,ARG4 ;V3.06 22$: ;V3.06 MOVL (R10),R0 ;V3.00 CMPL R0,R11 ;V3.00 BEQL 15$ ;V3.00 CMPW #TOKEN_LEFT_PARREN,12(R0) ;V3.00 BNEQ 15$ ;V3.00 BISL #SYMBOL_FLAG_ARRAY,ARG4 ;V3.00 15$: CALLG ARG_INSERT,STORE_SYMBOL ;V3.00 MOVL R0,ARG5 ;V3.00 BRB 9$ ;V3.00 3$: MOVL (R10),R10 ;V3.00 BRW 1$ ;V3.06 9$: ;GOT STRUCURE NAME-NOW GET NAMES OF VARS WITH THAT STRUCTURE ;V3.00 MOVL (R10),R10 ;SKIP TO SLASH ;V3.00 CMPL R10,R11 ;SEE IF DONE ;V3.00 BEQL 8$ ;YES ;V3.00 MOVL (R10),R10 ;SKIP SLASH ;V3.00 10$: CMPL R10,R11 ;SEE IF DONE ;V3.00 BNEQ 12$ ;NO-CONTINUE CHECK ;V3.00 8$: RET ;V3.00 12$: CMPW #TOKEN_IDENTIFIER,12(R10) ;SEE IF A TEXT STRING ;V3.00 BEQL 1012$ ;V3.00 BRW 13$ ;NO ;V3.00 1012$: MOVAL 16(R10),DESCRIPTER+4 ;GET ADDR OF STRING ;V3.00 SUBW3 #16,14(R10),DESCRIPTER ;GET LENGTH OF STRING ;V3.00 CLRW DESCRIPTER+2 ;V3.00 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 ;V3.00 MOVL 8(R10),ARG3 ;V3.00 MOVL #SYMBOL_FLAG_RECORD,ARG4 ;V3.00 TSTB STRUCTURE_LEVEL ;V3.00 BEQL 2012$ ;V3.00 BISL2 #,ARG4 ;V3.25 2012$: MOVL (R10),R0 ;V3.00 CMPL R0,R11 ;V3.00 BEQL 16$ ;V3.00 CMPW #TOKEN_LEFT_PARREN,12(R0) ;V3.00 BNEQ 16$ ;V3.00 BISL #SYMBOL_FLAG_ARRAY,ARG4 ;V3.00 16$: TSTL PARREN_LEVEL ;V3.00 BEQL 20$ ;V3.00 BICL2 #,ARG4 ;V3.25 BISL #SYMBOL_FLAG_ARRAY_ELEMENT,ARG4 ;V3.00 CALLG ARG_INSERT,STORE_SYMBOL ;V3.00 CALLS #0,CHECK_RECORD ;V3.00 BRW 18$ ;V3.00 20$: CALLG ARG_RECORD,STORE_SYMBOL ;V3.00 BRW 18$ ;V3.00 13$: CMPW #TOKEN_SLASH,12(R10) ;NEW STRUCURE ELABORATON ;V3.00 BNEQ 14$ ;V3.00 BRW 1$ ;YES ;V3.00 14$: CMPW #TOKEN_LEFT_PARREN,12(R10) ;V3.00 BNEQ 17$ ;V3.00 INCL PARREN_LEVEL ;V3.00 BRB 18$ ;V3.00 17$: CMPW #TOKEN_RIGHT_PARREN,12(R10) ;V3.00 BNEQ 18$ ;V3.00 DECL PARREN_LEVEL ;V3.00 18$: MOVL (R10),R10 ;V3.00 BRW 10$ ;V3.00 .PAGE .SUBTITLE ASSIGN # TO VAR PARSE_ASSIGN: MOVAL LINE_TOKEN_QUEUE,R11 ;GET THE QUEUE MOVL @(R11),R10 ;GET LABEL TOKEN MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2;TOKEN MOVL 8(R10),ARG3 ;LINE MOVL #SYMBOL_FLAG_USED,ARG4 ;FLAG CALLG ARG_INSERT,STORE_SYMBOL CALLS #0,CHECK_RECORD ;V3.00 MOVL @(R10),R10 ;GET ASSIGNED VARIABLE TOKEN MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2;TOKEN MOVL 8(R10),ARG3 ;LINE MOVL #,ARG4 ;FLAG CALLG ARG_INSERT,STORE_SYMBOL CALLS #0,CHECK_RECORD ;V3.00 RET .PAGE .SUBTITLE ARITHMETIC/POSSABLE DEFINE LOCAL FUNCTION STATEMENT PARSE_ARITH: MOVAL LINE_TOKEN_QUEUE,R11 ;GET THE QUEUE MOVL (R11),R10 ;GET FIRST ENTRY MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2;TOKEN MOVL 8(R10),ARG3 ;LINE MOVL #,ARG4 ;FLAG CMPL #5,PROGRAM_LEVEL ;SEE IF RIGHT SPOT FOR ARITH FUNCT DEF BNEQ 50$ CALLG NULL,CHECK_FUNCTION BLBC R0,50$ ;YES-IT IS SOMETHING WITH A "()" ON IT MOVL #SYMBOL_FLAG_STATEMENT_FN,ARG4; SAY IT IS A LOCAL FUNCTION MOVL #TOKEN_EVAL_LOCAL_FUNCTION,ARG2 BRB 60$ 50$: MOVL #6,PROGRAM_LEVEL ;NOT S LOCAL FUNCTION STATEMENT ;UP PROGRAM LEVEL 60$: CALLG ARG_INSERT,STORE_SYMBOL CALLS #0,CHECK_RECORD ;V3.00 ; THE REST OF THE EVALUATION IS A SIMPLE LOOP STOREING IDENTIFIERS ONLY 101$: MOVL (R10),R10 ;GET NEXT TOKEN CMPL R10,R11 ;ARE WE DONE?? BEQL 100$ CMPW #TOKEN_IDENTIFIER,12(R10) ;IS IT A TOKEN BNEQ 101$ ;NO GO TO NEXT TOKEN MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL #TOKEN_EVAL_USED,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL #SYMBOL_FLAG_USED,ARG4 ;CLEAR FLAG CALLG NULL,PARSE_CALLED_FUNCTION ;V1.3 BLBS R0,102$ ;V1.3 CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL ;V1.3 CALLS #0,CHECK_RECORD ;V3.00 102$: BRW 101$ ;V1.3 100$: RET .PAGE .SUBTITLE I/O ROUTINES .SUBTITLE BACKSPACE/CLOSE/ENDFILE/INQUIRE/OPEN/REWIND/UNLOCK .SUBTITLE READ/WRITE/REWRITE/DELETE/FIND PARSE_READ_COMPLEX: MOVL #,TEMPORARY_FLAG CLRL OTHER_FLAG BRB PARSE_CIO PARSE_INQUIRE: MOVL #,TEMPORARY_FLAG MOVL #1,OTHER_FLAG BRB PARSE_CIO PARSE_WRITE_COMPLEX: MOVL #-1,OTHER_FLAG MOVL #SYMBOL_FLAG_USED,TEMPORARY_FLAG BRB PARSE_CIO PARSE_BACKSPACE: PARSE_CLOSE: PARSE_ENDFILE: PARSE_OPEN: PARSE_REWIND: PARSE_UNLOCK: PARSE_REWRITE_COMPLEX: PARSE_DELETE_COMPLEX: PARSE_FIND_COMPLEX: MOVL #SYMBOL_FLAG_USED,TEMPORARY_FLAG CLRL OTHER_FLAG PARSE_CIO: MOVAL LINE_TOKEN_QUEUE,R11 MOVL @(R11),R10 ;GET SECOND ELEMENT IN QUEUE CMPW #TOKEN_LEFT_PARREN,12(R10);SIMPLE OR COMPLEX FORM?? BNEQ 1$ BRW IO_COMPLEX_FORM ; SIMPLE FORM OF BACKSPACE,ENDFILE,REWIND,UNLOCK 10$: MOVL (R10),R10 ;GET NEXT TOKEN CMPL R10,R11 BEQL 50$ 1$: CMPW #TOKEN_IDENTIFIER,12(R10) ;LOOK ONLY AT IDENTIFIERS BNEQ 10$ MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL #SYMBOL_FLAG_USED,ARG4 ;CLEAR FLAG CALLG NULL,PARSE_CALLED_FUNCTION ;V1.3 BLBS R0,102$ ;YES-IT IS SOMETHING WITH A "()" ON IT ;V1.3 CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL ;V1.3 CALLS #0,CHECK_RECORD ;V3.00 102$: BRW 10$ ;V1.3 50$: RET IO_COMPLEX_FORM: MOVL (R10),R10 ;GO TO TOKEN FOLLOWING "(" ; LOOKING AT UNIT NUMBER LOCATION CMPW #4000,12(R10) ;SEE IF IN KEY WORD FORM BGTR 1$ CMPW #5000,12(R10) BLEQ 1$ JMP IO_KEY_WORD_LIST 1$: ; LOOP UNTILL ZERO PARREN LEVEL , OR ' OR ) FOUND CLRL PARREN_LEVEL 2$: TSTL PARREN_LEVEL BNEQ 3$ CMPW #TOKEN_RIGHT_PARREN,12(R10) BNEQ 202$ JMP GET_IO_LIST 202$: CMPW #TOKEN_QUOTE,12(R10) BNEQ 302$ JMP GET_IO_RECORD 302$: CMPW #TOKEN_COMMA,12(R10) BNEQ 3$ JMP GET_IO_FORMAT 3$: CMPW #TOKEN_LEFT_PARREN,12(R10) BNEQ 4$ INCL PARREN_LEVEL BRW 10$ 4$: CMPW #TOKEN_RIGHT_PARREN,12(R10) BNEQ 5$ DECL PARREN_LEVEL BRW 10$ 5$: CMPW #TOKEN_IDENTIFIER,12(R10) BEQL 3005$ JMP 10$ 3005$: MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL #SYMBOL_FLAG_USED,ARG4 ;CLEAR FLAG TSTL OTHER_FLAG ;CHECK FOR INTERNAL WRITE POSABILITY BGEQ 2005$ CALLG ARG_FLAG,GET_FLAG BITL #SYMBOL_FLAG_CHARACTER,R0 BEQL 2005$ BISL #,ARG4 2005$: CALLG NULL,PARSE_CALLED_FUNCTION ;V1.3 BLBS R0,10$ ;YES-IT IS SOMETHING WITH A "()" ON IT ;V1.3 102$: CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL CALLS #0,CHECK_RECORD ;V3.00 10$: MOVL (R10),R10 CMPL R10,R11 BNEQ 11$ RET 11$: BRW 2$ GET_IO_RECORD: ; DIRECT ACCESS FORM OF IO STATEMENT. GET RECORD NUMBER MOVL (R10),R10 ;GO TO TOKEN FOLLOWING "'" ; LOOKING AT UNIT NUMBER LOCATION CMPW #4000,12(R10) ;SEE IF IN KEY WORD FORM BGTR 1$ CMPW #5000,12(R10) BLEQ 1$ JMP IO_KEY_WORD_LIST 1$: ; LOOP UNTILL ZERO PARREN LEVEL , OR ) FOUND CLRL PARREN_LEVEL 2$: TSTL PARREN_LEVEL BNEQ 3$ CMPW #TOKEN_RIGHT_PARREN,12(R10) BNEQ 202$ JMP GET_IO_LIST 202$: CMPW #TOKEN_COMMA,12(R10) BNEQ 3$ JMP GET_IO_FORMAT 3$: CMPW #TOKEN_LEFT_PARREN,12(R10) BNEQ 4$ INCL PARREN_LEVEL BRW 10$ 4$: CMPW #TOKEN_RIGHT_PARREN,12(R10) BNEQ 5$ DECL PARREN_LEVEL BRB 10$ 5$: CMPW #TOKEN_IDENTIFIER,12(R10) BNEQ 10$ MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL #SYMBOL_FLAG_USED,ARG4 ;CLEAR FLAG CALLG NULL,PARSE_CALLED_FUNCTION ;V1.3 BLBS R0,10$ ;YES-IT IS SOMETHING WITH A "()" ON IT ;V1.3 102$: CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL CALLS #0,CHECK_RECORD ;V3.00 10$: MOVL (R10),R10 CMPL R10,R11 BNEQ 11$ RET 11$: BRW 2$ GET_IO_FORMAT: MOVL (R10),R10 ;SKIP PAST "," TO FORMAT SPECIFIER CMPW #4000,12(R10) ;SEE IF IN KEY WORD FORM BGTR 1$ CMPW #5000,12(R10) BLEQ 1$ JMP IO_KEY_WORD_LIST 1$: CMPW #TOKEN_NUMBER,12(R10) ;SEE IF NUMBER(LABEL) FORM BNEQ 100$ MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL #,ARG4 ;CLEAR FLAG CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL CALLS #0,CHECK_RECORD ;V3.00 MOVL (R10),R10 ;GET NEXT TOKEN-SHOULD BE "," OR ")" CMPW #TOKEN_RIGHT_PARREN,12(R10) BEQL 1001$ JMP IO_KEY_WORD_LIST 1001$: BRW GET_IO_LIST 100$: CLRL PARREN_LEVEL 2$: TSTL PARREN_LEVEL BNEQ 3$ CMPW #TOKEN_RIGHT_PARREN,12(R10) BNEQ 202$ JMP GET_IO_LIST 202$: CMPW #TOKEN_COMMA,12(R10) BNEQ 3$ JMP IO_KEY_WORD_LIST 3$: CMPW #TOKEN_LEFT_PARREN,12(R10) BNEQ 4$ INCL PARREN_LEVEL BRW 10$ 4$: CMPW #TOKEN_RIGHT_PARREN,12(R10) BNEQ 5$ DECL PARREN_LEVEL BRB 10$ 5$: CMPW #TOKEN_IDENTIFIER,12(R10) BNEQ 10$ MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL #SYMBOL_FLAG_USED,ARG4 ;CLEAR FLAG CALLG NULL,PARSE_CALLED_FUNCTION ;V1.3 BLBS R0,10$ ;YES-IT IS SOMETHING WITH A "()" ON IT ;V1.3 102$: CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL CALLS #0,CHECK_RECORD ;V3.00 10$: MOVL (R10),R10 CMPL R10,R11 BNEQ 11$ RET 11$: BRW 2$ IO_KEY_WORD_LIST_LOOP: MOVL (R10),R10 CMPL R10,R11 BNEQ IO_KEY_WORD_LIST RET IO_KEY_WORD_LIST: CMPW #TOKEN_COMMA,12(R10) BEQL IO_KEY_WORD_LIST_LOOP CMPW #TOKEN_RIGHT_PARREN,12(R10) BNEQ 1000$ JMP GET_IO_LIST 1000$: CVTWL 12(R10),R0 ;FOUR TYPES OF HANDLEING ;1 THOSE WITH STRINGS OR EXPRESSIONS FOLLOWING ;2 THOSE WITH LABEL'S OR EXPRESSIONS FOLLOWING ;3 THOSE WITH NO ARGUMENTS ;4 ONE THAT SPECIFIES AN EXTERNAL FUNCTION TO BE CALLED ; BREAK OUT THOSE WITH LABEL OR EXPRESSION ARGUMENTS FOLLOWING CMPW #TOKEN_FMT,R0 BNEQ 300$ JMP IO_LABEL 300$: CMPW #TOKEN_END_EQUAL,R0 BNEQ 400$ JMP IO_LABEL 400$: CMPW #TOKEN_ERR,R0 BNEQ 500$ JMP IO_LABEL ; BREAK OUT THOSE THAT HAVE EXTERNAL FUNCTION 500$: CMPW #TOKEN_USEROPEN,R0 BNEQ 1500$ JMP IO_EXTERNAL_FN 1500$: ; THOSE WITH NO ARGUMENTS CMPW #TOKEN_NOSPANBLOCKS,R0 BEQL IO_KEY_WORD_LIST_LOOP CMPW #TOKEN_READONLY,R0 BEQL IO_KEY_WORD_LIST_LOOP CMPW #TOKEN_SHARED,R0 BEQL IO_KEY_WORD_LIST_LOOP ; KEY WORD HAS STRING/VAR OR EXPRESSION AS ARGUMENT MOVL (R10),R10 ;GET NEXT TOKEN CMPW #TOKEN_QUOTED_STRING,12(R10) BEQL IO_KEY_WORD_LIST_LOOP CMPW #TOKEN_HOLLERITH_STRING,12(R10) BEQL IO_KEY_WORD_LIST_LOOP IO_BACK_LOOP: 100$: CLRL PARREN_LEVEL 2$: TSTL PARREN_LEVEL BNEQ 3$ CMPW #TOKEN_RIGHT_PARREN,12(R10) BNEQ 202$ JMP GET_IO_LIST 202$: CMPW #TOKEN_COMMA,12(R10) BNEQ 3$ JMP IO_KEY_WORD_LIST_LOOP 3$: CMPW #TOKEN_LEFT_PARREN,12(R10) BNEQ 4$ INCL PARREN_LEVEL BRW 10$ 4$: CMPW #TOKEN_RIGHT_PARREN,12(R10) BNEQ 5$ DECL PARREN_LEVEL BRW 10$ 5$: CMPW #TOKEN_IDENTIFIER,12(R10) BEQL 1005$ JMP 10$ 1005$: MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER TSTL OTHER_FLAG BLEQ 40$ CMPW #TOKEN_FILE,12(R10) BEQL 40$ CMPW #TOKEN_UNIT,12(R10) BEQL 40$ CMPW #TOKEN_DEFAULTFILE,12(R10) BEQL 40$ MOVL #,ARG4 BRB 41$ 40$: MOVL #,ARG4 41$: CALLG NULL,PARSE_CALLED_FUNCTION ;V1.3 BLBS R0,10$ ;YES-IT IS SOMETHING WITH A "()" ON IT ;V1.3 102$: CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL CALLS #0,CHECK_RECORD ;V3.00 10$: MOVL (R10),R10 CMPL R10,R11 BNEQ 11$ RET 11$: BRW 2$ IO_LABEL: MOVL (R10),R10 ;GET ARGUMENT CMPW #TOKEN_NUMBER,12(R10) ;IS IT A LABEL BEQL 1$ ;YES BRW IO_BACK_LOOP ;NO-TREAT AS EXTRESSION 1$: MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL #SYMBOL_FLAG_USED,ARG4 ;CLEAR FLAG CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL CALLS #0,CHECK_RECORD ;V3.00 JMP IO_KEY_WORD_LIST_LOOP IO_EXTERNAL_FN: MOVL (R10),R10 MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL #- ,ARG4 ;CLEAR FLAG CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL CALLS #0,CHECK_RECORD ;V3.00 JMP IO_KEY_WORD_LIST_LOOP GET_IO_LIST: MOVL (R10),R10 ;GET NEXT TOKEN CMPL R10,R11 BNEQ 1$ RET 1$: CMPW #TOKEN_IDENTIFIER,12(R10) BNEQ GET_IO_LIST MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL TEMPORARY_FLAG,ARG4 ;CLEAR FLAG CALLG NULL,PARSE_CALLED_FUNCTION ;V1.3 BLBS R0,102$ ;YES-IT IS SOMETHING WITH A "()" ON IT ;V1.3 CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL ;V1.3 CALLS #0,CHECK_RECORD ;V3.00 102$: BRW GET_IO_LIST ;V1.3 .PAGE .SUBTITLE BLOCKDATA/PROGRAM PARSE_BLOCKDATA: MOVAL DEF_BLOCK_DATA,R6 ;LOAD DEFAULT NAME FOR BLOCK DATA CVTWL (R6),R7 MOVC5 R7,@DEF_BLOCK_DATA+4,#0,#31,MODULE_NAME MOVC5 R7,@DEF_BLOCK_DATA+4,#^A/ /,#32,CURRENT_MODULE_NAME ;V1.26 INCL BLOCK_DATA_FLAG PARSE_PROGRAM: MOVAL LINE_TOKEN_QUEUE,R11 ;GET SECOND TOKEN MOVL @(R11),R10 ;SEE IF NAME EXISTS CMPL R10,R11 BNEQ 2$ ;V3.05 BRW 1$ ;V3.05 2$: MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER ;V3.05 SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL - #- ,ARG4 ;CLEAR FLAG CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL CALLS #0,CHECK_RECORD ;V3.00 MOVC5 DESCRIPTER,@DESCRIPTER+4,#0,#31,MODULE_NAME ;LOAD MODULE NAME MOVC5 DESCRIPTER,@DESCRIPTER+4,#^A/ /,#32,CURRENT_MODULE_NAME ;V1.26 INCL PROGRAM_FLAG PUSHAL TYPE_EPT ;V3.05 PUSHAL DESCRIPTER ;V3.05 CALLS #2,SET_VAR_TYPE ;V3.05 1$: RET .PAGE .SUBTITLE SIMPLE TYPE/ARRAY DECLARATIONS .SUBTITLE BYTE/LOGICAL/INTEGER/CHARACTER/DIMENSION/VIRTUAL .SUBTITLE VOLITILE ;V3.00 ; IGNORE ANY *LEN DECLARATIONS. MARK VARIABLES AS ARRAYS IF SUCH PARSE_CHARACTER: MOVL #1,OTHER_FLAG MOVAL TYPE_CHR,CURRENT_TYPE_POINTER ;V3.05 BRW PARSE_OTHER_TYPE_LIST PARSE_BYTE: MOVAL TYPE_B_1,CURRENT_TYPE_POINTER ;V3.05 CLRL OTHER_FLAG ;V3.05 BRW PARSE_OTHER_TYPE_LIST ;V3.05 PARSE_LOGICAL: MOVAL LINE_TOKEN_QUEUE,R11 ;GET HEAD OF TOKEN QUEUE ;V3.05 MOVL @(R11),R10 ;INIT TO SECOND ELEMENT ;V3.05 CMPW #TOKEN_IDENTIFIER,12(R10) ;V3.05 BEQL 3$ ;V3.05 CMPW #TOKEN_ONE_BYTE,12(R10) ;SEE IF LENGTH SET ;V3.05 BNEQ 4$ ;V3.05 MOVAL TYPE_L_1,CURRENT_TYPE_POINTER ;V3.05 BRB 2$ ;V3.05 4$: CMPW #TOKEN_TWO_BYTES,12(R10) ;V3.05 BEQL 1$ ;V3.05 CMPW #TOKEN_FOUR_BYTES,12(R10) ;V3.05 BEQL 5$ ;V3.05 BRW PARSE_ERROR ;V3.05 3$: BITL #OPTION_NOI4_FLAG,FLAG_WORD+4 ;V3.05 BNEQ 1$ ;V3.05 5$: MOVAL TYPE_L_4,CURRENT_TYPE_POINTER ;V3.05 BRB 2$ ;V3.05 1$: MOVAL TYPE_L_2,CURRENT_TYPE_POINTER ;V3.05 2$: CLRL OTHER_FLAG ;V3.05 BRB PARSE_OTHER_TYPE_LIST ;V3.05 PARSE_INTEGER: MOVAL LINE_TOKEN_QUEUE,R11 ;GET HEAD OF TOKEN QUEUE ;V3.05 MOVL @(R11),R10 ;INIT TO SECOND ELEMENT ;V3.05 CMPW #TOKEN_IDENTIFIER,12(R10) ;V3.05 BEQL 3$ ;V3.05 CMPW #TOKEN_TWO_BYTES,12(R10) ;V3.05 BEQL 1$ ;V3.05 CMPW #TOKEN_FOUR_BYTES,12(R10) ;V3.05 BEQL 5$ ;V3.05 BRW PARSE_ERROR ;V3.05 3$: BITL #OPTION_NOI4_FLAG,FLAG_WORD+4 ;V3.05 BNEQ 1$ ;V3.05 5$: MOVAL TYPE_I_4,CURRENT_TYPE_POINTER ;V3.05 BRB 2$ ;V3.05 1$: MOVAL TYPE_I_2,CURRENT_TYPE_POINTER ;V3.05 2$: CLRL OTHER_FLAG ;V3.05 BRB PARSE_OTHER_TYPE_LIST ;V3.05 PARSE_DIMENSION: PARSE_VIRTUAL: PARSE_VOLITILE: ;V3.00 CLRL OTHER_FLAG ; FOR CASE OF DOUBLE COMPLEX OR DOUBLE PRECISION NOT REAL*8 OR COMPLEX*16 PARSE_OTHER_TYPE_LIST: CLRL PARREN_LEVEL ;V3.00 MOVAL LINE_TOKEN_QUEUE,R11 ;GET HEAD OF TOKEN QUEUE MOVL (R11),R10 ;INIT TO FIRST ELEMENT 1$: ;INPUT LOOP FOR SIMPLE TYPE MOVL (R10),R10 ;GET NEXT TOKEN CMPL R10,R11 ;CHECK FOR DONE BNEQ 2$ ;NOT DONE RET ;DONE 2$: CMPW #TOKEN_IDENTIFIER,12(R10) BEQL 3$ ;V3.00 CMPW #TOKEN_LEFT_PARREN,12(R10) ;V3.00 BNEQ 4$ ;V3.00 INCL PARREN_LEVEL ;V3.00 BRB 1$ ;V3.00 4$: CMPW #TOKEN_RIGHT_PARREN,12(R10) ;V3.00 BNEQ 1$ ;V3.00 DECL PARREN_LEVEL ;V3.00 BRB 1$ ;V3.00 3$: MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER CLRL ARG4 ;CLEAR FLAG MOVL (R10),R9 ;LOOK AT FOLLOWING TOKEN FOR PARREN 104$: CMPL R9,R11 ;FOR POSSABLE FUNCTION NAME BEQL 102$ CMPW #TOKEN_LEFT_PARREN,12(R9) BEQL 103$ ; CHECK FOR LENGTH SPECIFICATION (CHARACTER LENGTH WOULD FOLLOW ()) CMPW #TOKEN_HEX_BYTES,12(R9) BEQL 105$ CMPW #TOKEN_FOUR_BYTES,12(R9) BEQL 105$ CMPW #TOKEN_TWO_BYTES,12(R9) BEQL 105$ CMPW #TOKEN_OCTAL_BYTES,12(R9) BEQL 105$ CMPW #TOKEN_ONE_BYTE,12(R9) BNEQ 102$ 105$: MOVL (R9),R9 BRB 104$ 103$: MOVL #SYMBOL_FLAG_ARRAY,ARG4; SAY IT IS AN ARRAY 102$: TSTL OTHER_FLAG BEQL 106$ BISL #SYMBOL_FLAG_CHARACTER,ARG4 106$: TSTL PARREN_LEVEL ;V3.00 BEQL 6$ ;V3.00 BISL #SYMBOL_FLAG_ARRAY_ELEMENT,ARG4 ;V3.00 6$: ;V3.00 CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL CALLS #0,CHECK_RECORD ;V3.00 TSTL PARREN_LEVEL ;SET TYPE FOR DECLARED SYMBOLS ONLY ;V3.00 BEQL 1006$ ;V3.05 BRW 7$ ;V3.05 1006$: TSTL CURRENT_TYPE_POINTER ;ONLY FOR TYPE DECLARATIONS ;V3.05 BNEQ 17$ ;V3.05 BRW 7$ ;V3.05 17$: CMPL #TYPE_L_1,CURRENT_TYPE_POINTER ;V3.05 BEQL 9$ ;V3.05 CMPL #TYPE_L_2,CURRENT_TYPE_POINTER ;V3.05 BEQL 9$ ;V3.05 CMPL #TYPE_L_4,CURRENT_TYPE_POINTER ;V3.05 BEQL 9$ ;V3.05 CMPL #TYPE_I_2,CURRENT_TYPE_POINTER ;V3.05 BEQL 10$ ;V3.05 CMPL #TYPE_I_4,CURRENT_TYPE_POINTER ;V3.05 BEQL 10$ ;V3.05 BRW 8$ ;V3.05 9$: MOVL (R10),R9 ;V3.05 CMPW #TOKEN_FOUR_BYTES,12(R9) ;V3.05 BNEQ 11$ ;V3.05 PUSHAL TYPE_L_4 ;V3.05 BRB 16$ ;V3.05 11$: CMPW #TOKEN_TWO_BYTES,12(R9) ;V3.05 BNEQ 12$ ;V3.05 PUSHAL TYPE_L_2 ;V3.05 BRB 16$ ;V3.05 12$: CMPW #TOKEN_ONE_BYTE,12(R9) ;V3.05 BNEQ 13$ ;V3.05 PUSHAL TYPE_L_1 ;V3.05 BRB 16$ ;V3.05 13$: BRW 8$ ;V3.05 10$: MOVL (R10),R9 ;V3.05 CMPW #TOKEN_FOUR_BYTES,12(R9) ;V3.05 BNEQ 14$ ;V3.05 PUSHAL TYPE_I_4 ;V3.05 BRB 16$ ;V3.05 14$: CMPW #TOKEN_TWO_BYTES,12(R9) ;V3.05 BNEQ 8$ ;V3.05 PUSHAL TYPE_I_2 ;V3.05 BRB 16$ ;V3.05 8$: PUSHL CURRENT_TYPE_POINTER ;V3.05 16$: PUSHAL DESCRIPTER ;V3.05 CALLS #2,SET_VAR_TYPE ;V3.05 7$: BRW 1$ ;V3.05 .PAGE .SUBTITLE SIMPLE ENTRY POINTS .SUBTITLE SUBROUTINE/[,BYTE,LOGICAL,INTEGER,CHARACTER]FUNCTION .SUBTITLE CALL/ENTRY ;SIMPLE FUNCTIONS WHOSE TYPES DON'T CHANGE DUE TO LENGTH SPEC ON NAME PART PARSE_BYTE_FUNCTION: MOVAL TYPE_B_1,CURRENT_TYPE_POINTER ;V3.05 BRW PARSE_OTHER_SIMPLE_FUNCTION ;V3.05 PARSE_LOGICAL_FUNCTION: MOVAL LINE_TOKEN_QUEUE,R11 ;GET HEAD OF TOKEN QUEUE ;V3.05 MOVL @(R11),R10 ;INIT TO SECOND ELEMENT ;V3.05 CMPW #TOKEN_FUNCTION,12(R10) ;MUST BE "FUNCTION" OR LEN SPEC ;V3.05 BNEQ 8$ ;IS LEN SPEC ;V3.05 MOVL (R10),R10 ;NEXT TOKEN IS FUNCTION NAME ;V3.05 CMPW #TOKEN_IDENTIFIER,12(R10);MAKE SURE ;V3.05 BEQL 7$ ;OK ;V3.05 BRW PARSE_ERROR ;NOT OK ;V3.05 7$: MOVL (R10),R10 ;GET ELEMENT FOLLOWING NAME ;V3.05 CMPL R10,R11 ;IF NONE USE DEFAULT ;V3.05 BEQL 3$ ;V3.05 CMPW #TOKEN_END_OF_LINE,12(R10) ;V3.05 BEQL 3$ ;V3.05 CMPW #TOKEN_LEFT_PARREN,12(R10);DITTO FOR LEFT PARREN ;V3.05 BEQL 3$ ;V3.05 BRB 8$ ;MUST BE LEN SPEC-USE IT ;V3.05 6$: ;LEN SPEC FOLLOWS "LOGICAL" BUT SEE IF OVERRIDEING SPEC FOLOWS IDENT ;V3.05 ; IF SO-USE THAT ONE ;V3.05 MOVL (R10),R9 ;V3.05 CMPW #TOKEN_FUNCTION,12(R9) ;MUST BE "FUNCTION" ;V3.05 BEQL 9$ ;V3.05 BRW PARSE_ERROR ;NOT OK ;V3.05 9$: MOVL (R9),R9 ;NEXT TOKEN IS FUNCTION NAME ;V3.05 CMPW #TOKEN_IDENTIFIER,12(R9);MAKE SURE ;V3.05 BEQL 10$ ;OK ;V3.05 BRW PARSE_ERROR ;NOT OK ;V3.05 10$: MOVL (R9),R9 ;GET ELEMENT FOLLOWING NAME ;V3.05 CMPL R9,R11 ;IF NONE USE DEFAULT ;V3.05 BEQL 3$ ;V3.05 CMPW #TOKEN_END_OF_LINE,12(R9) ;V3.05 BEQL 3$ ;V3.05 CMPW #TOKEN_LEFT_PARREN,12(R9);DITTO FOR LEFT PARREN ;V3.05 BEQL 3$ ;V3.05 MOVL R9,R10 ;V3.05 8$: CMPW #TOKEN_ONE_BYTE,12(R10) ;SEE IF LENGTH SET ;V3.05 BNEQ 4$ ;V3.05 MOVAL TYPE_L_1,CURRENT_TYPE_POINTER ;V3.05 BRB 2$ ;V3.05 4$: CMPW #TOKEN_TWO_BYTES,12(R10) ;V3.05 BEQL 1$ ;V3.05 CMPW #TOKEN_FOUR_BYTES,12(R10) ;V3.05 BEQL 5$ ;V3.05 BRW PARSE_ERROR ;V3.05 3$: BITL #OPTION_NOI4_FLAG,FLAG_WORD+4 ;V3.05 BNEQ 1$ ;V3.05 5$: MOVAL TYPE_L_4,CURRENT_TYPE_POINTER ;V3.05 BRB 2$ ;V3.05 1$: MOVAL TYPE_L_2,CURRENT_TYPE_POINTER ;V3.05 2$: BRW PARSE_OTHER_SIMPLE_FUNCTION ;V3.05 PARSE_INTEGER_FUNCTION: MOVAL LINE_TOKEN_QUEUE,R11 ;GET HEAD OF TOKEN QUEUE ;V3.05 MOVL @(R11),R10 ;INIT TO SECOND ELEMENT ;V3.05 CMPW #TOKEN_FUNCTION,12(R10) ;MUST BE "FUNCTION" OR LEN SPEC ;V3.05 BNEQ 8$ ;IS LEN SPEC ;V3.05 MOVL (R10),R10 ;NEXT TOKEN IS FUNCTION NAME ;V3.05 CMPW #TOKEN_IDENTIFIER,12(R10);MAKE SURE ;V3.05 BEQL 7$ ;OK ;V3.05 BRW PARSE_ERROR ;NOT OK ;V3.05 7$: MOVL (R10),R10 ;GET ELEMENT FOLLOWING NAME ;V3.05 CMPL R10,R11 ;IF NONE USE DEFAULT ;V3.05 BEQL 3$ ;V3.05 CMPW #TOKEN_END_OF_LINE,12(R10) ;V3.05 BEQL 3$ ;V3.05 CMPW #TOKEN_LEFT_PARREN,12(R10);DITTO FOR LEFT PARREN ;V3.05 BEQL 3$ ;V3.05 BRB 8$ ;MUST BE LEN SPEC-USE IT ;V3.05 6$: ;LEN SPEC FOLLOWS "INTEGER" BUT SEE IF OVERRIDEING SPEC FOLOWS IDENT ;V3.05 ; IF SO-USE THAT ONE ;V3.05 MOVL (R10),R9 ;V3.05 CMPW #TOKEN_FUNCTION,12(R9) ;MUST BE "FUNCTION" ;V3.05 BEQL 9$ ;V3.05 BRW PARSE_ERROR ;NOT OK ;V3.05 9$: MOVL (R9),R9 ;NEXT TOKEN IS FUNCTION NAME ;V3.05 CMPW #TOKEN_IDENTIFIER,12(R9);MAKE SURE ;V3.05 BEQL 10$ ;OK ;V3.05 BRW PARSE_ERROR ;NOT OK ;V3.05 10$: MOVL (R9),R9 ;GET ELEMENT FOLLOWING NAME ;V3.05 CMPL R9,R11 ;IF NONE USE DEFAULT ;V3.05 BEQL 3$ ;V3.05 CMPW #TOKEN_END_OF_LINE,12(R9) ;V3.05 BEQL 3$ ;V3.05 CMPW #TOKEN_LEFT_PARREN,12(R9);DITTO FOR LEFT PARREN ;V3.05 BEQL 3$ ;V3.05 MOVL R9,R10 ;V3.05 8$: CMPW #TOKEN_TWO_BYTES,12(R10) ;V3.05 BEQL 1$ ;V3.05 CMPW #TOKEN_FOUR_BYTES,12(R10) ;V3.05 BEQL 5$ ;V3.05 BRW PARSE_ERROR ;V3.05 3$: BITL #OPTION_NOI4_FLAG,FLAG_WORD+4 ;V3.05 BNEQ 1$ ;V3.05 5$: MOVAL TYPE_I_4,CURRENT_TYPE_POINTER ;V3.05 BRB 2$ ;V3.05 1$: MOVAL TYPE_I_2,CURRENT_TYPE_POINTER ;V3.05 2$: BRB PARSE_OTHER_SIMPLE_FUNCTION ;V3.05 PARSE_CHARACTER_FUNCTION: MOVAL TYPE_CHR,CURRENT_TYPE_POINTER ;V3.05 PARSE_SUBROUTINE: ;V3.05 PARSE_FUNCTION: ;V3.05 ;FOR DOUBLE PRECISION AND DOUBLE COMPLEX NOT OF FORM REAL*8 OR COMPLEX*16 PARSE_OTHER_SIMPLE_FUNCTION: CLRL OTHER_FLAG CLRL R8 ;CLEAR FLAG FOR UPDATE OF MODULE NAME INCL PROGRAM_FLAG BRB INPUT_SIMPLE_ENTRY_POINT PARSE_CALL: MOVL #1,OTHER_FLAG MOVL #1,R8 BRB INPUT_SIMPLE_ENTRY_POINT PARSE_ENTRY: CLRL OTHER_FLAG MOVL #1,R8 ;SET FLAG NOT TO UPDATE MODULE NAME INPUT_SIMPLE_ENTRY_POINT: MOVL #1,CALLED_ARG_NUMBER ;V2.08 MOVAL LINE_TOKEN_QUEUE,R11 ;GET POINTER TO QUEUE MOVL R11,R10 ;SET UP POINTER TO FIND NAME 1$: MOVL (R10),R10 ;GET NEXT TOKEN CMPL R10,R11 BNEQ 2$ RET 2$: CMPW #TOKEN_FUNCTION,12(R10) ;FIND LAST TOKEN BEFORE ENTRY POINT NAME BEQL 10$ CMPW #TOKEN_CALL,12(R10) BEQL 10$ CMPW #TOKEN_ENTRY,12(R10) BEQL 10$ CMPW #TOKEN_SUBROUTINE,12(R10) BNEQ 1$ 10$: MOVL (R10),R10 ;NEXT TOKEN IS ENTRY POINT NAME MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL #,ARG4;SET FLAG TSTL OTHER_FLAG BNEQ 11$ BISL #SYMBOL_FLAG_DEFINED_ENTRY_POINT,ARG4 BRB 12$ ;V1.3 11$: BISL #SYMBOL_FLAG_CALL_ENTRY_POINT,ARG4 ;V1.3 12$: CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL ;V1.3 CALLS #0,CHECK_RECORD ;V3.00 MOVL R0,ENTRY_POINT_POINTER ;V2.09 CLRL PARREN_LEVEL ;V2.09 TSTL CURRENT_TYPE_POINTER ;V3.05 BEQL 14$ ;V3.05 PUSHL CURRENT_TYPE_POINTER ;V3.05 PUSHAL DESCRIPTER ;V3.05 CALLS #2,SET_VAR_TYPE ;V3.05 14$: TSTL R8 ;UPDATE MODULE NAME ?? ;V3.05 BNEQ 20$ MOVC5 DESCRIPTER,@DESCRIPTER+4,#0,#31,MODULE_NAME MOVC5 DESCRIPTER,@DESCRIPTER+4,#^A/ /,#32,CURRENT_MODULE_NAME ;V1.26 ; LOOP TO INPUT ARGUMENT LIST 20$: MOVL (R10),R10 ;GET NEXT TOKEN CMPL R10,R11 ;SEE IF DONE BNEQ 21$ CLRL ENTRY_POINT_POINTER ;V2.09 CLRL CALLED_ARG_NUMBER ;V2.09 RET 21$: CMPW #TOKEN_IDENTIFIER,12(R10) ;IS IT AN IDENTIFIER BNEQ 3021$ ;V2.09 BRW 30$ ;V2.09 ; CHECK FOR ALTERNATE RETURNS 3021$: CMPW #TOKEN_RIGHT_PARREN,12(R10) ;V2.09 BNEQ 2021$ ;V2.09 DECL PARREN_LEVEL ;V2.09 BRW 20$ ;V2.09 2021$: CMPW #TOKEN_LEFT_PARREN,12(R10) ;V2.09 BNEQ 1021$ ;V2.09 INCL PARREN_LEVEL ;V2.09 BRB 19$ ;V2.09 1021$: CMPW #TOKEN_COMMA,12(R10) ; , FOLLOWED BY * OR & ;V2.09 BNEQ 20$ CMPL #1,PARREN_LEVEL ;V2.08 BNEQ 20$ ;V2.08 INCL CALLED_ARG_NUMBER ;V2.08 19$: MOVL (R10),R9 ;GET FOLLOWING TOKEN CMPW #TOKEN_ASTERISK,12(R9) BEQL 22$ CMPW #TOKEN_AMPERSAND,12(R9) BNEQ 20$ 22$: MOVL (R9),R9 ;NEXT TOKEN MUST BE A NUMBER CMPW #TOKEN_NUMBER,12(R9) BNEQ 20$ MOVAL 16(R9),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R9),DESCRIPTER CLRW DESCRIPTER+2 MOVL #TOKEN_EVAL_CALLING_ARG,ARG2 MOVL 8(R9),ARG3 ;LOAD LINE NUMBER MOVL #,ARG4;CLEAR FLAG CALLG ARG_INSERT_CALLING_ARG,STORE_SYMBOL ;PUT IN THE SYMBOL ;V2.09 CALLS #0,CHECK_RECORD ;V3.00 MOVL R9,R10 BRW 20$ 30$: MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER TSTL OTHER_FLAG BNEQ 31$ MOVL #,ARG4 MOVL #TOKEN_EVAL_CALLED_BY_ARG,ARG2 BRB 32$ 31$: MOVL #,ARG4 MOVL #TOKEN_EVAL_CALLING_ARG,ARG2 32$: CALLG NULL,PARSE_CALLED_FUNCTION ;V1.3 BLBS R0,102$ ;YES-IT IS SOMETHING WITH A "()" ON IT ;V1.3 TSTL OTHER_FLAG ;V2.08 BNEQ 1032$ ;V2.08 CALLG ARG_INSERT_CALL_ARG,STORE_SYMBOL ;V2.08 CALLS #0,CHECK_RECORD ;V3.00 BRB 102$ ;V2.08 1032$: CALLG ARG_INSERT_CALLING_ARG,STORE_SYMBOL ;PUT IN THE SYMBOL ;V2.09 CALLS #0,CHECK_RECORD ;V3.00 102$: BRW 20$ ;V1.3 .PAGE .SUBTITLE COMMON PARSE_COMMON: MOVC3 #32,BLANK_COMMON_STRING+1,COMMON_NAME_STRING ;V1.17 CVTBL BLANK_COMMON_STRING,COMMON_DESCRIPTER ;V1.17 MOVAL COMMON_NAME_STRING,COMMON_DESCRIPTER+4 ;V1.17 MOVAL LINE_TOKEN_QUEUE,R11 ;GET HEAD OF TOKEN QUEUE MOVL (R11),R10 ;INIT TO FIRST ELEMENT MOVL (R10),R9 ;SEE IF NEXT CHR IS SLASH ;V1.17 CMPW #TOKEN_SLASH,12(R9) ;V1.17 BEQL 1$ ;NO-WE HAVE A BLANK COMMON ;V1.17 MOVQ COMMON_DESCRIPTER,DESCRIPTER ;LOAD DESCRIPTER ;V1.17 MOVL #TOKEN_EVAL_COMMON_NAME,ARG2 ;V1.17 MOVL 8(R9),ARG3 ;LOAD LINE NUMBER ;V1.17 MOVL #SYMBOL_FLAG_GLOBAL!SYMBOL_FLAG_COMMON_NAME,ARG4;CLEAR FLAG ;V1.17 CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL ;V1.17 CALLS #0,CHECK_RECORD ;V3.00 1$: ;INPUT LOOP FOR COMMON MOVL (R10),R10 ;GET NEXT TOKEN CMPL R10,R11 ;CHECK FOR DONE BNEQ 2$ ;NOT DONE RET ;DONE 2$: CMPW #TOKEN_IDENTIFIER,12(R10) ;SEE IF IDENTIFIER BNEQ 1102$ ;V1.11 BRW 3$ ;YES ;V1.11 1102$: ;V1.11 CMPW #TOKEN_SLASH,12(R10) BNEQ 1$ ;NOT THE START OF COMMON NAME ; INPUT COMMON NAME MOVL (R10),R10 CMPL R10,R11 BNEQ 4$ RET 4$: MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL DESCRIPTER,COMMON_DESCRIPTER ;V1.11 MOVAL COMMON_NAME_STRING,COMMON_DESCRIPTER+4 ;V1.11 MOVC5 DESCRIPTER,16(R10),#0,#32,COMMON_NAME_STRING ;V1.11 MOVL #TOKEN_EVAL_COMMON_NAME,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL #SYMBOL_FLAG_GLOBAL!SYMBOL_FLAG_COMMON_NAME,ARG4;CLEAR FLAG CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL CALLS #0,CHECK_RECORD ;V3.00 MOVL (R10),R10 ;PASS CLOSEING SLASH FOR COMMON NAME CMPL R10,R11 BEQL 101$ ;V1.11 BRW 1$ ;V1.11 101$: RET ;V1.11 3$: MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER CLRL ARG4 ;V1.11 PUSHAL COMMON_DESCRIPTER ;SEE IF DECLARED ARG OR PARAM ;V1.11 CALLS #1,GET_FLAG ;V1.11 BITL #,R0 ;V1.11 BNEQ 112$ ;YES-USED BUT NOT A COMMON VAR ;V1.11 BISL2 #SYMBOL_FLAG_GLOBAL,ARG4 ;SET GLOBAL FLAG ;V1.11 BISL2 #SYMBOL_FLAG_IN_NAMED_COMMON,ARG4 ;V1.11 112$: ;V1.11 MOVL (R10),R9 ;LOOK AT FOLLOWING TOKEN FOR PARREN 104$: CMPL R9,R11 ;FOR POSSABLE ARRAY NAME BEQL 102$ CMPW #TOKEN_LEFT_PARREN,12(R9) BNEQ 102$ 103$: BISL2 #SYMBOL_FLAG_ARRAY,ARG4; SAY IT IS AN ARRAY 102$: CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL CALLS #0,CHECK_RECORD ;V3.00 BRW 1$ .PAGE .SUBTITLE NAMELIST PARSE_NAMELIST: MOVAL LINE_TOKEN_QUEUE,R11 ;GET HEAD OF TOKEN QUEUE MOVL (R11),R10 ;INIT TO FIRST ELEMENT 1$: ;INPUT LOOP FOR NAMELIST MOVL (R10),R10 ;GET NEXT TOKEN CMPL R10,R11 ;CHECK FOR DONE BNEQ 2$ ;NOT DONE RET ;DONE 2$: CMPW #TOKEN_IDENTIFIER,12(R10) ;SEE IF IDENTIFIER BEQL 3$ ;YES CMPW #TOKEN_SLASH,12(R10) BNEQ 1$ ;NOT THE START OF COMMON NAME ; INPUT NAMELIST NAME MOVL (R10),R10 CMPL R10,R11 BNEQ 4$ RET 4$: MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL #TOKEN_EVAL_NAMELIST_NAME,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL #,ARG4 ;CLEAR FLAG CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL CALLS #0,CHECK_RECORD ;V3.00 MOVL (R10),R10 ;PASS CLOSEING SLASH FOR COMMON NAME CMPL R10,R11 BNEQ 1$ RET 3$: MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL #,ARG4 ;CLEAR FLAG 102$: CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL CALLS #0,CHECK_RECORD ;V3.00 BRW 1$ .PAGE .SUBTITLE COMPLEX/DOUBLE COMPLEX PARSE_DOUBLE_COMPLEX: ; IS THE DECLARATION COMLPLEX *16 OR DOUBLE COMPLEX MOVAL LINE_TOKEN_QUEUE,R11 MOVL (R11),R11 ;GET FIRST ELEMENT CMPW #TOKEN_DOUBLECOMPLEX,12(R11) BNEQ 1$ BITL #OPTION_G_FLOATING_FLAG,FLAG_WORD+4 ;V3.05 BEQL 2$ ;V3.05 MOVAL TYPE_C_G,CURRENT_TYPE_POINTER ;V3.05 BRB 3$ ;V3.05 2$: MOVAL TYPE_C_D,CURRENT_TYPE_POINTER ;V3.05 3$: JMP PARSE_OTHER_TYPE_LIST ;WAS STRAGHT DECL. HANDLE SIMPLY ;V3.05 1$: BITL #OPTION_G_FLOATING_FLAG,FLAG_WORD+4 ;V3.05 BEQL 4$ ;V3.05 MOVAL TYPE_C_G,CURRENT_TYPE_POINTER ;V3.05 BRB PARSE_COMPLEX16 ;V3.05 4$: MOVAL TYPE_C_D,CURRENT_TYPE_POINTER ;V3.05 BRB PARSE_COMPLEX16 ;V3.05 PARSE_COMPLEX: MOVAL TYPE_C_F,CURRENT_TYPE_POINTER ;V3.05 PARSE_COMPLEX16: ;V3.05 CLRL PARREN_LEVEL ;V3.00 MOVAL LINE_TOKEN_QUEUE,R11 ;SET UP FOR SCAN MOVL R11,R10 ; SCAN TO FIRST IDENTIFIER 1$: MOVL (R10),R10 CMPL R10,R11 BNEQ 2$ RET 2$: CMPW #TOKEN_IDENTIFIER,12(R10) BEQL 5$ ;V3.00 CMPW #TOKEN_LEFT_PARREN,12(R10) ;V3.00 BNEQ 6$ ;V3.00 INCL PARREN_LEVEL ;V3.00 BRB 1$ ;V3.00 6$: CMPW #TOKEN_RIGHT_PARREN,12(R10) ;V3.00 BNEQ 1$ ;V3.00 DECL PARREN_LEVEL ;V3.00 BRB 1$ ;V3.00 5$: MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER ;V3.00 SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER CLRL ARG4 ;CLEAR FLAG MOVL (R10),R9 ;LOOK AT FOLLOWING TOKEN FOR PARREN OR ;LENGTH SPEC 104$: CMPL R9,R11 ;FOR POSSABLE ARRAY NAME OR ALT TYPE BEQL 102$ CMPW #TOKEN_OCTAL_BYTES,12(R9) ;LENGTH SPEC ?? BNEQ 105$ MOVL #TOKEN_EVAL_COMPLEX,ARG2;OVERWRITE DEFAULT TOKEN MOVL (R9),R9 CMPL R9,R11 BEQL 102$ BRB 106$ 105$: CMPW #TOKEN_HEX_BYTES,12(R9) BNEQ 106$ MOVL #TOKEN_EVAL_DOUBLE_COMPLEX,ARG2;OVERWRITE DEFAULT TOKEN MOVL (R9),R9 CMPL R9,R11 BEQL 102$ 106$: CMPW #TOKEN_LEFT_PARREN,12(R9) BNEQ 102$ 103$: MOVL #SYMBOL_FLAG_ARRAY,ARG4; SAY IT IS AN ARRAY 102$: CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL CALLS #0,CHECK_RECORD ;V3.00 TSTL PARREN_LEVEL ;V3.05 BNEQ 7$ ;V3.05 CMPL #TOKEN_EVAL_COMPLEX,ARG2 ;V3.05 BNEQ 15$ ;V3.05 PUSHAL TYPE_C_F ;V3.05 BRB 16$ ;V3.05 15$: BITL #OPTION_G_FLOATING_FLAG,FLAG_WORD+4 ;V3.05 BEQL 17$ ;V3.05 PUSHAL TYPE_C_G ;V3.05 BRB 16$ ;V3.05 17$: PUSHAL TYPE_C_D ;V3.05 16$: PUSHAL DESCRIPTER ;V3.05 CALLS #2,SET_VAR_TYPE ;V3.05 7$: BRW 1$ ;V3.05 .PAGE .SUBTITLE COMPLEX FUNCTION/DOUBLE COMPLEX FUNCTION PARSE_DOUBLE_CPLX_FUNCTION: MOVAL LINE_TOKEN_QUEUE,R11 ;SEE IF DIRECT OR COMPLEX*16 MOVL (R11),R10 CMPW #TOKEN_DOUBLECOMPLEX,12(R10) ;WAS IT A DIRECT D.C. DEC BNEQ 1$ ;NO CMPLX*16 BITL #OPTION_G_FLOATING_FLAG,FLAG_WORD+4 ;V3.05 BEQL 2$ ;V3.05 MOVAL TYPE_C_G,CURRENT_TYPE_POINTER ;V3.05 BRB 3$ ;V3.05 2$: MOVAL TYPE_C_D,CURRENT_TYPE_POINTER ;V3.05 3$: JMP PARSE_OTHER_SIMPLE_FUNCTION ;YES-HANDLE SIMPLY ;V3.05 1$: BITL #OPTION_G_FLOATING_FLAG,FLAG_WORD+4 ;V3.05 BEQL 4$ ;V3.05 MOVAL TYPE_C_G,CURRENT_TYPE_POINTER ;V3.05 BRB PARSE_COMPLEX16_FUNCTION ;V3.05 4$: MOVAL TYPE_C_D,CURRENT_TYPE_POINTER ;V3.05 BRB PARSE_COMPLEX16_FUNCTION ;V3.05 PARSE_COMPLEX_FUNCTION: MOVAL TYPE_C_F,CURRENT_TYPE_POINTER ;V3.05 PARSE_COMPLEX16_FUNCTION: ;V3.05 INCL PROGRAM_FLAG ; CHECK TO SEE IF LENGTH OVERIDE FOLLOWS ENTRY POINT IDENTIFIER MOVAL LINE_TOKEN_QUEUE,R11 MOVL (R11),R10 ; SKIP TO TOKEN FOLLOWING IDENTIFIER 1$: MOVL (R10),R10 CMPL R10,R11 BNEQ 2$ RET 2$: CMPW #TOKEN_IDENTIFIER,12(R10) BNEQ 1$ MOVL (R10),R10 ;GET FOLLOWING TOKEN AND CHECK FOR LENGTH CMPW #TOKEN_HEX_BYTES,12(R10) BNEQ 3$ MOVL #TOKEN_EVAL_DOUBLE_CPLX_FUNCTION,EVALUATION_ROUTINE_TOKEN BITL #OPTION_G_FLOATING_FLAG,FLAG_WORD+4 ;V3.05 BEQL 5$ ;V3.05 MOVAL TYPE_C_G,CURRENT_TYPE_POINTER ;V3.05 BRB 6$ ;V3.05 5$: MOVAL TYPE_C_D,CURRENT_TYPE_POINTER ;V3.05 6$: JMP PARSE_OTHER_SIMPLE_FUNCTION ;V3.05 3$: CMPW #TOKEN_OCTAL_BYTES,12(R10) BNEQ 4$ MOVL #TOKEN_EVAL_COMPLEX_FUNCTION,EVALUATION_ROUTINE_TOKEN MOVAL TYPE_C_F,CURRENT_TYPE_POINTER ;V3.05 4$: JMP PARSE_OTHER_SIMPLE_FUNCTION .PAGE .SUBTITLE REAL/QUAD/DOUBLE PRECISION PARSE_DOUBLE_PRECISION: ; IS THE DECLARATION REAL*8 OR DOUBLE PRECISION BITL #OPTION_G_FLOATING_FLAG,FLAG_WORD+4 ;V3.05 BEQL 2$ ;V3.05 MOVAL TYPE_R_G,CURRENT_TYPE_POINTER ;V3.05 BRB 3$ ;V3.05 2$: MOVAL TYPE_R_D,CURRENT_TYPE_POINTER ;V3.05 3$: MOVAL LINE_TOKEN_QUEUE,R11 ;V3.05 MOVL (R11),R11 ;GET FIRST ELEMENT CMPW #TOKEN_DOUBLEPRECISION,12(R11) BNEQ 1$ JMP PARSE_OTHER_TYPE_LIST ;WAS STRAGHT DECL. HANDLE SIMPLY 1$: BRB PARSE_REAL16 ;V3.05 PARSE_REAL: MOVAL TYPE_R_F,CURRENT_TYPE_POINTER ;V3.05 BRB PARSE_REAL16 ;V3.05 PARSE_QUAD: MOVAL TYPE_R_H,CURRENT_TYPE_POINTER ;V3.05 PARSE_REAL16: ;V3.05 CLRL PARREN_LEVEL ;V3.00 MOVAL LINE_TOKEN_QUEUE,R11 ;SET UP FOR SCAN MOVL R11,R10 ; SCAN TO FIRST IDENTIFIER 1$: MOVL (R10),R10 CMPL R10,R11 BNEQ 2$ RET 2$: CMPW #TOKEN_IDENTIFIER,12(R10) BEQL 5$ ;V3.00 CMPW #TOKEN_LEFT_PARREN,12(R10) ;V3.00 BNEQ 6$ ;V3.00 INCL PARREN_LEVEL ;V3.00 BRB 1$ ;V3.00 6$: CMPW #TOKEN_RIGHT_PARREN,12(R10) ;V3.00 BNEQ 1$ ;V3.00 DECL PARREN_LEVEL ;V3.00 BRB 1$ ;V3.00 5$: MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER ;V3.00 SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER CLRL ARG4 ;CLEAR FLAG MOVL (R10),R9 ;LOOK AT FOLLOWING TOKEN FOR PARREN OR ;LENGTH SPEC 104$: CMPL R9,R11 ;FOR POSSABLE ARRAY NAME OR ALT TYPE BEQL 102$ CMPW #TOKEN_OCTAL_BYTES,12(R9) ;LENGTH SPEC ?? BNEQ 105$ MOVL #TOKEN_EVAL_DOUBLE_PRECISION,ARG2;OVERWRITE DEFAULT TOKEN MOVL (R9),R9 CMPL R9,R11 BEQL 102$ BRB 106$ 105$: CMPW #TOKEN_HEX_BYTES,12(R9) BNEQ 107$ MOVL #TOKEN_EVAL_QUAD,ARG2;OVERWRITE DEFAULT TOKEN MOVL (R9),R9 CMPL R9,R11 BEQL 102$ BRB 106$ 107$: CMPW #TOKEN_FOUR_BYTES,12(R9) BNEQ 106$ MOVL #TOKEN_EVAL_REAL,ARG2 MOVL (R9),R9 CMPL R9,R11 BEQL 102$ 106$: CMPW #TOKEN_LEFT_PARREN,12(R9) BNEQ 102$ 103$: MOVL #SYMBOL_FLAG_ARRAY,ARG4; SAY IT IS AN ARRAY 102$: TSTL PARREN_LEVEL ;V3.00 BEQL 8$ ;V3.00 BISL #SYMBOL_FLAG_ARRAY_ELEMENT,ARG4 ;V3.00 8$: ;V3.00 CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL CALLS #0,CHECK_RECORD ;V3.00 TSTL PARREN_LEVEL ;V3.05 BNEQ 9$ ;V3.05 CMPL #TOKEN_EVAL_REAL,ARG2 ;V3.05 BNEQ 15$ ;V3.05 PUSHAL TYPE_R_F ;V3.05 BRB 16$ ;V3.05 15$: CMPL #TOKEN_EVAL_QUAD,ARG2 ;V3.05 BNEQ 19$ ;V3.05 PUSHAL TYPE_R_H ;V3.05 BRB 16$ ;V3.05 19$: BITL #OPTION_G_FLOATING_FLAG,FLAG_WORD+4 ;V3.05 BEQL 17$ ;V3.05 PUSHAL TYPE_R_G ;V3.05 BRB 16$ ;V3.05 17$: PUSHAL TYPE_R_D ;V3.05 16$: PUSHAL DESCRIPTER ;V3.05 CALLS #2,SET_VAR_TYPE ;V3.05 9$: BRW 1$ ;V3.05 .PAGE .SUBTITLE REAL FUNCTION/DOUBLE PRECISION FUNCTION/QUAD FUNCTION PARSE_DOUBLE_PRECISION_FN: BITL #OPTION_G_FLOATING_FLAG,FLAG_WORD+4 ;V3.05 BEQL 2$ ;V3.05 MOVAL TYPE_R_G,CURRENT_TYPE_POINTER ;V3.05 BRB 3$ ;V3.05 2$: MOVAL TYPE_R_D,CURRENT_TYPE_POINTER ;V3.05 3$: MOVAL LINE_TOKEN_QUEUE,R11 ;SEE IF DIRECT OR REAL*8 ;V3.05 MOVL (R11),R10 CMPW #TOKEN_DOUBLEPRECISION,12(R10) ;WAS IT A DIRECT D.P. DEC BNEQ 1$ ;NO REAL*8 JMP PARSE_OTHER_SIMPLE_FUNCTION ;YES-HANDLE SIMPLY 1$: BRB PARSE_REAL8_FUNCTION ;V3.05 PARSE_REAL_FUNCTION: MOVAL TYPE_R_F,CURRENT_TYPE_POINTER ;V3.05 BRB PARSE_REAL8_FUNCTION ;V3.05 PARSE_QUAD_FUNCTION: MOVAL TYPE_R_H,CURRENT_TYPE_POINTER ;V3.05 PARSE_REAL8_FUNCTION: ;V3.05 INCL PROGRAM_FLAG ; CHECK TO SEE IF LENGTH OVERIDE FOLLOWS ENTRY POINT IDENTIFIER MOVAL LINE_TOKEN_QUEUE,R11 MOVL (R11),R10 ; SKIP TO TOKEN FOLLOWING IDENTIFIER 1$: MOVL (R10),R10 CMPL R10,R11 BNEQ 2$ RET 2$: CMPW #TOKEN_IDENTIFIER,12(R10) BNEQ 1$ MOVL (R10),R10 ;GET FOLLOWING TOKEN AND CHECK FOR LENGTH CMPW #TOKEN_HEX_BYTES,12(R10) BNEQ 3$ MOVL #TOKEN_EVAL_QUAD_FUNCTION,EVALUATION_ROUTINE_TOKEN MOVAL TYPE_R_H,CURRENT_TYPE_POINTER ;V3.05 JMP PARSE_OTHER_SIMPLE_FUNCTION 3$: CMPW #TOKEN_OCTAL_BYTES,12(R10) BNEQ 4$ MOVL #TOKEN_EVAL_DOUBLE_PRECISION_FN,EVALUATION_ROUTINE_TOKEN BITL #OPTION_G_FLOATING_FLAG,FLAG_WORD+4 ;V3.05 BEQL 7$ ;V3.05 MOVAL TYPE_R_G,CURRENT_TYPE_POINTER ;V3.05 BRB 6$ ;V3.05 7$: MOVAL TYPE_R_D,CURRENT_TYPE_POINTER ;V3.05 6$: JMP PARSE_OTHER_SIMPLE_FUNCTION ;V3.05 4$: CMPW #TOKEN_FOUR_BYTES,12(R10) BNEQ 5$ MOVL #TOKEN_EVAL_REAL_FUNCTION,EVALUATION_ROUTINE_TOKEN MOVAL TYPE_R_F,CURRENT_TYPE_POINTER ;V3.05 5$: JMP PARSE_OTHER_SIMPLE_FUNCTION .PAGE .SUBTITLE SIMPLE LIST-NO FUNCTIONS HERE .SUBTITLE DATA/SAVE/PARAMETER ;V1.15 PARSE_DATA: MOVL #-1,OTHER_FLAG ;V1.11 BRB PARSE_S_LIST ;V1.11 PARSE_PARAMETER: MOVL #1,OTHER_FLAG BRB PARSE_S_LIST PARSE_SAVE: CLRL OTHER_FLAG PARSE_S_LIST: MOVAL LINE_TOKEN_QUEUE,R11 MOVL (R11),R10 1$: MOVL (R10),R10 ;GET NEXT ELEMENT CMPL R10,R11 BNEQ 2$ RET 2$: CMPW #TOKEN_IDENTIFIER,12(R10) BNEQ 1$ MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER CLRL ARG4 ;V1.11 TSTL OTHER_FLAG BEQL 3$ BLSS 5$ ;V1.11 BISL2 #SYMBOL_FLAG_PARAMETER,ARG4 ;V1.11 5$: BISL2 #SYMBOL_FLAG_CHANGED,ARG4 ;V1.11 BRB 4$ 3$: CLRL ARG4 4$: CALLG ARG_INSERT,STORE_SYMBOL CALLS #0,CHECK_RECORD ;V3.00 BRB 1$ .PAGE ;V1.15 .SUBTITLE EQUIVALENCE ;V1.15 PARSE_EQUIVALENCE: ;V1.15 MOVAL LINE_TOKEN_QUEUE,R11 ;GET BEGINNING OF QUEUE ;V1.15 MOVL (R11),R10 ;POINT TO EQUIVALENCE TOKEN ;V1.15 1$: MOVL (R10),R10 ;GET NEXT SET OF EQUIV TOKENS ;V1.15 CMPL R10,R11 ;SEE IF DONE YET ;V1.15 BNEQ 2$ ;NO ;V1.15 RET ;DONE ;V1.15 2$: CMPW #TOKEN_LEFT_PARREN,12(R10) ;MUST BE A LEFT PARREN HERE ;V1.15 BEQL 3$ ;YES ;V1.15 BRW PARSE_ERROR ;NO-SYNTAX ERROR ;V1.15 3$: MOVL #1,PARREN_LEVEL ;SET PARREN LEVEL TO 1 ;V1.15 CLRL R2 ;CLEAR SYMBOL ENTRY POINTER ;V1.15 4$: MOVL (R10),R10 ;NEXT ELEMENT ;V1.15 CMPL R11,R10 ;SEE IF DONE ;V1.15 BNEQ 5$ ;NO ;V1.15 BRW PARSE_ERROR ;YES-ERROR ;V1.15 5$: CMPW #TOKEN_LEFT_PARREN,12(R10) ;SEE IF LEFT PARREN ;V1.15 BNEQ 6$ ;NO ;V1.15 INCL PARREN_LEVEL ;YES-BUMP PARREN LEVEL ;V1.15 BRW 4$ ;V1.15 6$: CMPW #TOKEN_RIGHT_PARREN,12(R10) ;IS IT RIGHT PARREN ;V1.15 BNEQ 7$ ;NO ;V1.15 DECL PARREN_LEVEL ;BACK UP PARREN LEVEL ;V1.15 BGTR 4$ ;STILL MORE IN LIST ;V1.15 MOVL (R10),R10 ;SEE IF MORE TO GO ;V1.15 CMPL R10,R11 ;SEE IF DONE ;V1.15 BNEQ 8$ ;NOPE ;V1.15 RET ;DONE ;V1.15 8$: CMPW #TOKEN_COMMA,12(R10) ;IS IT A COMMA(MANDITORY) ;V1.15 BEQL 1$ ;YES-CONTINUE WITH NEXT LIST ;V1.15 BRW PARSE_ERROR ;NO-ERROR ;V1.15 7$: CMPW #TOKEN_IDENTIFIER,12(R10) ;IS IT AN IDENTIFIER ;V1.15 BNEQ 4$ ;NO-JUST IGNORE IT ;V1.15 CMPL #1,PARREN_LEVEL ;SEE IF SYMBOL IS EQUIVILENCED ;V1.15 BEQL 9$ ;PARREN LEVEL IS RIGHT ;V1.15 MOVAL 16(R10),DESCRIPTER+4 ;NO-OTHER SYMBOL IN STATEMENT ;V1.15 SUBW3 #16,14(R10),DESCRIPTER ;SET UP DESCRIPTER OF SYMBOL ;V1.15 CLRW DESCRIPTER+2 ;V1.15 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 ;SET UP CALL TO STORE SYMBOL ;V1.15 MOVL 8(R10),ARG3 ;LINE NUMBER ;V1.15 CLRL ARG4 ;NO FLAGS ;V1.15 CALLG ARG_INSERT,STORE_SYMBOL ;STORE IT ;V1.15 CALLS #0,CHECK_RECORD ;V3.00 BRW 4$ ;V1.15 9$: TSTL R2 ;SEE IF FIRST IN STRING OF EQ ;V1.15 BNEQ 10$ ;NO-ALREADY GOT FIRST ;V1.15 MOVAL 16(R10),DESCRIPTER+4 ;NO-OTHER SYMBOL IN STATEMENT ;V1.15 SUBW3 #16,14(R10),DESCRIPTER ;SET UP DESCRIPTER OF SYMBOL ;V1.15 CLRW DESCRIPTER+2 ;V1.15 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 ;SET UP CALL TO STORE SYMBOL ;V1.15 MOVL 8(R10),ARG3 ;LINE NUMBER ;V1.15 CLRL ARG4 ;NO FLAGS ;V1.15 CALLG ARG_INSERT,STORE_SYMBOL ;STORE IT ;V1.15 CALLS #0,CHECK_RECORD ;V3.00 MOVL R0,R2 ;SAVE ADDRESS ;V1.15 BRW 4$ ;NEXT ;V1.15 10$: MOVAL 16(R10),DESCRIPTER+4 ;NO-OTHER SYMBOL IN STATEMENT ;V1.15 SUBW3 #16,14(R10),DESCRIPTER ;SET UP DESCRIPTER OF SYMBOL ;V1.15 CLRW DESCRIPTER+2 ;V1.15 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 ;SET UP CALL TO STORE SYMBOL ;V1.15 MOVL 8(R10),ARG3 ;LINE NUMBER ;V1.15 MOVL #SYMBOL_FLAG_EQUIVALENCE,ARG4 ;SET FLAG ;V1.15 MOVL R2,EQ_LOC ;SET LOC OF EQ SYMBOL ;V1.15 CALLG ARG_INSERT_EQ,STORE_SYMBOL ;STORE IT ;V1.15 CALLS #0,CHECK_RECORD ;V3.00 BRW 4$ ;V1.15 .PAGE .SUBTITLE ENCODE/DECODE PARSE_ENCODE: MOVL #1,OTHER_FLAG BRB PARSE_CODE PARSE_DECODE: CLRL OTHER_FLAG PARSE_CODE: MOVAL LINE_TOKEN_QUEUE,R11 ;SET UP POINTER INTO QUEUE MOVL (R11),R10 ;POINT TO KEYT WORD MOVL (R10),R10 ;POINT TO ( MOVL #1,PARREN_LEVEL 1$: ;INPUT CHAR COUNT EXPRESSION MOVL (R10),R10 ;NEXT TOKEN CMPL R10,R11 BNEQ 2$ RET 2$: CMPL #1,PARREN_LEVEL BLSS 10$ CMPW #TOKEN_COMMA,12(R10) ;END OF UNIT YET BNEQ 10$ JMP 50$ 10$: CMPW #TOKEN_LEFT_PARREN,12(R10) BNEQ 11$ INCL PARREN_LEVEL BRB 1$ 11$: CMPW #TOKEN_RIGHT_PARREN,12(R10) BNEQ 12$ DECL PARREN_LEVEL BRB 1$ 12$: CMPW #TOKEN_IDENTIFIER,12(R10) BNEQ 1$ MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL #SYMBOL_FLAG_USED,ARG4 ;CLEAR FLAG CALLG NULL,PARSE_CALLED_FUNCTION ;V1.3 BLBS R0,13$ ;YES-IT IS SOMETHING WITH A "()" ON IT ;V1.3 CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL ;V1.3 CALLS #0,CHECK_RECORD ;V3.00 13$: BRW 1$ ;V1.3 50$: ;GET THE FORMAT SPECIFIER MOVL (R10),R10 ;SKIP TO TOKEN CMPL R10,R11 BNEQ 52$ RET 52$: CMPL #1,PARREN_LEVEL BLSS 60$ CMPW #TOKEN_COMMA,12(R10) ;END OF UNIT YET BNEQ 60$ JMP 100$ 60$: CMPW #TOKEN_LEFT_PARREN,12(R10) BNEQ 61$ INCL PARREN_LEVEL BRB 50$ 61$: CMPW #TOKEN_RIGHT_PARREN,12(R10) BNEQ 62$ DECL PARREN_LEVEL BRB 50$ 62$: CMPW #TOKEN_NUMBER,12(R10) BEQL 64$ CMPW #TOKEN_IDENTIFIER,12(R10) BNEQ 50$ 64$: MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL #SYMBOL_FLAG_USED,ARG4 ;CLEAR FLAG CALLG NULL,PARSE_CALLED_FUNCTION ;V1.3 BLBS R0,63$ ;YES-IT IS SOMETHING WITH A "()" ON IT ;V1.3 CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL ;V1.3 CALLS #0,CHECK_RECORD ;V3.00 63$: BRW 50$ ;V1.3 100$: ;I/O STRING MOVL (R10),R10 CMPL R10,R11 BNEQ 102$ RET 102$: CMPL #1,PARREN_LEVEL BLSS 110$ CMPW #TOKEN_COMMA,12(R10) ;END OF UNIT YET BNEQ 2102$ JMP 150$ 2102$: CMPW #TOKEN_RIGHT_PARREN,12(R10);END OF INSIDE DATA BNEQ 110$ JMP 500$ 110$: CMPW #TOKEN_LEFT_PARREN,12(R10) BNEQ 111$ INCL PARREN_LEVEL BRB 100$ 111$: CMPW #TOKEN_RIGHT_PARREN,12(R10) BNEQ 112$ DECL PARREN_LEVEL BRB 100$ 112$: CMPW #TOKEN_IDENTIFIER,12(R10) BNEQ 100$ MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL #SYMBOL_FLAG_USED,ARG4 ;CLEAR FLAG TSTL OTHER_FLAG BEQL 1112$ BISL #SYMBOL_FLAG_CHANGED,ARG4 1112$: CALLG NULL,PARSE_CALLED_FUNCTION ;V1.3 BLBS R0,113$ ;YES-IT IS SOMETHING WITH A "()" ON IT ;V1.3 CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL ;V1.3 CALLS #0,CHECK_RECORD ;V3.00 113$: BRW 100$ ;V1.3 150$: ; LOOP HERE TO GET KEY WORD STUFF MOVL (R10),R10 ;NEXT TOKEN CMPL R10,R11 BNEQ 151$ RET 151$: CMPW #TOKEN_COMMA,12(R10) BEQL 150$ CMPW #TOKEN_RIGHT_PARREN,12(R10) BNEQ 2051$ JMP 500$ 2051$: CMPW #TOKEN_ERR,12(R10) BNEQ 153$ JMP 200$ ; MUST BE IOSTAT 153$: MOVL (R10),R10 CMPL R10,R11 BNEQ 152$ RET 152$: CMPL #1,PARREN_LEVEL BLSS 160$ CMPW #TOKEN_COMMA,12(R10) ;END OF UNIT YET BEQL 150$ CMPW #TOKEN_RIGHT_PARREN,12(R10) BNEQ 160$ JMP 500$ 160$: CMPW #TOKEN_LEFT_PARREN,12(R10) BNEQ 161$ INCL PARREN_LEVEL BRB 153$ 161$: CMPW #TOKEN_RIGHT_PARREN,12(R10) BNEQ 162$ DECL PARREN_LEVEL BRB 153$ 162$: CMPW #TOKEN_IDENTIFIER,12(R10) BNEQ 153$ MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL #,ARG4;CLEAR FLAG CMPL #1,PARREN_LEVEL BNEQ 1162$ BISL #SYMBOL_FLAG_CHANGED,ARG4 1162$: CALLG NULL,PARSE_CALLED_FUNCTION ;V1.3 BLBS R0,163$ ;YES-IT IS SOMETHING WITH A "()" ON IT ;V1.3 CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL ;V1.3 CALLS #0,CHECK_RECORD ;V3.00 163$: BRW 153$ ;V1.3 200$: ;ERR=- GET LABEL MOVL (R10),R10 ;GET LABEL CMPW #TOKEN_NUMBER,12(R10) BEQL 202$ JMP 152$ 202$: MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL #SYMBOL_FLAG_USED,ARG4 ;CLEAR FLAG CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL CALLS #0,CHECK_RECORD ;V3.00 JMP 150$ 500$: ;IO LIST MOVL (R10),R10 ;GET NEXT TOKEN CMPL R10,R11 BNEQ 501$ RET 501$: CMPW #TOKEN_IDENTIFIER,12(R10) BNEQ 500$ MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER TSTL OTHER_FLAG MOVL #SYMBOL_FLAG_USED,ARG4 BNEQ 1501$ BISL #SYMBOL_FLAG_CHANGED,ARG4 1501$: CALLG NULL,PARSE_CALLED_FUNCTION ;V1.3 BLBS R0,502$ ;YES-IT IS SOMETHING WITH A "()" ON IT ;V1.3 CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL ;V1.3 CALLS #0,CHECK_RECORD ;V3.00 502$: BRW 500$ ;V1.3 .PAGE .SUBTITLE DEFINE FILE PARSE_DEFINEFILE: MOVAL LINE_TOKEN_QUEUE,R11 MOVL (R11),R10 ;GET FIRST TOKEN 1$: MOVL (R10),R10 CMPL R10,R11 BNEQ 10$ RET ;TAKE ANY IDENTIFIER 10$: CMPW #TOKEN_IDENTIFIER,12(R10) BNEQ 1$ MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL #SYMBOL_FLAG_USED,ARG4 CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL CALLS #0,CHECK_RECORD ;V3.00 BRW 1$ ;AND CONTINUE .PAGE .SUBTITLE DO PARSE_DO: MOVAL LINE_TOKEN_QUEUE,R11 MOVL @(R11),R10 ;GO TO POTENTIAL LABEL CMPW #TOKEN_NUMBER,12(R10) BNEQ 10$ ;NO LABEL HERE MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL #SYMBOL_FLAG_USED,ARG4 CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL CALLS #0,CHECK_RECORD ;V3.00 MOVL (R10),R10 ;SKIP TO POSSABLE "," CMPL #TOKEN_COMMA,12(R10) BNEQ 10$ ;NO COMMA MOVL (R10),R10 ;SKIP COMMA 10$: ;WHAT FORM DOES THIS DO TAKE MOVL #,TEMPORARY_FLAG CMPW #TOKEN_WHILE,12(R10) ;DO...WHILE BNEQ 20$ ;NO MOVL @(R10),R10 ;YES-SKIP WHILE( MOVL #SYMBOL_FLAG_USED,TEMPORARY_FLAG 20$:; STORE LOOP FOR ALL IDENTIFIERS CMPW #TOKEN_IDENTIFIER,12(R10) BNEQ 100$ MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL TEMPORARY_FLAG,ARG4 ;CLEAR FLAG CALLG NULL,PARSE_CALLED_FUNCTION ;V1.3 BLBS R0,100$ ;YES-IT IS SOMETHING WITH A "()" ON IT ;V1.3 2$: CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL CALLS #0,CHECK_RECORD ;V3.00 100$: MOVL #SYMBOL_FLAG_USED,TEMPORARY_FLAG MOVL (R10),R10 CMPL R10,R11 BEQL 1100$ JMP 20$ 1100$: RET .PAGE .SUBTITLE ELSEIF/RETURN PARSE_ELSEIF: PARSE_RETURN: ; SAVE ALL IDENTIFIERS MOVAL LINE_TOKEN_QUEUE,R11 MOVL (R11),R10 1$: MOVL (R10),R10 CMPL R10,R11 BNEQ 3$ RET 3$: CMPW #TOKEN_IDENTIFIER,12(R10) BNEQ 1$ MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL #SYMBOL_FLAG_USED,ARG4 ;CLEAR FLAG CALLG NULL,PARSE_CALLED_FUNCTION ;V1.3 BLBS R0,2$ ;YES-IT IS SOMETHING WITH A "()" ON IT ;V1.3 CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL ;V1.3 CALLS #0,CHECK_RECORD ;V3.00 2$: BRW 1$ ;V1.3 .PAGE .SUBTITLE END .ENTRY PARSE_BAD_END,^M PARSE_END: ; OUTPUT SYMBOL TABLE ;V1.4 CALLG NULL,DUMP_INDEX ;V1.4 INCL END_FLAG ;V2.00 RET ;V2.00 .PAGE ;V3.00 .SUBTITLE DICTIONARY COMMAND ;V3.00 PARSE_DICTIONARY: ;V3.00 PUSHAL NO_DICTIONARY ;V3.00 CALLS #1,G^LIB$PUT_OUTPUT ;V3.00 PUSHAL NO_DICTIONARY ;V3.00 CALLS #1,ERROR_LINE ;V3.00 RET ;V3.00 .PAGE .SUBTITLE ERROR PARSE_ERROR: PUSHAL TAXING CALLS #1,G^LIB$PUT_OUTPUT PUSHAL TAXING CALLS #1,ERROR_LINE RET .PAGE .SUBTITLE LISTS OF ENTRY POINTS EXTERNAL/INTRINSIC PARSE_EXTERNAL: PARSE_INTRINSIC: MOVAL LINE_TOKEN_QUEUE,R11 MOVL (R11),R10 ;GET ENTRY POINT NAME LOOP 1$: MOVL (R10),R10 CMPL R10,R11 BNEQ 3$ RET 3$: CMPW #TOKEN_IDENTIFIER,12(R10) BNEQ 1$ MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL #,ARG4;SAY IT IS A FUNCTION 2$: CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL CALLS #0,CHECK_RECORD ;V3.00 PUSHAL TYPE_EPT ;V3.05 PUSHAL DESCRIPTER ;V3.05 CALLS #2,SET_VAR_TYPE ;V3.05 BRW 1$ .PAGE .SUBTITLE FORMAT PARSE_FORMAT: MOVAL LINE_TOKEN_QUEUE,R11 MOVL (R11),R10 ; MAIN LOOP LOOKING FOR "<" 1$: MOVL (R10),R10 CMPL R10,R11 BNEQ 2$ RET 2$: CMPW #TOKEN_LEFT_ANGLE,12(R10) BNEQ 1$ ; FOUND ONE ; LOOP-SAVEING IDENTIFIERS AND LOOKING FOR ">" 3$: MOVL (R10),R10 CMPL R10,R11 BNEQ 4$ RET 4$: CMPW #TOKEN_RIGHT_ANGLE,12(R10) BEQL 1$ CMPW #TOKEN_IDENTIFIER,12(R10) BNEQ 3$ MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL #SYMBOL_FLAG_USED,ARG4 ;CLEAR FLAG CALLG NULL,PARSE_CALLED_FUNCTION ;V1.3 BLBS R0,102$ ;YES-IT IS SOMETHING WITH A "()" ON IT ;V1.3 CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL ;V1.3 CALLS #0,CHECK_RECORD ;V3.00 102$: BRW 3$ ;V1.3 .PAGE .SUBTITLE GO TO PARSE_GOTO: MOVAL LINE_TOKEN_QUEUE,R11 ;THE USUAL SETUP MOVL (R11),R10 ;POINT TO ; THE NEXT TOKEN IS EITHER A NUMBER,"(" OR SYMBOL DEPENDING ON THE ; TYPE OF GOTO MOVL (R10),R10 CMPW #TOKEN_NUMBER,12(R10) BNEQ 4$ JMP SIMPLE_GOTO 4$: CMPW #TOKEN_LEFT_PARREN,12(R10) BNEQ 3$ JMP COMPUTED_GOTO ; ONLY THING LEFT IS ASSIGNED GOTO 3$: MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL #SYMBOL_FLAG_USED,ARG4 ;CLEAR FLAG CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL CALLS #0,CHECK_RECORD ;V3.00 ; SCAN REST OF GO TO INSERTING ONLY NUMBERS 1$: MOVL (R10),R10 CMPL R10,R11 BNEQ 2$ RET 2$: CMPW #TOKEN_NUMBER,12(R10) BNEQ 1$ MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL #SYMBOL_FLAG_USED,ARG4 ;CLEAR FLAG CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL CALLS #0,CHECK_RECORD ;V3.00 BRB 1$ SIMPLE_GOTO: MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL #SYMBOL_FLAG_USED,ARG4 ;CLEAR FLAG CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL CALLS #0,CHECK_RECORD ;V3.00 RET ;NOTHING FOLLOWES COMPUTED_GOTO: MOVL (R10),R10 ;SCAN UNTILL ")" FOUND CMPL R10,R11 BNEQ 1$ RET 1$: CMPW #TOKEN_RIGHT_PARREN,12(R10) BEQL 100$ CMPW #TOKEN_NUMBER,12(R10) BNEQ COMPUTED_GOTO MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL #SYMBOL_FLAG_USED,ARG4 ;CLEAR FLAG CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL CALLS #0,CHECK_RECORD ;V3.00 BRB COMPUTED_GOTO 100$:;NOW LOAD ONLY IDENTIFIERS MOVL (R10),R10 ;SCAN UNTILL ")" FOUND CMPL R10,R11 BNEQ 201$ RET 201$: CMPW #TOKEN_IDENTIFIER,12(R10) BNEQ 100$ MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL #SYMBOL_FLAG_USED,ARG4 ;CLEAR FLAG CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL CALLS #0,CHECK_RECORD ;V3.00 BRB 100$ .PAGE .SUBTITLE IF PARSE_IF: MOVAL LINE_TOKEN_QUEUE,R11 MOVL @(R11),R10 ;POINT TO "(" MOVL #1,PARREN_LEVEL ; FIRST GET IN THE CONDITIONL EXPRESSION PART OF IF 1$: MOVL (R10),R10 CMPL R10,R11 BNEQ 2$ RET ; LOOP UNTILL ZERO PARREN LEVEL , OR ' OR ) FOUND 2$: 3$: CMPW #TOKEN_LEFT_PARREN,12(R10) BNEQ 4$ INCL PARREN_LEVEL BRB 1$ 4$: CMPW #TOKEN_RIGHT_PARREN,12(R10) BNEQ 5$ DECL PARREN_LEVEL BGTR 1$ BRW GET_IF_CONDITIONAL 5$: CMPW #TOKEN_IDENTIFIER,12(R10) BNEQ 1$ MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL #SYMBOL_FLAG_USED,ARG4 ;CLEAR FLAG CALLG NULL,PARSE_CALLED_FUNCTION ;V1.3 BLBS R0,102$ ;YES-IT IS SOMETHING WITH A "()" ON IT ;V1.3 CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL ;V1.3 CALLS #0,CHECK_RECORD ;V3.00 102$: BRW 1$ ;V1.3 GET_IF_CONDITIONAL: MOVL (R10),R10 CMPL R10,R11 BNEQ 1$ RET ; WHAT FOLLOWS ?? 1$: CMPW #TOKEN_THEN,12(R10) ;IF()THEN-WE ARE DONE BNEQ 2$ RET 2$: CMPW #TOKEN_NUMBER,12(R10) ;IF()100,200,300 BNEQ 3$ ; GET THE LABELS 22$: CMPW #TOKEN_NUMBER,12(R10) BNEQ 21$ MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER SUBW3 #16,14(R10),DESCRIPTER CLRW DESCRIPTER+2 MOVL EVALUATION_ROUTINE_TOKEN,ARG2 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER MOVL #SYMBOL_FLAG_USED,ARG4 ;CLEAR FLAG CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL CALLS #0,CHECK_RECORD ;V3.00 21$: MOVL (R10),R10 CMPL R10,R11 BNEQ 22$ RET 3$: BITL #CHART_FLAG,FLAG_WORD ;V2.00 BEQL 12345$ ;V2.00 CALLG NULL,ACCUMULATE_CHART ;V2.00 12345$: ;V2.00 ; IT IS LOGICAL IF FORM WITH A STATEMENT FOLLOWING ; REMOVE ALL THE LEADING IF TOKENS AND UPDATE THE ; LINE_MNEMONIC AND EVALUATION_ROUTINE_TOKEN MOVL LOGICAL_IF_ROUTINE_TOKEN,EVALUATION_ROUTINE_TOKEN MOVC3 #31,LOGICAL_IF_MNEMONIC,LINE_MNEMONIC ; NOW LOOP-REMOVEING TOKENS FROM THE FRONT OF QUEUE UNTILL ; ALL IF RELATED STUFF IS GONE 100$: CMPL (R11),R10 ;SEE IF WE ARE DONE YET BEQL 200$ ;YES REMQUE @LINE_TOKEN_QUEUE,R9 BVC 101$ RET 101$: MOVL R9,ARG3 CVTWL 14(R9),ARG2 CALLG ARG_FREE,FREE BRB 100$ ; CONDITIONAL PART OF IF NOW LOOKS LIKE ONLY THING IN LINE ; CONTINUE PARSE JUST AT DISPATCH TABLE 200$: JMP LOGICAL_IF_LOOP_BACK .PAGE .SUBTITLE INCLUDE PARSE_INCLUDE: ;HANDLE INCLUDE PUSH UP ONE LEVEL MOVAL LINE_TOKEN_QUEUE,R11 ;SET UP POINTER TO QUEUE MOVL (R11),R10 ;POINT TO INCLUDE MOVL (R10),R10 ;POINT TO STRING CONTIANING SPEC SUBW3 #16,14(R10),DESCRIPTER ;BUILD DESCRIPTER CLRW DESCRIPTER+2 MOVAL 16(R10),DESCRIPTER+4 PUSHAL DESCRIPTER CALLS #1,PUSH_INCLUDE_LEVEL RET .PAGE .SUBTITLE CHECK TO SEE IF FUNCTION .ENTRY CHECK_FUNCTION,^M ; ; CHECK TO SEE IF THE IDENTIFIER BEING SCANNED IS A FUNCTION OR NO ; IF NOT RETURN R0=0 ELSE R0=1 ; ; INTERNAL OR STATEMENT FUNCTIONS RETURN A VALUE THAT THEY ARE ;V1.3 ; NOT FUNCTIONS ;V1.3 ; ;V1.3 MOVL (R10),R9 ;GET NEXT TOKEN CMPL R9,R11 BNEQ 102$ JMP 2$ 102$: CMPW #TOKEN_LEFT_PARREN,12(R9) ;FOLLOED BY A LEFT PARREN? BEQL 202$ ;V1.3 BRW 2$ ;NO ;V1.3 202$: CALLG ARG_FLAG,GET_FLAG ;GET THE FLAG WORD ;V1.3 BITL #SYMBOL_FLAG_ENTRY_POINT,R0 ;IS IT EXTERNAL E.P. ;V1.3 BNEQ 3$ ;V1.3 BITL - ;V1.3 #- ;V1.3 ,R0 ;ANY DECLARATION YET ?? BNEQ 2$ ;YES-IT IS SOMETHING WITH A "()" ON IT ; NOT DECLARRED TO BE AN ARRAY OR FUNCTION ALREADY ; IS IT CHARACTER TYPE?? BITL #SYMBOL_FLAG_CHARACTER,R0 BEQL 3$ ;NO-IT MUST BE FUNCTION ; SYMBOL IS CHARACTER-MUST NOW SEE IF TRAILING () CONTAIN A":" INDICATEING ; THAT THIS IS A CHARACTER POSITION NOT A FUNCTION ARGUMENT LIST ; PUSHL PARREN_LEVEL CLRL PARREN_LEVEL ; LOOK FOR ZERO LEVEL ":" 4$: MOVL (R9),R9 ;NEXT SYMBOL CMPL R9,R11 ;SEE IF RUN OUT OF TOKENS BNEQ 6$ ;IF SO-DEFAULT IS FUNCTION MOVL (SP)+,PARREN_LEVEL ;RESTORE PARREN LEVEL BRB 3$ ;AND EXIT FUNCTION 6$: CMPW #TOKEN_LEFT_PARREN,12(R9);LEFT PARREN BNEQ 5$ ;NO INCL PARREN_LEVEL ;BUMP PARREN LEVEL BRB 4$ ;TRY AGAIN 5$: CMPW #TOKEN_RIGHT_PARREN,12(R9);RIGHT PARREN LEVEL BNEQ 7$ ;NO DECL PARREN_LEVEL ;BACK UP PARREN LEVEL BGEQ 4$ ;NOT END OF () MOVL (SP)+,PARREN_LEVEL BRB 3$ ;CHR FUNCTION-RESTORE PARREN LEVEL 7$: TSTL PARREN_LEVEL ;CHECK FOR ":" AT ZERO LEVEL ONLY BNEQ 4$ ;NOPE-NESTED CMPW #TOKEN_COLON,12(R9) ;IS IT ?? BNEQ 4$ ;NOPR MOVL (SP)+,PARREN_LEVEL ;YES-RESTORE PARREN LEVEL-NOT FUNCTION 2$: CLRL R0 RET 3$: ;V1.3 ; ITEM UNDER QUESTION IS A FUNCTION ;V1.3 MOVL #1,R0 ;V1.3 RET ;V1.3 .PAGE ;V1.3 .SUBTITLE PARSE CALLED FUNCTION ARGUMENTS ;V1.3 .ENTRY PARSE_CALLED_FUNCTION,^M ;V1.3 CALLG NULL,CHECK_FUNCTION ;IS IT A FUNCTION ;V1.3 BLBS R0,1$ ;V1.3 RET ;NO ;V1.3 1$: PUSHR #^M ;V1.3 PUSHL PARREN_LEVEL ;SET UP FOR ARGUMENT SCAN ;V1.3 PUSHL ENTRY_POINT_POINTER ;V2.09 PUSHL CALLED_ARG_NUMBER ;V2.09 ; DECLARE FUNCTION NAME AND STORE IT ;V1.3 BISL2 #,ARG4 ;V1.3 CALLG ARG_INSERT_CALLING_ARG,STORE_SYMBOL ;PUT IN THE SYMBOL ;V1.3 CALLS #0,CHECK_RECORD ;V3.00 CLRL PARREN_LEVEL ;V1.3 MOVL R0,ENTRY_POINT_POINTER ;V2.09 MOVL #1,CALLED_ARG_NUMBER ;V2.09 2$: MOVL (R10),R10 ;GET NEXT TOKEN ;V1.3 CMPL R10,R11 ;ARE WE DONE?? ;V1.3 BNEQ 2002$ ;V2.09 BRW 100$ ;V2.09 2002$: CMPW #TOKEN_COMMA,12(R10) ;V2.09 BNEQ 1002$ ;V2.09 CMPL #1,PARREN_LEVEL ;V2.09 BNEQ 2$ ;V2.09 INCL CALLED_ARG_NUMBER ;V2.09 BRB 2$ ;V2.09 1002$: CMPW #TOKEN_IDENTIFIER,12(R10) ;IS IT A TOKEN ;V2.09 BEQL 3$ ;YES ;V1.3 CMPW #TOKEN_LEFT_PARREN,12(R10) ;V1.3 BNEQ 4$ ;V1.3 INCL PARREN_LEVEL ;V1.3 BRB 2$ ;V1.3 4$: CMPW #TOKEN_RIGHT_PARREN,12(R10) ;V1.3 BNEQ 2$ ;V1.3 DECL PARREN_LEVEL ;V1.3 BLEQ 101$ ;V1.3 BRB 2$ ;V1.3 3$: MOVAL 16(R10),DESCRIPTER+4 ;LOAD DESCRIPTER ;V1.3 SUBW3 #16,14(R10),DESCRIPTER ;V1.3 CLRW DESCRIPTER+2 ;V1.3 MOVL #TOKEN_EVAL_CALLING_ARG,ARG2 ;V1.3 MOVL 8(R10),ARG3 ;LOAD LINE NUMBER ;V1.3 MOVL #,ARG4 ;V1.5 CALLG NULL,PARSE_CALLED_FUNCTION ;**-1 BLBS R0,5$ ;V1.3 CALLG ARG_INSERT_CALLING_ARG,STORE_SYMBOL ;V2.09 CALLS #0,CHECK_RECORD ;V3.00 5$: BRW 2$ ;V1.3 100$: MOVL 4(R10),R10 ;ON END OF LINE-BACK UP ONE TOKEN ;V1.3 101$: MOVL (SP)+,CALLED_ARG_NUMBER ;V2.09 MOVL (SP)+,ENTRY_POINT_POINTER ;V2.09 MOVL (SP)+,PARREN_LEVEL ;V1.3 POPR #^M ;V1.3 RET .PAGE ;V3.00 .SUBTITLE CHECK RECORD/STRUCTURED VARIABLES AND SKIP ELEMENTS ;V3.00 .ENTRY CHECK_RECORD,^M ;V3.00 ; R10 POINTS TO CURRENT ENTRY IN LINE TOKEN QUEUE AND CAN BE UPDATED ;V3.00 ; R11 POINTS TO HEAD OF LINE TOKEN QUEUE ;V3.00 ; R0 POINTS TO SYMBOL JUST PUT INTO SYMBOL TABLE-MUST BE UNCHANGED ;V3.00 TSTL R0 ;V3.18 BNEQ 1000$ ;V3.18 RET ;V3.18 1000$: PUSHR #^M ;V3.18 CMPB #4,PROGRAM_LEVEL ;MAKE SURE PAST STRUCTURE DEF LEVEL ;V3.00 BLSS 1$ ;V3.00 BRW 2$ ;V3.00 ; R0 POINTS TO VARIABLE NAME ENTRY IN SYMBOL TABLE ;V3.00 1$: BITL #SYMBOL_FLAG_RECORD,SYMBOL_TABLE_L_FLAG_WORD(R0) ;V3.00 BNEQ 3$ ;V3.00 BRW 2$ ;V3.00 ; THIS IS A STRUCTURED VARIABLE-SET UP TO SKIP RECORD ELEMENT NAMES ;V3.00 ; R11 POINTS TO TOP OF LINE TOKEN QUEUE ;V3.00 ; R10 POINTS TO LINE TOKEN QUEUE CONTAINING VARIABLE NAME ;V3.00 ; R9 POINTS TO SYMBOL TABLE ENTRY FOR R10 ;V3.00 ; R8 WORKING COPY OF R10 FOR UPDATE SCANNING ;V3.00 ; R7 POINTER TO CURR LEVEL OF STRUCTURE INTERESTED IN ;V3.00 3$: MOVL R0,R9 ;V3.00 MOVL R10,R8 ;V3.00 MOVL SYMBOL_TABLE_L_STRUCTURE_PTR(R9),R7 ;V3.00 MOVL SYMBOL_TABLE_L_STRUCTURE_PTR(R7),R7 ;V3.00 BNEQ 10$ ;V3.00 BRW 2$ ;BAD STRUCTURE BUT ACCEPT IT-JUST EXIT ;V3.00 10$: ;LEVEL SCAN LOOP-CAN EXPECT NEXT LINE TOKEN QUEUE ELEMENT TO BE ONE OF ;V3.00 ; THREE TYPES REQUIREING FURTHER PROCESSING- '.', LOGICAL OP,'(' . ;V3.00 MOVL (R8),R8 ;NEXT ELEMENT ;V3.00 CMPL R8,R11 ;SEE IF DONE ;V3.00 BNEQ 11$ ;NO ;V3.00 MOVL 4(R8),R10 ;PUT LAST ELEMENT IN R10 ;V3.00 BRW 2$ ;AND EXIT ;V3.00 11$: CMPW #TOKEN_POINT,12(R8) ;IS IT DOT ;V3.00 BEQL 12$ ;V3.00 BRW 20$ ;NO CHECK FOR OTHER FORMS ;V3.00 12$: MOVL (R8),R8 ;GET NEXT ELEMENT-SHOULD BE IDENT ;V3.00 CMPL R8,R11 ;SEE IF DONE ;V3.00 BNEQ 18$ ;NO ;V3.00 MOVL 4(R8),R10 ;PUT LAST ELEMENT IN R10 ;V3.00 BRW 2$ ;AND EXIT ;V3.00 18$: CMPW #TOKEN_IDENTIFIER,12(R8) ;V3.00 BEQL 13$ ;YES ;V3.00 PUSHAL ST_SYN ;V3.00 CALLS #1,G^LIB$PUT_OUTPUT ;V3.00 PUSHAL ST_SYN ;V3.00 CALLS #1,ERROR_LINE ;V3.00 MOVL 4(R8),R10 ;V3.00 BRW 2$ ;V3.00 13$:; SCAN DOWN LIST AT CURRENT LEVEL FOR CURENT IDENTIFIER AS ELEMENT ;V3.00 CVTWL 14(R8),R6 ;GET LENGTH OF SYMBOL ;V3.00 SUBL2 #16,R6 ;V3.00 17$: CMPB STRUCTURE_B_SIZE(R7),R6 ;V3.00 BNEQ 14$ ;NOT SAME SIZE ;V3.00 CMPC3 R6,STRUCTURE_S_NAME(R7),16(R8) ;V3.00 BNEQ 14$ ;NOT SAME STRING ;V3.00 ; STRING MATCH-DO WE GO DOWN ONE LEVEL OR EXIT ;V3.00 MOVL STRUCTURE_L_NEXT_LEVEL(R7),R7 ;V3.00 BEQL 15$ ;NOPE-END OF STRUCTURED VARIABLE ;V3.00 BRW 10$ ;YES-HANDLE NEXT LEVEL ;V3.00 15$: MOVL R8,R10 ;UPDATE R10 TO LAST ELEMENT SCANNED ;V3.00 BRW 2$ ;AND EXIT ;V3.00 14$: ;DOES NOT MATCH-GO TO NEXT ELEMENT NAME AT THIS LEVEL ;V3.00 MOVL STRUCTURE_L_NEXT_ELEMENT(R7),R7 ;V3.00 BEQL 16$ ;OOPS-NOT HERE ;V3.00 BRW 17$ ;V3.00 16$: PUSHAL ST_SYN ;V3.00 CALLS #1,G^LIB$PUT_OUTPUT ;V3.00 PUSHAL ST_SYN ;V3.00 CALLS #1,ERROR_LINE ;V3.00 MOVL 4(R8),R10 ;V3.00 BRW 2$ ;V3.00 20$: ;CHECK TO SEE IF THIS IS A LOGICAL OPERATOR OR POSSABLY A NESTED ;V3.00 ; STRUCTURE WITH A NAME THAT MATCHES A LOGICAL OP ;V3.00 CMPW #3000,12(R8) ;SEE IF IN RANGE OF LOGICALS ;V3.00 BGTR 21$ ;V3.00 CMPW #NUMBER_OF_LOGICAL,12(R8) ;V3.00 BLEQ 22$ ;V3.00 21$: BRW 40$ ;NOT LOGICAL-TRY NEXT ;V3.00 22$: CVTWL 12(R8),R6 ;GET POINTER TO DESCRIPTER OF LOGICAL OP ;V3.00 SUBL2 #3000,R6 ;V3.00 MULL2 #8,R6 ;V3.00 ADDL2 #LOGICAL_TABLE,R6 ;V3.00 ADDL3 #1,4(R6),-(SP) ;SET UP PHONY DESCRIPTER ON STACK ;V3.00 CVTWL (R6),R0 ;V3.00 SUBL3 #2,R0,-(SP) ;V3.00 27$: CMPB STRUCTURE_B_SIZE(R7),(SP) ;V3.00 BNEQ 23$ ;NO MATCH IN SIZE ;V3.00 CMPC3 (SP),@4(SP),STRUCTURE_S_NAME(R7) ;V3.00 BEQL 25$ ;GOT A MATCH-GO DO FIXUP FOR NEXT LEVEL IF ANY ;V3.00 23$: MOVL STRUCTURE_L_NEXT_ELEMENT(R7),R7 ;V3.00 BNEQ 27$ ;TRY NEXT ENTRY ;V3.00 ; NO MATCH-ASSUME NO ERROR BUT TRUE LOGICAL OP-SET UP AND RETURN ;V3.00 CLRQ (SP)+ ;CLEAR UP STACK ;V3.00 MOVL 4(R8),R10 ;UPDATE POINTER ;V3.00 BRW 2$ ;AND EXIT ;V3.00 25$: ;LOGICAL OP ACTUALLY IS AN ELEMENT OF THE STRUCTURED VARIABLE. ;V3.00 CLRQ (SP)+ ;V3.00 MOVL STRUCTURE_L_NEXT_LEVEL(R7),R7 ;V3.00 BNEQ 26$ ;V3.00 BRW 2$ ;NO NEXT LEVEL JUST EXIT EVEN IF ERROR ;V3.00 26$: BRW 12$ ;REENTER LEVEL CHECK LOOP AT IDENT CHECK ;V3.00 40$: ;COULD BE A '(' IF NOT DONE ;V3.00 CMPW #TOKEN_LEFT_PARREN,12(R8) ;V3.00 BEQL 41$ ;MATCH ;V3.00 MOVL 4(R8),R10 ;RESET R10 TO LAST SCANNED TOKEN ELEMENT ;V3.00 BRW 2$ ;AND EXIT ;V3.00 41$: ;HANDLE PARREN'S ;V3.00 MOVL PARREN_LEVEL,-(SP) ;V3.00 MOVL #1,PARREN_LEVEL ;V3.00 42$: MOVL (R8),R8 ;V3.00 CMPL R8,R11 ;V3.00 BNEQ 1042$ ;V3.00 BRW 43$ ;V3.00 1042$: CMPW #TOKEN_LEFT_PARREN,12(R8) ;V3.00 BNEQ 44$ ;V3.00 INCL PARREN_LEVEL ;V3.00 BRB 42$ ;V3.00 44$: CMPW #TOKEN_RIGHT_PARREN,12(R8) ;V3.00 BNEQ 45$ ;V3.00 DECL PARREN_LEVEL ;V3.00 BGTR 42$ ;V3.00 MOVL (SP)+,PARREN_LEVEL ;V3.00 BRW 10$ ;V3.00 45$: CMPW #TOKEN_IDENTIFIER,12(R8) ;V3.00 BEQL 46$ ;V3.00 BRW 42$ ;V3.18 46$: PUSHR #^M ;V3.00 MOVL R8,R10 ;V3.00 MOVAL 16(R10),DESCRIPTER+4 ;V3.00 SUBW3 #16,14(R10),DESCRIPTER ;V3.00 CLRW DESCRIPTER+2 ;V3.00 MOVL 8(R10),ARG3 ;V3.00 CALLG NULL,PARSE_CALLED_FUNCTION ;V3.00 BLBS R0,47$ ;V3.00 CALLG ARG_INSERT,STORE_SYMBOL ;V3.00 CALLS #0,CHECK_RECORD ;V3.00 47$: MOVL R10,R8 ;V3.00 POPR #^M ;V3.00 BRW 42$ ;V3.00 43$: MOVL (SP)+,PARREN_LEVEL ;V3.00 BRW 2$ ;V3.00 2$: POPR #^M ;V3.00 RET ;V3.00 .PAGE ;V3.05 .SUBTITLE SET VAR DEFAULT TYPE LIST ;V3.05 .ENTRY SET_DEFAULT_VAR_TYPE,^M ;V3.05 ; FIRST SET REALS A-H ;V3.05 OFFSET=0 ;V3.05 COUNT=^A/H/-^A/A/+1 ;V3.05 .REPEAT COUNT ;V3.05 MOVAL TYPE_R_F,L^DEFAULT_TYPES+OFFSET ;V3.05 OFFSET=OFFSET+4 ;V3.05 .ENDR ;V3.05 ; DO INTEGERS I-N FIRST SEE IF I*2 OR I*4 ;V3.05 MOVAL TYPE_I_4,R11 ;V3.05 BITL #OPTION_NOI4_FLAG,FLAG_WORD+4 ;V3.05 BEQL 1$ ;V3.05 MOVAL TYPE_I_2,R11 ;V3.05 1$: COUNT=^A/N/-^A/I/+1 ;V3.05 .REPEAT COUNT ;V3.05 MOVL R11,L^DEFAULT_TYPES+OFFSET ;V3.05 OFFSET=OFFSET+4 ;V3.05 .ENDR ;V3.05 ; FINALLY THE LAST OF THE REALS O-Z ;V3.05 COUNT=^A/Z/-^A/O/+1 ;V3.05 .REPEAT COUNT ;V3.05 MOVAL TYPE_R_F,L^DEFAULT_TYPES+OFFSET ;V3.05 OFFSET=OFFSET+4 ;V3.05 .ENDR ;V3.05 RET ;V3.05 .END