.TITLE GET .MCALL ..V2..,.REGDEF ..V2.. .REGDEF .GLOBL LABL,TYPECH,MOVCHR,GETLIN,EOF,LIN,DEBUG,PRTLIN,FILLER .GLOBL GETVAR,VAR,VARTYP,LOGCK,LOGOP,TYPE,TYPECH,VARTYP .GLOBL ARGFLG,GETLBL,LABL,STOLBL,STOVAR,LOGNEM,LINPT,TMP,FINLIN .GLOBL SKIP,SAVENO,PUTCHR,PNMFLG,SUEXP,NOSRC .CSECT GET .PAGE ; A '.' HAS BEEN FOUND-IS IT THE BEGINNING OF ; A LOGICAL OPERATOR WHICH IS TO BE SKIPPED ; IF LOGOP=0 IT IS NOT A LOGICAL OF IF LOGOP.NE.0 IT IS ; EQUAL TO THE NUMBER OF CHRS IN LOGICAL OP TO BE SKIPPED LOGCK: MOV R1,-(SP) MOV R2,-(SP) MOV R3,-(SP) MOV R4,-(SP) MOV #LOGNEM,R2 ;GET BEGINING OF LOGICAL NEM.TABLE NXTLOG: MOV LINPT,R3 ;GET LOC OF '.' IN STRING LINE CLR R1 ;R1 IS LOG OP LENGTH CTR LOGLB: MOVB (R2)+,R0 ;GET NEM CHR BEQ NDLOG ;IF NULL BYTE DONE FOUND LOG OP OR END OF THABLE 1$: INC R1 CMPB #' ,(R3) BNE 2$ INC R3 BR 1$ 2$: CMPB R0,(R3)+ BNE SKPLOG BR LOGLB ;ONE MORE TIME SKPLOG: MOVB (R2)+,R0 ;CHECK NEXT CHR BNE SKPLOG ;NULL YET BR NXTLOG ;YES TRY NEXT NEM NDLOG: MOV R1,LOGOP ;DONE XFER COUNT TO LOGOP MOV (SP)+,R4 MOV (SP)+,R3 MOV (SP)+,R2 MOV (SP)+,R1 RTS PC .PAGE ; THIS ROUTINE TESTS THE CHR IN R0 AND RETURNS IN VAR TYPECH ; TYPECH=1 IF CHR =LETTER ; TYPECH=0 IF CHR= NUMBER ; TYPECH=-1 IF CHR ANYTHING ELSE TYPE: CMPB R0,#133 ;IS ASCII CODE HIGHER THAN LETTER BHIS NTLTNO ;NOT LETTER TO HIGH CMPB R0,#101 ;TEST LOW END LETTER ASCII VALUE BLO NTLET ;TO LOW FOR LETTER BRANCH MOV #1,TYPECH ;YES LETTER RTS PC NTLET: CMPB R0,#72 ;HIGHER THAN NUMBER BHIS NTLTNO CMPB R0,#60 ;LOWER THAN NUMBER BLO NTLTNO CLR TYPECH ;IT IS A NUMBER RTS PC NTLTNO: MOV #-1,TYPECH ;ONLTHING LEFT RTS PC .PAGE ; WHEN A NUMBER IS FOUND IN A LINE AND IT IS TO BE ; SKIPPED, THIS ROUTINE DOES IT SKPNUM: MOV LINPT,TMP NXTNUM: MOVB @LINPT,R0 INC LINPT CMPB #' ,R0 BEQ NXTNUM JSR PC,TYPE ;IS IT A NUMBER TST TYPECH BEQ NXTNUM ;IF YES GO BACK UNTILL NON NUMBER FOUND BLT NDNUSK ;NON NUMBER NON LETTER FOUND CMPB #'R,R0 BEQ HOL ;TREAT RAD50 SAME AS HOL CMPB #'H,R0 ;WAS 'H' FOUND (HOLERATH) BEQ HOL ;YES CMPB #'E,R0 ;WAS AN 'E' FOUND X.XXXXX E+-XX BEQ FPNUM CMPB #'D,R0 ;SAME FOR 'D' X.XXXXX D+_XX BEQ FPNUM NDNUSK: CMPB #'.,R0 ;WAS IT A POINT BNE NDSKDW ;NO DEC LINPT JSR PC,LOGCK ;IS IT A LOGICAL OPERATOR INC LINPT TST LOGOP BEQ NXTNUM ;NOT LOG OP CONTINUE NUMBER SKIP DEC LINPT ADD LOGOP,LINPT ;UPDATE LINEPTR TO AFER OP NDSKDW: DEC LINPT RTS PC FPNUM: MOVB @LINPT,R0 INC LINPT CMPB #' ,R0 BEQ FPNUM CMPB #'+,R0 BEQ FPEXSG ;FP EXP SIGN CMPB #'-,R0 BEQ FPEXSG TSTSKP: JSR PC,TYPE ;TYPE?? TST TYPECH BNE NDSKDW ;NOT NUMBER,DONE FPEXSG: MOVB @LINPT,R0 INC LINPT CMPB #' ,R0 BEQ FPEXSG BR TSTSKP ;NEXT CHR ONLY 1ST AFTER E OR D IS +- HOL: CLR R3 ;HOLERATH STATEMENT-GET SET TO GET COUNT OF NUMBER ;OF CHRS TO SKIP AND PRAY THERE ARE NO BLANKS SQUESSED OUT CLR R2 HOLCNT: MOV TMP,LINPT 7$: MOVB @LINPT,R0 INC LINPT CMPB #' ,R0 BEQ 7$ 1$: SUB #60,R0 ;CONVERT FROM ASCII TO BINARY ASL R3 ;MULT CONTENTS OF R3 BY 10 MOV R3,R2 ASL R2 ;R2=4* ORIG CONTENTS OF R3 ASL R2 ;8* NOW ADD R3,R2 ;10* DECIMAL OF COURSE MOV R2,R3 ADD R0,R3 ;UPDATED COUNT 10$: MOVB @LINPT,R0 INC LINPT CMPB #' ,R0 BEQ 10$ CMPB #'H,R0 BEQ 2$ CMPB #'R,R0 BEQ 2$ BR 1$ 2$: MOV R3,SUEXP 3$: JSR PC,MOVCHR INC LINPT DEC SUEXP BNE 3$ RTS PC .PAGE ; THIS ROUTINE GETS A LABLE EMBEDED IN A STATEMENT ; EG. GO TO 100 ; READ(100, ; ETC GETLBL: MOV #LABL,R0 ;BLANK OUT LABL MOV #20040,(R0)+ MOV #20040,(R0)+ MOV #20040,(R0)+ MOV #LABL,R1 ;SET UP LABLE CHR PTR GTLBCH: JSR PC,MOVCHR TSTB R0 BEQ NDLIN ;NULL SAYS END OF STRING-DONE JSR PC,TYPE ;WHAT TYPE OF SYMBOL IS IT TST TYPECH BNE NTNUM ;NOT A NUMBER INC LINPT ;YES A NUMBER INC PTR CMPB #'0,R0 ;IS CHR A ZERO BNE XFR1 ;NO SKIP NEXT CMP #LABL,R1 ;IS IT A LEADING ZERO BEQ GTLBCH ;IF YES SKIP IT XFR1: MOVB R0,(R1)+ ;STO CHR CMP #LABL+5,R1 ;GOT MAX OF 5 CHRS YET BHI GTLBCH ;NO GO BACK SKPNO: JSR PC,MOVCHR TSTB R0 BEQ NDLIN ;NULL CHECK JSR PC,TYPE TST TYPECH BNE NTNUM ;NOT NUMBER INC LINPT ;INC PTR TO NEXT CHR BR SKPNO ;AND REPEAT NDLIN: NTNUM: CMP #LABL,R1 ;WAS A LABEL FOUND??? BEQ NOLABL ;NO SKIP STORE JSR PC,STOLBL ;YESY STORE NOLABL: RTS PC ; WHEN THIS ROUTINE IS EXITED- THE POINTER LINPTR POINTS TO THE ; CHR THAT STOPED THE SCAN .PAGE ;THIUS ROUTINE GETS AND STORES A VARIABLE NAME IN A STRING'LINE' GETVAR: MOV #VAR,R1 ;BLANK 'VAR' MOV #20040,(R1)+ MOV #20040,(R1)+ MOV #20040,(R1)+ JSR PC,MOVCHR TSTB R0 BNE NTNLVR ;NULL=END OF LINE OT: INC ARGFLG CLR PNMFLG ;CLEAR UPDATE UPDATE PROGRAM NAME FLAG RTS PC NTNLVR: JSR PC,TYPE ;IS IT A LETTER TST TYPECH BGT LETR ;YES LETTER BEQ NUMB ;IS IT A NUMBER CMPB #47,R0 ;"'" BEQ QTHAL ;ITS A HOLERATH USEING QUOTES CMPB #42,R0 ;'"' BEQ OCTNO ;OCTAL NO PREFIX CMPB #56,R0 ;'.' BEQ POINT ;PERIOD INC LINPT CLR PNMFLG RTS PC QTHAL: INC LINPT ;INC PTR TO NEXT CHR INC SUEXP JSR PC,MOVCHR TSTB R0 BEQ OT ;NULL-DONE CMPB #47,R0 ;FOUND CLOSEING "'" YET BNE QTHAL ;NOT YET CLR SUEXP NTLG: INC LINPT ;SET PTR TO CHR AFTER HOL CLR PNMFLG RTS PC OCTNO: INC LINPT NUMB: JSR PC,SKPNUM ;SKIP THE NUMBER CLR PNMFLG RTS PC POINT: JSR PC,LOGCK ;IS POINT BEGINING OF LOGICAL OP TST LOGOP BEQ NTLG ;NO CAN ONLY BE PART OF A NUMBER-HANDLE AS SUCH ADD LOGOP,LINPT ;SKIP LOGICAL OP CLR PNMFLG RTS PC LETR: MOV #VAR,R1 ;A LETTER-SET UP PTR FOR STORAGE STOCHR: MOVB R0,(R1)+ ;STORE CHR SKPCHR: INC LINPT JSR PC,MOVCHR TSTB R0 BEQ NGTVAR ;NULL END OF LINE JSR PC,TYPE TST TYPECH BLT GTVAR ;NOT LETTER OR NUMBER END OF SCAN MOV #VAR,-(SP) ADD #6,(SP) CMP (SP)+,R1 BEQ SKPCHR ;YES KEEP GETTING BUT NOT STOREING CHRS ;UNTILL END OF VAR NAME BR STOCHR ;STOR CHR NGTVAR: GTVAR: TST SKIP BNE GTDATA JSR PC,STOVAR GTDATA: CLR PNMFLG RTS PC .PAGE MOVCHR: TST ARGFLG BNE NDLIN2 TSTB @LINPT BNE NTNUL NLIN: JSR PC,GETLIN TST EOF BNE NDLIN2 TSTB LIN BEQ NDLIN2 CMPB #'C,LIN BEQ NDLIN2 CMPB #'D,LIN BNE CHKCNT TST DEBUG BEQ NDLIN2 CHKCNT: CMPB #'0,LIN+5 BEQ NDLIN2 CMPB #' ,LIN+5 BEQ NDLIN2 MOV #FILLER,R0 JSR PC,PRTLIN TST NOSRC BNE 3$ TST SAVENO BNE 1$ MOV #40,R0 BR 2$ 1$: MOV #'*,R0 2$: JSR PC,PUTCHR MOV #LIN,R0 JSR PC,PRTLIN 3$: CMPB #'D,LIN BNE NOD MOVB #' ,LIN NOD: MOV #LIN+6,LINPT BR MOVCHR NTNUL: TST SUEXP BNE NOBL CMPB #' ,@LINPT BNE NOBL INC LINPT BR MOVCHR NOBL: TST SUEXP BNE 1$ CMPB #'!,@LINPT BEQ NLIN 1$: CMP LINPT,FINLIN BGE NLIN MOVB @LINPT,R0 RTS PC NDLIN2: INC ARGFLG CLR R0 RTS PC .END