.TITLE TIMES ; JEFFREY KODOSKY ARL JUL76 ; ; FSUBR ; ENTRY: 1 ARG ; EXIT: 1 ARG ; ERRORS: I4, HARD MATH ERROR (SUPPRESSED WITH Z SWITCH FOR ; LEGAL OPERATIONS WITH INFINITY. ZERO TIMES ; INFINITY IS ALWAYS ILLEGAL) ; CALLS: EVLIS ; CAR ; CDR ; ATM2N ; I2ATM ; R2ATM ; MLI ; IR ; MLR ; GET .GLOBL TIMES,ZTIMES,APVAL,ZSW,QI4ERR,QEVLIS,QCAR .GLOBL QCDR,QATM2N,QI2ATM,QR2ATM,QMLI,QIR,QMLR,QGET TIMES: QEVLIS ;EVALUATE LIST OF ARGUMENTS CLR (PC)+ ACFLAG: .WORD 0 ;0=INT,>0=REAL,<0=INF MOV @R5,R3 BEQ TIME04 ;JUMP IF NO ARGS! QCDR MOV R3,-(R5) QCAR QATM2N BCC TIME10 ;JUMP IF AC INTEGER INC ACFLAG ;ELSE REAL BIT #77777,@SP ;CHECK FOR INF OR ZERO BNE TIME10 TST 2(SP) BEQ TIME10 NEG ACFLAG ;NOTE INF BR TIME20 ;JUMP TO SEE IF ITS OK TIME04: MOV (R5)+,-(SP) ;POP NIL AND RETURN INTEGER 0 TIME05: QI2ATM .WORD 0 TIME07: CMP ACFLAG,(R5)+ ;TST ACFLAG BEQ TIME05 QR2ATM .WORD 0 MOV #-1,2(SP) ;CLEAN INF TIME10: MOV @R5,R3 ;GET NEXT NUMBER BEQ TIME07 QCDR MOV R3,-(R5) QCAR QATM2N BCS TIME27 ;JUMP IF NEXT NUMBER IS REAL TST ACFLAG BNE TIME14 ;JUMP IF AC NOT INTEGER QMLI ;MULTIPLY INTEGERS ADC ACFLAG ;NOTE REAL AC IF OVERFLOW BR TIME10 TIME14: BMI TIME23 ;JUMP IF AC = INF, ARG = INT TIME15: QIR ;AC=REAL, ARG=INT TIME16: QMLR ;MULTIPLY REALS BCC TIME10 NEG ACFLAG ;OVERFLOW TO INF TIME20: ROOM 3 ;CHECK IF INF ALLOWED MOV APVAL,-(R5) MOV ZSW,-(R5) QGET TST (R5)+ BNE TIME10-6 ;JUMP IF OK TO MAKE CLEAN INF TIME21: QI4ERR ;ELSE HARD ERROR TIME22: MOV (SP)+,@SP TIME23: TST (SP)+ ;ADJUST SIGN OF AC=INF BGT TIME10 BEQ TIME21 ;HARD ERROR IF 0*INF ADD #100000,@SP ;CHANGE SIGN OF AC BR TIME10 TIME27: BIT #77777,@SP ;ARG=REAL OR INF BEQ TIME30 ;JUMP IF ARG=0 OR INF TST ACFLAG BMI TIME22 ;JUMP IF ARG=REAL, AC=INF BNE TIME16 ;JUMP IF ARG=REAL,AC=REAL MOV 4(SP),R3 ;SWITCH AC=INT, ARG=REAL MOV 2(SP),4(SP) MOV (SP)+,@SP MOV R3,-(SP) INC ACFLAG ;AC=REAL, ARG=INT BR TIME15 TIME30: TST 2(SP) BEQ TIME40 ;JUMP IF ARG=0.0 TST ACFLAG ;ARG=INF BMI TIME22 ;JUMP IF INF,INF BNE TIME35 ;JUMP IF AC=REAL,ARG=INF TST 4(SP) ;AC=INT,ARG=INF BEQ TIME21 ;HARD ERROR IF INF*0 BPL TIME32 ADD #100000,@SP ;CHANGE SIGN OF INF ARG TIME32: MOV (SP)+,@SP ;MOVE INF INTO AC DEC ACFLAG BR TIME20 ;CHECK IF INF OK TIME35: TST 4(SP) ;AC=REAL,ARG=INF BEQ TIME21 ;HARD ERROR IF INF*0 BPL TIME37 ADD #100000,@SP ;CHANGE SIGN OF ARG=INF TIME37: MOV (SP)+,@SP MOV (SP)+,@SP NEG ACFLAG BR TIME20 ;CHECK IF INF OK TIME40: TST ACFLAG ;ARG=0.0 BMI TIME21 ;HARD ERROR IF 0*INF BEQ .+4 TST (SP)+ ;ELSE MAKE INT 0 CMP (SP)+,(SP)+ CLR @SP CLR ACFLAG BR TIME10 ZTIMES=.-TIMES .END