.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 ARG2: .LONG 0 ARG3: .LONG 0 ARG4: .LONG 0 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_FLAG: .LONG 1 .ADDRESS DESCRIPTER DEF_BLOCK_DATA: .ASCID /BLOCK_DATA/ TAXING: .ASCID /INDEX-E-Unknown Line Type or Syntax Error/ .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 ; 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_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_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_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_RETURN-100$ .WORD PARSE_REWIND-100$ .WORD PARSE_SAVE-100$ .WORD PARSE_STOP-100$ .WORD PARSE_SUBROUTINE-100$ .WORD PARSE_TYPE-100$ .WORD PARSE_UNLOCK-100$ .WORD PARSE_USED-100$ .WORD PARSE_VIRTUAL-100$ .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 ; 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 2$: BRW 1$ ;V1.3 100$: RET .PAGE .SUBTITLE NO FURTHER PARSEING REQUIRED ARGUMENT/CONTINUE .SUBTITLE ELSE/ENDDO/ENDIF/IMPLICITNONE/IMPLICIT/OPTION .SUBTITLE PAUSE/STOP/USED/COMMON_NAME/CONTINUE ; 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_IMPLICITNONE: PARSE_IMPLICIT: PARSE_LABEL: PARSE_LOCAL_FUNCTION: PARSE_NAMELIST_NAME: PARSE_OPTION: PARSE_PAUSE: PARSE_STOP: PARSE_USED: RET .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 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 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 ; 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 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 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 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 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 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 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 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 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 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 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 BEQL 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 ;CLEAR FLAG CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL 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 1$: RET .PAGE .SUBTITLE SIMPLE TYPE/ARRAY DECLARATIONS .SUBTITLE BYTE/LOGICAL/INTEGER/CHARACTER/DIMENSION/VIRTUAL ; IGNORE ANY *LEN DECLARATIONS. MARK VARIABLES AS ARRAYS IF SUCH PARSE_CHARACTER: MOVL #1,OTHER_FLAG BRB PARSE_OTHER_TYPE_LIST PARSE_BYTE: PARSE_LOGICAL: PARSE_INTEGER: PARSE_DIMENSION: PARSE_VIRTUAL: CLRL OTHER_FLAG ; FOR CASE OF DOUBLE COMPLEX OR DOUBLE PRECISION NOT REAL*8 OR COMPLEX*16 PARSE_OTHER_TYPE_LIST: 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) 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 ;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$: CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL BRW 1$ .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_SUBROUTINE: PARSE_FUNCTION: PARSE_BYTE_FUNCTION: PARSE_LOGICAL_FUNCTION: PARSE_INTEGER_FUNCTION: PARSE_CHARACTER_FUNCTION: ;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 MOVL R0,ENTRY_POINT_POINTER ;V2.09 CLRL PARREN_LEVEL ;V2.09 TSTL R8 ;UPDATE MODULE NAME ?? 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 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 BRB 102$ ;V2.08 1032$: CALLG ARG_INSERT_CALLING_ARG,STORE_SYMBOL ;PUT IN THE SYMBOL ;V2.09 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 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 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 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 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 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$ JMP PARSE_OTHER_TYPE_LIST ;WAS STRAGHT DECL. HANDLE SIMPLY 1$: PARSE_COMPLEX: 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) 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 ;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 BRW 1$ .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 JMP PARSE_OTHER_SIMPLE_FUNCTION ;YES-HANDLE SIMPLY 1$: PARSE_COMPLEX_FUNCTION: 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 JMP PARSE_OTHER_SIMPLE_FUNCTION 3$: CMPW #TOKEN_OCTAL_BYTES,12(R10) BNEQ 4$ MOVL #TOKEN_EVAL_COMPLEX_FUNCTION,EVALUATION_ROUTINE_TOKEN 4$: JMP PARSE_OTHER_SIMPLE_FUNCTION .PAGE .SUBTITLE REAL/QUAD/DOUBLE PRECISION PARSE_DOUBLE_PRECISION: ; IS THE DECLARATION REAL*8 OR DOUBLE PRECISION MOVAL LINE_TOKEN_QUEUE,R11 MOVL (R11),R11 ;GET FIRST ELEMENT CMPW #TOKEN_DOUBLEPRECISION,12(R11) BNEQ 1$ JMP PARSE_OTHER_TYPE_LIST ;WAS STRAGHT DECL. HANDLE SIMPLY 1$: PARSE_REAL: PARSE_QUAD: 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) 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 ;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$: CALLG ARG_INSERT,STORE_SYMBOL ;PUT IN THE SYMBOL BRW 1$ .PAGE .SUBTITLE REAL FUNCTION/DOUBLE PRECISION FUNCTION/QUAD FUNCTION PARSE_DOUBLE_PRECISION_FN: MOVAL LINE_TOKEN_QUEUE,R11 ;SEE IF DIRECT OR COMPLEX*16 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$: PARSE_REAL_FUNCTION: PARSE_QUAD_FUNCTION: 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 JMP PARSE_OTHER_SIMPLE_FUNCTION 3$: CMPW #TOKEN_OCTAL_BYTES,12(R10) BNEQ 4$ MOVL #TOKEN_EVAL_DOUBLE_PRECISION_FN,EVALUATION_ROUTINE_TOKEN JMP PARSE_OTHER_SIMPLE_FUNCTION 4$: CMPW #TOKEN_FOUR_BYTES,12(R10) BNEQ 5$ MOVL #TOKEN_EVAL_REAL_FUNCTION,EVALUATION_ROUTINE_TOKEN 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 .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 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 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 ; 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 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 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 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 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 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 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 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 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 .END