TITLE SCAT2 STANDARD COMPLEX ALGEBRA TRANSLATER V.2. SUBTTL ACCUMULATOR DEFINITIONS TWOSEG VCODE==1 VMAJOR==2 VMINOR==3 VEDIT==62 T0==0 ;TEMPORARY ACS FOR LOCAL USE T1==1 T2==2 T3==3 T4==4 T5==5 G1==6 ;GLOBALS FOR PASSING ARGS BETWEEN S/R'S G2==7 G3==10 ;COUNT ON LINE A1==11 ;ARITHMETIC REGISTERS A2==12 A3==13 A4==14 PS1==15 ;STACK POINTERS PS2==16 PSB==17 L==16 ;LINK REGISTER F1==A1 ;FLAGS NEEDED DURING DECODING F2==A2 T6==A4 ;EXTRA TEMP NEEDED DURING DECODING INTERN .JBVER .JBVER==137 LOC .JBVER BYTE (3)VCODE(9)VMAJOR(6)VMINOR(18)VEDIT RELOC 0 RELOC 400000 PAGE SUBTTL INITIALISATION START: RESET MOVE PSB, [IOWD 100, SUBSTK] SETZM VARTAB ;ZERO VARTAB TO IMAG MOVE T0, [XWD VARTAB,VARTAB+1] BLT T0, S1-1 OUTSTR [ASCIZ /SCAT (26-MAR-74) READY /] PAGE SUBTTL NEW COMMAND INITIALISATION NEWCOM: SETZM S1 ;ZERO S1 TO WFROM MOVE T0, [XWD S1, S1+1] BLT T0, WFROM SETZ G3, G3 ;ZERO LINE COUNT MOVE F1, [23,,23] ;SET CHECK FLAGS JFCL 17, .+1 ;CLEAR ERROR FLAGS MOVE PS1, [IOWD 100, S1] ;SET UP STACK POINTERS MOVE PS2, [IOWD 100, S2] MOVE PSB, [IOWD 100, SUBSTK] OUTCHR ["*"] ;INDICATE READY ADDI G3, 1 ;POSITION ON LINE PAGE SUBTTL INPUT AND DECODING INNOC: PUSHJ PSB, GETCHR ;HERE IF NO CHAR READY INMITC: ;HERE IF ALREADY HAVE CHAR PUSHJ PSB, SKCHCK ;IS THIS ONE WANTED JRST .+5 ;NO CAIL T0, "A" ;IS IT A LETTER? CAILE T0, "Z" SKIPA ;NO JRST LETTER ;YES A LETTER PUSHJ PSB, SKCHCK ;IS THIS ONE WANTED JRST .+3 ;NO CAIN T0, "(" ;COMPLEX NO.? JRST CNUMBR ;YES PUSHJ PSB, SKCHCK ;IS THIS ONE WANTED JRST .+9 ;NO CAIE T0, "*" ;AN OPERATOR? CAIN T0, "/" JRST OPR ;YES *,/ CAIE T0, "+" CAIN T0, "-" JRST OPR ;YES +,- CAIN T0, "^" JRST OPR ;YES ^ TRNN T0, 777626 JRST OPR PUSHJ PSB, SKCHCK ;IS THIS ONE WANTED JRST .+3 ;NO CAIN T0, "_" ;ASSIGNMENT? JRST ASSIGN PUSHJ PSB, SKCHCK ;IS THIS ONE WANTED JRST .+3 ;NO CAIN T0, "[" ;BRACE? JRST BRACE ;YES PUSHJ PSB, SKCHCK ;IS THIS ONE WANTED JRST .+3 CAIN T0, "]" ;LAST CHANCE JRST BACBRA ;WHEW JRST PROCIG ;NAUGHTY, NAUGHTY PAGE SUBTTL PROCESS EACH TYPE OF INPUT ; A VARIABLE NAME ********** LETTER: PUSHJ PSB, CONST ;GET ITS VALUE OR STACK IT PUSH PS2, G2 ;NO ASSIGNMENT PUSH PS2, G1 ;ASSIGNMENT - IMAG PART MOVE F1, [54,,54] JRST INMITC ;BACK FOR NEXT PROCESS ; A COMPLEX PAIR ********** CNUMBR: PUSHJ PSB, RCPAIR ;GET ITS VALUE PUSH PS2, G1 ;REAL PART PUSH PS2, G2 ;IMAG PART MOVE F1, [44,,44] JRST INNOC ;NEXT ONE ; AN OPERATOR ********** OPR: TLNE PS1, 77 ;IS S1 EMPTY? JRST NOTEMP ;NO FALLEV: PUSH PS1, T0 ;YES OR LEVEL TEST FALSE MOVE F1, [23,,23] JRST OPRET NOTEMP: PUSHJ PSB, LEV ;IS CHAR LEV .LE. TOP S1 JRST FALLEV ;NO POP PS1, T1 ;YES PUSH PS2, T1 JRST OPR ;TRY AGAIN OPRET: TRNE T0, 777626 JRST INNOC MOVEI T0, "[" JRST BRACE ;AN OPENING BRACE OR ASSIGNMENT ********** BRACE: PUSH PS1, T0 ;PUT IT AWAY MOVE F1, [63,,63] JRST INNOC ;GET NEXT ONE ; ASSIGNMENT ********** ASSIGN: PUSH PS1, T0 ;PUT ON STACK MOVE F1, [23,,23] JRST INNOC ;RETURN ; A CLOSING BRACE ********** BACBRA: MOVE F1, [44,,44] BACB1: TLNN PS1, 77 ;IS S1 EMPTY? JRST UNB ;YES POP PS1, T1 ;NO CAIN T1, "[" ;IS IT [ JRST INNOC ;YES PUSH PS2, T1 ;NO - PUT IT ON S2 JRST BACB1 ;TRY AGAIN UNB: HRLI G3, 9 ;UNB PARENTHESES ADDI G3, 1 JRST ERRH UNB1: HRLI G3, 9 ;ENTER ERROR HANDLER HRRZ T5, G3 ; AT ERPRNT HLRZ T4, G3 MOVE T3, [-1] JRST ERPRNT ; HERE FOR OTHER CHARACTERS ********** PROCIG: CAIN T0, 12 ;IS IT JRST POSFIN ;YES CAIN T0, " " ;IGNORE BLANKS JRST BLPRC CAIN T0, 15 ;IGNORE CR IN ANTICIPATION JRST INNOC ; OF LF HRLI G3, 1 ;OTHER IS ILLEGAL ADDI G3, 1 JRST ERRH ;JUMP TO ERROR HANDLER BLPRC: LSH F1, ^D-12 ;RESTORE FLAG HRL F1, F1 ; AND DUPLICATE JRST INNOC ; HERE FOR END OF POSTFIX STRING ********** POSFIN: TLNN PS1, 77 ;S1 EMPTY JRST POSTR ;YES POP PS1, T2 ;NO TRANSFER S1 TO S2 CAIN T2, "[" ;IF [ APPEARS IT JRST UNB1 ; IS UNBAL. PUSH PS2, T2 JRST POSFIN ;TRY AGAIN ; TRANSFER WHOLE STRING TO S1 ; IN REVERSE ORDER POSTR: TLNN PS2, 77 ;S2 EMPTY? JRST PROCES ;YES POP PS2, T0 ;EXCHANGE PUSH PS1, T0 JRST POSTR PAGE SUBTTL PROCESSING OF POLISH STRING ; ; NOW WE HAVE A POLISH STRING IN S1 TO EXECUTE ; PROCES: SETZ T1, T1 ;ZERO ACS 0-14 MOVE T0, [XWD T1, T2] BLT T0, A4 ; ; PREPARE TO DO ARITHMETIC ; TPOP: TLNN PS1, 77 ;S1 EMPTY? JRST RESOUT ;YES POP PS1, T0 ;GET TOP CHAR CAIN T0, "+" ;IS IT + JRST CPL CAIN T0, "-" ;IS IT - JRST CMIN CAIN T0, "/" ;IS IT / JRST CDIV CAIN T0, "*" ;IS IT * JRST CMUL CAIN T0, "^" ;IS IT ^ JRST CUP CAIN T0, "_" ;IS IT _ JRST CASS HRRZ T1, T0 CAIN T1, 151 JRST FUNCTH PUSH PS2, T0 ;MUST BE NO. JRST TPOP PAGE SUBTTL DO ARITHMETIC ; DO ADDITION CPL: PUSHJ PSB, GET4 ;UNSTACK LAST VALUES FADR A1, A3 FADR A2, A4 PUSHJ PSB, STOR2 ;PUT BACK JRST TPOP ; DO SUBTRACTION CMIN: PUSHJ PSB, GET4 ; UNSTACK LAST VALUES FSBR A1, A3 ; SUBTRACT FSBR A2, A4 PUSHJ PSB, STOR2 ;RE-STORE JRST TPOP ; DO MULTIPLICATION CMUL: PUSHJ PSB, GET4 MOVE T1, A1 ;DO REAL PART FMPR T1, A3 MOVE T2, A2 FMPR T2, A4 FSBR T1, T2 ;REAL PART IN T1 MOVE T2, A2 ;DO IMAG PART FMPR T2, A3 MOVE T3, A1 FMPR T3, A4 FADR T2, T3 ;IMAG PART IN T2 MOVE A1, T1 ;PUT THEM AWAY MOVE A2, T2 PUSHJ PSB, STOR2 JRST TPOP ; DO DIVISION CDIV: PUSHJ PSB, GET4 MOVE T0, A3 ;GET DIVISOR FMPR T0, A3 ;SQUARE MOVE T1, A4 FMPR T1, A4 ;SQUARE FADR T0, T1 ;ADD MOVE T1, A1 ;DO REAL PART FMPR T1, A3 MOVE T2, A2 FMPR T2, A4 FADR T1, T2 ;REAL IN T1 MOVE T2, A2 ;DO IMAG PART FMPR T2, A3 MOVE T3, A1 FMPR T3, A4 FSBR T2, T3 ;IMAG IN T2 FDVR T1, T0 ;DIVIDE FDVR T2, T0 MOVE A1, T1 ;AND PUT AWAY MOVE A2, T2 PUSHJ PSB, STOR2 JRST TPOP ; DO EXPONENTIATION CUP: PUSHJ PSB, GET4 MOVEM L, SAVL ;SAVE 16 MOVEI L, A3 ;POINTER TO POWER MOVE T0, A1 ;BASE IN T0,T1 MOVE T1, A2 PUSHJ PSB, CEXP.3## ;SYSTEM ROUTINE MOVE L, SAVL ;RESTORE L MOVE A1, T0 ;RESULT IN T0,T1 MOVE A2, T1 PUSHJ PSB, STOR2 ;STORE JRST TPOP ; DO ASSIGNMENT CASS: PUSHJ PSB, GET2 ;GET TWO VALUES POP PS2, T1 ;VAR NAME PUSHJ PSB, WR6STR ;WRITE O/P SETOM ASSFLG ;SET FLAG MOVNI G1, 50 ;COUNTER ASSLOP: MOVE T0, VARTAB+50(G1) ;SEARCH VARTAB CAMN T0, T1 ;FOR VARIABLE JRST ASSFND JUMPE T0, ASSNFD ;OR NULL AOJL G1, ASSLOP MOVEI T5, 0 ;ERROR IF OUT END MOVEI T4, 7 MOVEI T3, [-1] JRST ERPRNT ASSNFD: MOVEM T1, VARTAB+50(G1) ;NEW VARIABLE ASSFND: MOVEM A1, REAL+50(G1) ;OLD " MOVEM A2, IMAG+50(G1) PUSHJ PSB, STOR2 JRST TPOP ; FUNCTION HANDLER FUNCTH: PUSHJ PSB, GET2 CAMN T0, ['MAG',,151] JRST MAG CAMN T0, ['ANG',,151] JRST ANG CAMN T0, ['SNH',,151] JRST SNH CAMN T0, ['TNH',,151] JRST TNH CAMN T0, ['CSH',,151] JRST CSH CAMN T0, ['CAR',,151] JRST CAR CAMN T0, ['POL',,151] JRST POL ERRFUN: PUSHJ PSB, STOR2 HRRZI T4, 12 SETZ T5, T5 MOVE T3, [-1] JRST ERPRNT MAG: JSA L, CABS## EXP A1 MOVE A1, T0 MOVEI A2, 0 PUSHJ PSB, STOR2 JRST TPOP ANG: JSA L, ATAN2## ARG A2 ARG A1 FMPR T0, [57.29577951] MOVE A1, T0 MOVEI A2, 0 PUSHJ PSB, STOR2 JRST TPOP SNH: PUSHJ PSB, SINH PUSHJ PSB, STOR2 JRST TPOP CSH: PUSHJ PSB, COSH PUSHJ PSB, STOR2 JRST TPOP TNH: MOVE A3, A1 MOVE A4, A2 PUSHJ PSB, SINH EXCH A3, A1 EXCH A4, A2 PUSHJ PSB, COSH ;SINH IN A3,A4 ;COSH IN A1,A2 MOVE T0, A3 MOVE T1, A4 MOVEI L, A1 PUSHJ PSB, CFDM.0## PUSHJ PSB, STOR2 JRST TPOP SINH: JSA L, CEXP## EXP A1 MOVE T2, T0 MOVE T3, T1 FMPR A1, [-1.0] FMPR A2, [-1.0] JSA L, CEXP## EXP A1 FSBR T2, T0 FSBR T3, T1 MOVEM T2, A1 MOVEM T3, A2 FDVR A1, [2.0] FDVR A2, [2.0] POPJ PSB, COSH: JSA L, CEXP## EXP A1 MOVE T2, T0 MOVE T3, T1 FMPR A1, [-1.0] FMPR A2, [-1.0] MOVE T2, T0 MOVE T3, T1 JSA L, CEXP## EXP A1 FADR T0, T2 FADR T1, T3 MOVEM T0, A1 MOVEM T1, A2 FDVR A1, [2.0] FDVR A2, [2.0] POPJ PSB, CAR: JSA L, SIND## ARG A2 MOVEM T0, T5 JSA L, COSD## ARG A2 ;SIN IN T5, COS IN T0 FMPR T0, A1 FMPR T5, A1 CARRET: MOVEM T0, A1 MOVEM T5, A2 PUSHJ PSB, STOR2 JRST TPOP POL: JSA L, CABS## EXP A1 MOVEM T0, T5 JSA L, ATAN2## EXP A2 EXP A1 FMPR T0, [57.29577951] EXCH T0, T5 JRST CARRET PAGE SUBTTL NOW OUTPUT RESULTS RESOUT: SKIPGE ASSFLG ;NEED 'RESULT = ' JRST NUMPRT MOVE T1, [SIXBIT /RESULT/] PUSHJ PSB, WR6STR PUSHJ PSB, GET2 ;AND GET RESULTS NUMPRT: PUSHJ PSB, WCPAIR ;WRITE NUMBER OUTSTR CRLF JRST NEWCOM PAGE SUBTTL SWITCH HANDLER SWITCH: MOVE T0, [XWD T1, SAV] ;SAVE ACS BLT T0, SAV+4 NSW: PUSHJ PSB, INSW ;GET SW CHAR CAIE T0, 33 ;ESCAPE OR CAIN T0, 175 ;ALTMODE - LAST SWITCH JRST LASTSW CAIN T0, "D" ;D - DUMP JRST DUMP CAIN T0, "E" ;E - EXIT EXIT CAIN T0, "R" ;R - RESTART COMMAND JRST RE CAIN T0, "Q" ;Q - QUERY ERRORS JRST QUERY CAIN T0, "L" ;L - LIST ERRORS AND IMPLICIT R JRST ERRSW CAIN T0, "C" ;C - CLEAR ERROR COUNT JRST ECLR CAIN T0, "H" ;H - HELP JRST HELP CAIN T0, "X" ;X SWITCH - DELETE VARIABLES JRST DELVAR ; UNRECOGNIZED SWITCH ********** OUTSTR [ASCIZ / UNRECOGNIZED SWITCH /] OUTCHR T0 HRRI G3, ^D36 NSMES: OUTSTR [ASCIZ /, NEXT SWITCH $/] JRST NSW ; LAST SWITCH ********** LASTSW: OUTSTR [ASCIZ / CONTINUE, NOTHING HAS BEEN CHANGED /] LASTNO: MOVE T0, [XWD SAV, T1] BLT T0, T5 ;RESTORE ACS PUSHJ PSB, GETCHR POPJ PSB, ;RETURN ; ERROR QUERY ********** QUERY: HLRZ T1, G3 ;GET ERROR COUNT JUMPE T1, QNO ;NO ERRORS OUTSTR [ASCIZ / ERRORS/] ;THERE ARE SOME HRRI G3, ^D21 JRST NSMES QNO: OUTCHR ["$"] ;TERMINATE SWITCH LIST ADDI G3, 1 JRST LASTNO ;AND RETURN AS THO NOTHING HAPPENED ; DUMP OF VARIABLES ********** DUMP: SKIPE VARTAB ;ANY DEFINED? JRST DNO1 ;YES OUTSTR [ASCIZ / NO VARIABLES DEFINED/] ;NO JRST NSMES DNO1: SETZ G1, G1 ;ZERO INDEX DNO2: OUTSTR CRLF ;NEXT LINE MOVE T1, VARTAB(G1) ;GET NEXT NAME JUMPE T1, DEND ;NULL IS END PUSHJ PSB, WR6STR ;WRITE NAME MOVE A1, REAL(G1);AND VALUES MOVE A2, IMAG(G1) PUSHJ PSB, WCPAIR AOJA G1, DNO2 ;LOOP FOR NEXT DEND: OUTSTR [ASCIZ / NOW/] JRST NSMES ; CLEAR ERROR COUNT ********** ECLR: HRLI G3, 0 OUTSTR [ASCIZ / ERRORS CLEARED/] HRRI G3, ^D29 JRST NSMES ; HELP - HELP TEXT ********** HELP: OUTSTR [ASCIZ / SWITCHES ARE: ============= C - CLEAR ERROR COUNT, COMMAND CONTINUED D - DUMP ALL VARIABLES AND VALUES ASSIGNED TO DATE E - EXIT H - TYPE THIS TEXT/] OUTSTR [ASCIZ / L - LIST ERRORS AND IMPLICIT R Q - QUERY IF ERRORS EXIST R - RESTART COMMAND/] OUTSTR [ASCIZ / X - DELETE VARIABLES - TERMINATES SWITCH LIST NOW/] HRRI G3, ^D18 JRST NSMES ; ERROR LIST ********** ERRSW: HLRZ T1, G3 JUMPE T1, QNO OUTSTR CRLF HRRZ T5, G3 HLRZ T4, G3 MOVE T3, [-1] JRST ERPRNT ; RESTART COMMAND ********** RE: OUTSTR CRLF JRST NEWCOM ; DELETE VARIABLES ********** DELVAR: OUTSTR [ASCIZ / CONFIRM: /] MOVEI G3, 9 PUSHJ PSB, INSW CAIE T0, "*" ;WANT ALL? JRST DELSOM ; CLEAR ALL MOVE T0, [XWD VARTAB,VARTAB+1] SETZM VARTAB BLT T0, S1-1 ;BLT 0 TO ALL OUTSTR [ASCIZ / ALL CLEARED/] MOVEI G3, 26 JRST NSMES ;CLEAR ONLY SOME DELSOM: MOVE T1, [POINT 6,T2] ;DECODE NAME MOVE T3, [-6] ;CHAR CNT SETZ T2, T2 ;ZERO RECEPTOR DELS1: CAIG T0, "Z" ;FIRST CHAR A-Z CAIGE T0, "A" SKIPA JRST DELLEG ;LEGAL CAIG T0, "9" CAIGE T0, "0" SKIPA JRST DELLEG CAIE T0, "," JRST CRTEST SETZM NLETT PUSHJ PSB, DELEND ;DEL VAR IN T2 JRST DELSOM CRTEST: CAIE T0, 15 ;IGNORE CR JRST LFTEST PUSHJ PSB, INSW JRST DELS1 LFTEST: CAIN T0, 12 ;END OF LINE JRST DELFIN HRLI G3, 1 JRST ERRH DELLEG: SUBI T0, 40 ;HERE TO DECODE VARIABLE NAME IDPB T0, T1 ;PUT CHAR AWAY PUSHJ PSB, INSW AOJLE T3, DELS1 ;RETURN WITH CHAR HRLI G3, 2 ;ERROR JRST ERRH DELEND: MOVNI T1, 50 DELEN1: CAMN T2, VARTAB+50(T1) JRST DELFND SKIPE VARTAB+50(T1) AOJL T1, DELEN1 HRLI G3, 3 JRST ERRH DELFND: MOVE T0, [-1] MOVEM T0, VARTAB+50(T1) SKIPL NLETT PUSHJ PSB, INSW POPJ PSB, DELFIN: JUMPE T2, SHUFFL SETOM NLETT PUSHJ PSB, DELEND ;PUT AWAY PRESENT ONE FIRST SHUFFL: MOVNI T5, 50 ;AND SHUFFLE MOVE T4, [-1] SHUFF1: SKIPN VARTAB+50(T5) JRST SHUFIN CAMN T4, VARTAB+50(T5) JRST SHUFMK SHFRET: AOJL T5, SHUFF1 JRST SHUFIN SHUFMK: MOVE T3, T5 SHFMK1: SKIPN VARTAB+51(T3) JRST SHFMK2 MOVE T1, VARTAB+51(T3) MOVEM T1, VARTAB+50(T3) MOVE T1, REAL+51(T3) MOVEM T1, REAL+50(T3) MOVE T1, IMAG+51(T3) MOVEM T1, IMAG+50(T3) CAMGE T3, [-2] AOJA T3, SHFMK1 SHFMK2: SETZM VARTAB+50(T3) SETZM REAL+50(T3) SETZM IMAG+50(T3) JRST SHUFFL SHUFIN: OUTSTR [ASCIZ /CLEARED/] JRST NSMES PAGE SUBTTL ERROR HANDLER ERRH: HRRZ T5, G3 ;POSITION OF ERROR HLRZ T4, G3 ;ERROR TYPE MOVE T3, [-1] ;CONTROL COUNT ERRCHR: PUSHJ PSB, GETCHR ;FINISH LINE CAIE T0, 12 ; = EOL JRST ERRCHR ;TRY AGAIN ERPRNT: CAIGE T5, 25 ;WHAT TO PRINT FIRST PUSHJ PSB, ARROW ;ARROW TO BE PRINTED PUSHJ PSB, MESS ;MESSAGE AOSG T3 ;NEED TO DO ARROW PUSHJ PSB, ARROW OUTSTR CRLF JRST NEWCOM ;NEXT COMMAND ; PRINT MESSAGE ********** MESS: JRST MS(T4) ;OUTPUT APPROPRIATE MESSAGE MS: JRST E0 JRST E1 JRST E2 JRST E3 JRST E4 JRST E5 JRST E6 JRST E7 JRST E8 JRST E9 JRST E10 E0: OUTSTR [ASCIZ /NO ERRORS YET/] SUBI T5, ^D13 POPJ PSB, E1: OUTSTR [ASCIZ /ILL. CHAR. IN INPUT/] SUBI T5, ^D19 POPJ PSB, E2: OUTSTR [ASCIZ /TOO MANY CHARS/] SUBI T5, ^D14 POPJ PSB, E3: OUTSTR [ASCIZ /UNDEFINED VARIABLE/] SUBI T5, ^D18 POPJ PSB, E4: OUTSTR [ASCIZ /DELIMITER EXPECTED/] SUBI T5, ^D18 POPJ PSB, E5: OUTSTR [ASCIZ /NO. OUT OF RANGE/] SUBI T5, ^D16 POPJ PSB, E6: OUTSTR [ASCIZ /EXP OUT OF RANGE/] SUBI T5, ^D16 POPJ PSB, E7: OUTSTR [ASCIZ /TOO MANY VARIABLES/] SUBI T5, ^D19 POPJ PSB, E8: OUTSTR [ASCIZ *EXEC OV/UND FLOW*] SUBI T5, ^D16 POPJ PSB, E9: OUTSTR [ASCIZ /UNBAL PARENTH/] SUBI T5, ^D13 POPJ PSB, E10: OUTSTR [ASCIZ /UDF FCN/] POPJ PSB, ; PRINT ARROW ********** ARROW: SKIPN T5 ;IF NO ARROW REQD. POPJ PSB, SUBI T5, 2 ;AMEND POSITION FOR ARROW ADDI T3, 1 MOVNS T5, T5 ARR1: OUTCHR [" "] AOJL T5, ARR1 OUTCHR ["^"] POPJ PSB, PAGE SUBTTL SUBROUTINES ; ROUTINE TO GET A CHARACTER --------------------------------------------------- GETCHR: INCHRW T0, ;GET THE CHAR ADDI G3, 1 ;INC CHAR CNT CAIE T0, 33 ;ESCAPR OR CAIN T0, 175 ;ALTMODE - SWITCH? PUSHJ PSB, SWITCH POPJ PSB, ;NO - SO RETURN ; ROUTINE TO GET A SWITCH ------------------------------------------------------ INSW: INCHRW T0, ;GET THE CHAR ADDI G3, 1 CAIN T0, " " ;IGNORE BLANKS JRST INSW POPJ PSB, ; ROUTINE TO EVALUATE A VARIABLE ----------------------------------------------- CONST: MOVE T5, [POINT 6,T4] SETZ T4, T4 ;ZERO RECEPTOR SUBI T0, 40 ;CONV TO SIXBIT AND IDPB T0, T5 ;PUT AWAY EXISTING CHAR MOVE T3, [-5] ;GET READY FOR NEXT 5 NEXTCH: PUSHJ PSB, GETCHR ;GET CHAR CAIL T0, "A" ;IS IT A LETTER CAILE T0, "Z" SKIPA ;NO JRST GOOD ;YES CAIL T0, "0" ;IS IT A NUMBER CAILE T0, "9" JRST LASTCH ;NO GOOD: AOSLE T3 ;INC CHAR CNT JRST TOMANY ;TOO MANY SUBI T0, 40 ;CONV TO 6BIT IDPB T0, T5 ;PUT IT AWAY JRST NEXTCH ;NEXT ONE LASTCH: CAIN T0, "_" ;IS IT _ JRST SKRT ;YES SKIP CAIN T0, "[" JRST FUNCT SETZ T5, T5 ;NO GET VALUES NVAR: MOVE T1, VARTAB(T5) ;GET NEXT VAR JUMPE T1, NDEF ;IS IT NULL CAME T1, T4 ;EQUAL? AOJA T5, NVAR ;NO TRY NEXT ONE RET: MOVE G1, IMAG(T5) ;GET IMAG MOVE G2, REAL(T5) ; &REAL PARTS POPJ PSB, ;RETURN FUNCT: TRNE T4, 777777 JRST TOMANY HRRI T4, 151 POP PSB, (PSB) MOVE T0, T4 JRST INMITC SKRT: MOVEM T4, G1 ;SKIP RETURN AOS (PSB) POPJ PSB, TOMANY: HRLI G3, 2 ;TOO MANY CHARS ADDI G3, 1 JRST ERRH ;ERROR HANDLER NDEF: HRLI G3, 3 ;NOT DEFINED JRST ERRH ;MORE ERRORS ; ROUTINE TO READ A COMPLEX PAIR, WITH THANKS TO R. COOK'S IOLIB V.3. ---------- RCPAIR: SETOM TIME ;INITIATE MOVE T3, [MOVEM T4,G1] SETZB G1, G2 RREAL: PUSHJ PSB, GETCHR ;GET FIRST CHAR PUSHJ PSB, NEGTIV ;PROCESS SIGN PUSHJ PSB, GETCHR ;IT WAS SIGNED MOVSI T1, (10.0) ;NOT SIGNED TDZA T4, T4 ;ZERO RECEPTOR RRE10: PUSHJ PSB, GETCHR ;GET ACHAR PUSHJ PSB, CDIGIT ;CONVERT ASCII TO F.P JRST RRE20 ;NOT A DIGIT FMPR T4, T1 ;*10 FADR T4, T0 ;ADD NEW NO. PUSHJ PSB, OFCHK ;CHECK OVERFLOW JRST RRE10 ;GO BACK FOR NEXT RRE20: CAIE T0, "." ;CORRECT? JRST RRE40 ;NO - MAY BE EXPONENT RRE30: PUSHJ PSB, RDIGIT ;READ AND CONVERT JRST RRE40 ;NOT A DIGIT FDVR T0, T1 ;CORRECT FOR DEC PLACE FADR T4, T0 ;AND ADD PUSHJ PSB, OFCHK ;CHECK UNDERFLOW FMPRI T1, (10.0) ;CORRECT MULT FOR DEC PLACE JRST RRE30 ;NEXT RRE40: FMPR T4, SIGN ;GET CORR. SIGN CAIE T0, "E" ;EXPONENT? JRST RRE60 ;NO SKIPN T4 ;MANTISSA 1.0 FOR PURE E FORMAT MOVEI T4, [1.0] PUSHJ PSB, RDECEX ;YES GET DEC EXPONENT MOVE T5, [FMPRI T4,(10.0)] ;ASSUME +VE EXP. SKIPGE T2 ;IS IT REALLY -VE HRLI T5, (FDVRI T4,) ;YES MOVMS T2, T2 RRE50: SOJL T2, RRE60 ;APPLY EXP. XCT T5 PUSHJ PSB, OFCHK ;CHECK IF OVFLW OCCURRED JRST RRE50 RRE60: CAIN T0, ")" ;END OF NUMBER? JRST RRE70 ;YES CAIE T0, "," ;END OF FIRST HALF JRST RRE80 ;NO - ERROR RRE61: XCT T3 ;GET IN CORRECT AC ADDI T3, 1 ;READY FOR NEXT HALF AOSG TIME ;NO NEXT HALF? PUSHJ PSB, RREAL ;READ NEXT HALF RRE63: POPJ PSB, ;POP TWICE TO RETURN RRE70: JUMPE T4, RRE63 ;) FOUND AFTER 1ST HALF AOS TIME ;) FOUND DURING FIRST OR SECOND HALF JRST RRE61 RRE80: HRLI G3, 4 ;ERROR CONDITION ADDI G3, 1 JRST ERRH ; ROUTINES USED BY RCPAIR ------------------------------------------------------ RDIGIT: PUSHJ PSB, GETCHR ;GET CHAR CDIGIT: CAIL T0, "0" ;CONVERT IT CAILE T0, "9" ;IS IT LEGAL? POPJ PSB, ;NO SUBI T0, "0" ;CONVERT FSC T0, 233 AOS (PSB) ;SKIP RETURN POPJ PSB, RDECEX: SETZ T2, T2 ;ZERO RECEPTOR PUSHJ PSB, GETCHR ;GET CHAR PUSHJ PSB, NEGDEC ;SIGN? RDEC1: PUSHJ PSB, GETCHR ;YES CAIL T0, "0" ;NO CAILE T0, "9" ;IS IT LEGAL JRST RDEND ;NO IMULI T2, ^D10 ;MUL * 10 SUBI T0, 60 ;ADD TO NUMBER ADD T2, T0 ; AFTER CONVERSION JRST RDEC1 ;GO BACK FOR NEXT RDEND: IMUL T2, SIGN ;FIX SIGN CAIG T2, ^D38 ;CHECK EXPONENT SIZE CAMGE T2, [^D-38] JRST RDERR POPJ PSB, RDERR: HRLI G3, 6 JRST ERRH POPJ PSB, ;RETURN NEGDEC: SETOM WFROM ;INDICATES INTEGER NEGTIV: MOVE T6, [-1] ;ASSUME -VE AOS (PSB) ;ASSUME SKIP CAIN T0, "-" ;IS IT -VE JRST TST ;YES - OK CAIN T0, "+" JRST PL ;WHOOPS A + AOS (PSB) ;ANYTHING ELSE PL: MOVEI T6, 1 ;RESTORE + TST: SKIPL WFROM ;NOW SHOULD WE FLOAT JRST FLOTR ;YES TSTRET: MOVEM T6, SIGN ;PUT AWAY SOS (PSB) ;RESTORE CORRECT SKIP SETZM WFROM ;RESTORE CORRECT ENTRY POPJ PSB, ;AND RETURN FLOTR: MOVE T1, T6 IDIVI T1, 400 SKIPE T1 TLC T1, 243000 TLC T2, 233000 FADL T1, T2 MOVE T6, T1 SETZ T2, T2 JRST TSTRET ; ROUTINE TO MAKE LEVEL COMPARISONS -------------------------------------------- LEV: PUSHJ PSB, LEVFND ;FIND CURRENT LEVEL MOVEM T1, T5 ;PUT LEVEL IN T5 MOVEM T0, T3 ;SAVE T0 POP PS1, T0 ;FIND LEV TOP S1 MOVEM T0, REPLT0 ;STORE FOR POSSIBLE REPLACEMENT PUSHJ PSB, LEVFND MOVEM T1, T4 ;PUT LEV S1 IN T4 MOVE T0, T3 ;RESTORE T0 CAMG T5, T4 AOS (PSB) ;SKIP RETURN IF LE MOVE T3, REPLT0 ;PUT BACK ON STACK PUSH PS1, T3 ; IF TEST FAILS POPJ PSB, LEVFND: MOVEI T4, 11 ;SET UP TABLE SEARCH FINONE: SOJL T4, NFND HLRZ T1, LEVTAB(T4) ;GET NEXT CHAR HRRZ T6, T0 CAME T6, T1 JRST FINONE ;NO HRRZ T1, LEVTAB(T4) ;YES - GET ITS LEVEL POPJ PSB, ;RETURN NFND: MOVEI T1, 7 ;MUST BE CONST OR VAR POPJ PSB, ;ROUTINE TO TEST FOV & FUND FLOWS ---------------------------------------------- OFCHK: JFOV FOVH ;OF OCCURRED POPJ PSB, ;NO FOVH: HRLI G3, 5 ;YES ADDI G3, 1 JRST ERRH ; ROUTINE TO CHECK IF INPUT DECODING DESIRED ----------------------------------- SKCHCK: IDIVI F1, 2 ;STRIP OFF LOW DIGIT SKIPE F2 ;IS IT ZERO AOS (PSB) ;NO POPJ PSB, ;YES ; ; WR6STR - WRITES A 6BIT STRING IN T1 ------------------------------------------ ; WR6STR: MOVNI T2, 6 ;LOOP COUNTER MOVE T3, [POINT 6,T1] ;BYTE POINTER WR6ST1: ILDB T0, T3 ;GET NEXT CHAR ADDI T0, 40 PUSHJ PSB, WASCII ;AND OUTPUT AOJL T2, WR6ST1 OUTSTR [ASCIZ / = /] ;FOLLOW BY = POPJ PSB, ; ; WASCII - WRITES AN ASCII CHAR IN T0 ------------------------------------------ ; WASCII: OUTCHR T0 ;SIMPLY O/P CHAR POPJ PSB, ; ; WFPNO - WRITE A FLOATING POINT NO IN T1 -------------------------------- ; THANKS TO ROB COOK'S IOLIB V.3. ; WFPNO: SETZB T4, T5 ;INIT EXPS MOVE T6, [1.0E-7] ;SMALLEST PRINTABLE FRACTION MOVM T3, T1 ;SAVE NO JUMPGE T1, WFP1 ;SPACE IF POSVE MOVEI T0, "-" ;OTHERWISE SIGN SKIPA WFP1: MOVEI T0, " " PUSHJ PSB, WASCII JUMPE T3, WRE30 ;SPECIAL TEEATMENT FOR 0.0 WRE20: CAMGE T3, [1.0] ;BIGGER THAN RANGE JRST WRE25 FDVRI T3, (10.0) ;YES - REDUCE AOJA T5, WRE20 ;AND LOOP WRE25: CAML T3, [0.1] ;IS IT .LT. 0.1 JRST WRE30 ;NO FMPRI T3, (10.0) ;YES INC NO. SOJA T5, WRE25 WRE30: ADDI T3, 1 ;BEAT ROUNDING ERRORS MOVM T1, T5 ;MOD OF EXPONENT CAILE T1, 6 ;E FORMAT? EXCH T4, T5 ;YES JUMPG T5, WRE40 ;IF EXP .LT.0 MOVEI T0, "0" PUSHJ PSB, WASCII ;PRECEDE BY 0 JRST WRE50 WRE40: PUSHJ PSB, WDIGIT ;WRITE A DIGIT SOJG T5, WRE40 ;LOOP FOR ALL INTEGERS WRE50: MOVEI T0, "." ;DELIMITER PUSHJ PSB, WASCII WRE60: JUMPGE T5, WRE70 ;ANY MORE LEADING ZEROES MOVEI T0, "0" ;YES PUSHJ PSB, WASCII AOJA T5, WRE60 ;LOOP FOR MORE WRE70: PUSHJ PSB, WDIGIT ;WRITE A DIGIT JUMPN T3, WRE70 ;UNTIL NONE LEFT SKIPN T4 POPJ PSB, ;FINISH IF NOT WANTED MOVEI T0, "E" ;SHOW E PUSHJ PSB, WASCII MOVE T1, T4 ;SET UP AND JRST WDECL ;WRITE EXPONENT WDIGIT: FMPRI T3, (10.0) ;MAKE A DIGIT FMPRI T6, (10.0) ;* TEST FRACTION MOVE T1, T3 ;COPY NO MULI T1, 400 ;SEPARATE EXPON. ASH T2, -243(T1) ;KEEP TOP DIGIT MOVEI T0, "0"(T2) ;SET FOR O/P FSC T2, 233 ;CONVERT DIG TO REAL FSBR T3, T2 ;REMOVE FROM NO. PUSHJ PSB, WASCII ;WRITE NO. CAMG T3, T6 ;BIGGER THAN SMALLEST ALLOWABLE SETZ T3, T3 ; 8 DIGITS WRITTEN POPJ PSB, ; ; WDECL - WRITES A DECIMAL INTEGER IN T1 --------------------------------------- ; WDECL: SETZB T4, T5 ;TO WRITE A DEC EXPONENT SKIPGE T1 ;NEG? MOVEI T4, 1 ;YES MOVM T1, T1 ;GET MAGNITUDE WD1: IDIVI T1, 12 ;STRIP OFF LOW DIGIT PUSH PS1, T2 ;STACK IT JUMPE T1, WPR ;END? AOJA T5, WD1 WPR: MOVEI T0, "+" ;OP SIGN SKIPE T4 MOVEI T0, "-" PUSHJ PSB, WASCII WP1: POP PS1, T0 ;UNSTACK VALUE ADDI T0, 60 ;AND PRINT PUSHJ PSB, WASCII SOJGE T5, WP1 POPJ PSB, ; ; WCPAIR WRITES A COMPLEX PAIR FROM A1,A2 -------------------------------------- ; WCPAIR: MOVEI T0, "(" ;JUST USE PREVIOUS ROUTINES PUSHJ PSB, WASCII MOVE T1, A1 PUSHJ PSB, WFPNO MOVEI T0, "," PUSHJ PSB, WASCII MOVE T1, A2 PUSHJ PSB, WFPNO MOVEI T0, ")" PUSHJ PSB, WASCII POPJ PSB, ; GET4 &GET2 TO UNSTACK VALUES FROM S1 --------------------------- GET4: POP PS2, A4 ;GET LAST VALUES POP PS2, A3 ;INTO ARITH REGS GET2: POP PS2, A2 POP PS2, A1 POPJ PSB, ; STOR2 TO PUT 2 VALUES BACK ON S1 AND TEST FOR OVFLOW----------------- STOR2: PUSH PS2, A1 ;REAL PUSH PS2, A2 ;IMAG PUSHJ PSB, EXOV POPJ PSB, ; EXOV TO TEST FOR EXECUTION OVFLOWS ----------------------------------- EXOV: JFOV EXER ;OFLOW? POPJ PSB, ;NO EXER: MOVEI T5, 0 ;YES MOVEI T4, 8 MOVEI T3, [-1] JRST ERPRNT PAGE SUBTTL DATA LOCATIONS IN HISEG LEVTAB: 52,,4 ;* 151,,6 ;SUBR. 57,,4 ;/ 53,,3 ;+ 55,,3 ;- 136,,5 ;^ 137,,2 ;_ 133,,2 ;[ 135,,1 ;] DESCR: ASCII /SCAT2/ FILNAM: ASCII /DATFL/ PPN: 111,,132 CRLF: ASCIZ / / LIT RELOC PAGE SUBTTL DATA LOCATIONS IN LOSEG VARTAB: BLOCK 50 ;PREDEFINED VARIABLES REAL: BLOCK 50 ;REAL PARTS IMAG: BLOCK 50 ;IMAG PARTS S1: BLOCK 100 ;TEMP STORAGE STACKS S2: BLOCK 100 SUBSTK: BLOCK 100 ;S/R LINKAGE ASSFLG: BLOCK 1 ;ASSIGNMENT FLAG SIGN: BLOCK 1 ;SIGN HANDLING TIME: BLOCK 1 ;RECURSIVE S/R TIME CALLED WFROM: BLOCK 1 ;-VE PROCESSING SAV: BLOCK 5 ;SAVE ACS SAVT0: BLOCK 1 ;SAVE T0 REPLT0: BLOCK 1 ;REPLACE T0 SAVL: BLOCK 1 ;SAVE L NLETT: BLOCK 1 END START