X-Git-Url: https://jxself.org/git/?p=pdp10-muddle.git;a=blobdiff_plain;f=%3Cmdl.int%3E%2Farith.mid.94;fp=%3Cmdl.int%3E%2Farith.mid.94;h=602aabfdd3b9b838145557c4b8e17583f4e98bac;hp=0000000000000000000000000000000000000000;hb=bab072f950a643ac109660a223b57e635492ac25;hpb=233a3c5245f8274882cc9d27a3c20e9b3678000c diff --git a//arith.mid.94 b//arith.mid.94 new file mode 100644 index 0000000..602aabf --- /dev/null +++ b//arith.mid.94 @@ -0,0 +1,856 @@ +TITLE ARITHMETIC PRIMITIVES FOR MUDDLE + +.GLOBAL HI,RLOW,CPLUS,CMINUS,CTIMES,CDIVID,CFIX,CFLOAT +.GLOBAL CLQ,CGQ,CLEQ,CGEQ,C1Q,C0Q,CMAX,CMIN,CABS,CMOD,CCOS,CSIN,CATAN,CLOG +.GLOBAL CEXP,CSQRT,CTIME,CORB,CXORB,CANDB,CEQVB,CRAND,CLSH,CROT, +.GLOBAL SAT,BFLOAT,FLGSET + +;BKD + +;DEFINES MUDDLE PRIMITIVES: FIX,FLOAT,ATAN,IEXP,LOG, +; G?,L?,0?,1?,+,-,*,/,MAX,MIN,ABS,SIN,COS,SQRT,RANDOM, +; TIME,SORT. + +RELOCATABLE + +.INSRT MUDDLE > + +O=0 + + +DEFINE TYP1 + (AB) TERMIN +DEFINE VAL1 + (AB)+1 TERMIN + +DEFINE TYP2 + (AB)+2 TERMIN +DEFINE VAL2 + (AB)+3 TERMIN + +DEFINE TYP3 + (AB)+4 TERMIN +DEFINE VAL3 + (AB)+5 TERMIN + +DEFINE TYPN + (D) TERMIN +DEFINE VALN + (D)+1 TERMIN + + +YES: MOVSI A,TATOM ;RETURN PATH FOR 'TRUE' + MOVE B,IMQUOTE T + AOS (P) + POPJ P, + +NO: MOVSI A,TFALSE ;RETURN PATH FOR 'FALSE' + MOVEI B,NIL + POPJ P, + + ;ERROR RETURNS AND OTHER UTILITY ROUTINES + +OVRFLW==10 +OVRFLD: ERRUUO EQUOTE OVERFLOW + +CARGCH: GETYP 0,A ; GET TYPE + CAIN 0,TFLOAT + POPJ P, + JSP A,BFLOAT + POPJ P, + +ARGCHK: ;CHECK FOR SINGLE FIXED OR FLOATING + ;ARGUMENT IF FIXED CONVERT TO FLOATING + ;RETURN FLOATING ARGRUMENT IN B ALWAYS + ENTRY 1 + GETYP C,TYP1 + MOVE B,VAL1 + CAIN C,TFLOAT ;FLOATING? + POPJ P, ;YES, RETURN + CAIE C,TFIX ;FIXED? + JRST WTYP1 ;NO, ERROR + JSP A,BFLOAT ;YES, CONVERT TO FLOATING AND RETURN + POPJ P, + +OUTRNG: ERRUUO EQUOTE ARGUMENT-OUT-OF-RANGE + +NSQRT: ERRUUO EQUOTE NEGATIVE-ARGUMENT + +DEFINE MFLOAT AC + IDIVI AC,400000 + FSC AC+1,233 + FSC AC,254 + FADR AC,AC+1 + TERMIN + +BFLOAT: MFLOAT B + JRST (A) + +OFLOAT: MFLOAT O + JRST (C) + +BFIX: MULI B,400 + TSC B,B + ASH C,(B)-243 + MOVE B,C + JRST (A) + + ;DISPATCH TABLES USED TO CONTROL THE FLOW OF THE VARIOUS PRIMITIVES + +TABLE2: SETZ NO ;TABLE2 (0) +TABLE3: SETZ YES ;TABLE2 (1) & TABLE3 (0) + SETZ NO ;TABLE2 (2) + SETZ YES + SETZ NO + +TABLE4: SETZ NO + SETZ NO + SETZ YES + SETZ YES + + + +FUNC: JSP A,BFIX + JSP A,BFLOAT + SUB B,VALN + IDIV B,VALN + ADD B,VALN + IMUL B,VALN + JSP C,SWITCH + JSP C,SWITCH + + + +FLFUNC==.-2 + FSBR B,O + FDVR B,O + FADR B,O + FMPR B,O + JSP C,FLSWCH + JSP C,FLSWCH + +DEFVAL==.-2 + 0 + 1 + 0 + 1 + 377777,,-1 + 400000,,1 + +DEFTYP==.-2 + TFIX,, + TFIX,, + TFIX,, + TFIX,, + TFLOAT,, + TFLOAT,, + ;PRIMITIVES FLOAT AND FIX + +IMFUNCTION FIX,SUBR + + ENTRY 1 + + JSP C,FXFL + MOVE B,1(AB) + CAIE A,TFIX + JSP A,BFIX + MOVSI A,TFIX + JRST FINIS + +IMFUNCTION FLOAT,SUBR + + ENTRY 1 + + JSP C,FXFL + MOVE B,1(AB) + CAIE A,TFLOAT + JSP A,BFLOAT + MOVSI A,TFLOAT + JRST FINIS + +CFIX: GETYP 0,A + CAIN 0,TFIX + POPJ P, + JSP A,BFIX + MOVSI A,TFIX + POPJ P, + +CFLOAT: GETYP 0,A + CAIN 0,TFLOAT + POPJ P, + JSP A,BFLOAT + MOVSI A,TFLOAT + POPJ P, + +FXFL: GETYP A,(AB) + CAIE A,TFIX + CAIN A,TFLOAT + JRST (C) + JRST WTYP1 + + +MFUNCTION ABS,SUBR + ENTRY 1 + GETYP A,TYP1 + CAIE A,TFIX + CAIN A,TFLOAT + JRST MOVIT + JRST WTYP1 +MOVIT: MOVM B,VAL1 ;GET ABSOLUTE VALUE OF ARGUMENT +AFINIS: HRLZS A ;MOVE TYPE CODE INTO LEFT HALF + JRST FINIS + + + +MFUNCTION MOD,SUBR + ENTRY 2 + GETYP A,TYP1 + CAIE A,TFIX ;FIRST ARG FIXED ? + JRST WTYP1 + GETYP A,TYP2 + CAIE A,TFIX ;SECOND ARG FIXED ? + JRST WTYP2 + MOVE A,VAL1 + IDIV A,VAL2 ;FORM QUOTIENT & REMAINDER + JUMPGE B,.+2 ;Only return positive remainders + ADD B,VAL2 + MOVSI A,TFIX + JRST FINIS + ;PRIMITIVES PLUS, DIFFERENCE, TIMES, DIVIDE, MIN, AND MAX + +MFUNCTION MIN,SUBR + + ENTRY + + MOVEI E,6 + JRST GOPT + +IMFUNCTION MAX,SUBR + + ENTRY + + MOVEI E,7 + JRST GOPT + +MFUNCTION DIVIDE,SUBR,[/] + + ENTRY + + MOVEI E,3 + JRST GOPT + +MFUNCTION DIFFERENCE,SUBR,[-] + + ENTRY + + MOVEI E,2 + JRST GOPT + +IMFUNCTION TIMES,SUBR,[*] + + ENTRY + + MOVEI E,5 + JRST GOPT + +MFUNCTION PLUS,SUBR,[+] + + ENTRY + + MOVEI E,4 + +GOPT: MOVE D,AB ;ARGUMENT POINTER + HLRE A,AB + MOVMS A + ASH A,-1 + PUSHJ P,CARITH + JRST FINIS + +; BUILD COMPILER ENTRIES TO THESE ROUTINES + +IRP NAME,,[CMINUS,CDIVID,CPLUS,CTIMES,CMIN,CMAX]CODE,,[2,3,4,5,6,7] + +NAME: MOVEI E,CODE + JRST CARIT1 +TERMIN + +CARIT1: MOVEI D,(A) + ASH D,1 ; TIMES 2 + HRLI D,(D) + SUBM TP,D ; POINT TO ARGS + PUSH TP,$TTP + AOBJN D,.+1 + PUSH TP,D + PUSHJ P,CARITH + MOVE TP,(TP) + SUB TP,[1,,1] + POPJ P, + +CARITH: MOVE B,DEFVAL(E) ; GET VAL + JFCL OVRFLW,.+1 + MOVEI 0,TFIX ; FIX UNTIL CHANGE + JUMPN A,ARITH0 ; AT LEAST ONE ARG + MOVE A,DEFTYP(E) + POPJ P, + +ARITH0: SOJE A,ARITH1 ; FALL IN WITH ONE ARG + MOVE B,1(D) + GETYP C,(D) ; TYPE OF 1ST ARG + ADD D,[2,,2] ; GO TO NEXT + CAIN C,TFLOAT + JRST ARITH3 + CAIN C,TFIX + JRST ARITH1 + JRST WRONGT + +ARITH1: GETYP C,0(D) ; GET NEXT TYPE + CAIE C,TFIX + JRST ARITH2 ; TO FLOAT LOOP + XCT FUNC(E) ; DO IT + ADD D,[2,,2] + SOJG A,ARITH1 ; KEEP ADDING OR WHATEVER + SKIPE OVFLG + JFCL OVRFLW,OVRFLD + MOVSI A,TFIX + POPJ P, + +ARITH3: GETYP C,0(D) + MOVE 0,1(D) ; GET ARG + CAIE C,TFIX + JRST ARITH4 + PUSH P,A + JSP C,OFLOAT ; FLOAT IT + POP P,A + JRST ARITH5 +ARITH4: CAIE C,TFLOAT + JRST WRONGT + JRST ARITH5 + +ARITH2: CAIE C,TFLOAT ; FLOATER? + JRST WRONGT + PUSH P,A + JSP A,BFLOAT + POP P,A + MOVE 0,1(D) + +ARITH5: XCT FLFUNC(E) + ADD D,[2,,2] + SOJG A,ARITH3 + + SKIPE OVFLG + JFCL OVRFLW,OVRFLD + MOVSI A,TFLOAT + POPJ P, + +SWITCH: XCT COMPAR(E) ;FOR MAX & MIN TESTING + MOVE B,VALN + JRST (C) +COMPAR==.-6 + CAMLE B,VALN + CAMGE B,VALN + + + +FLSWCH: XCT FLCMPR(E) + MOVE B,O + JRST (C) +FLCMPR==.-6 + CAMLE B,O + CAMGE B,O + ;PRIMITIVES ONEP AND ZEROP + +MFUNCTION ONEP,SUBR,[1?] + MOVEI E,1 + JRST JOIN + +MFUNCTION ZEROP,SUBR,[0?] + MOVEI E, + +JOIN: ENTRY 1 + GETYP A,TYP1 + CAIN A,TFIX ;fixed ? + JRST TESTFX + CAIE A,TFLOAT ;floating ? + JRST WTYP1 + MOVE B,VAL1 + CAMN B,NUMBR(E) ;equal to correct value ? + JRST YES1 + JRST NO1 + +TESTFX: CAMN E,VAL1 ;equal to correct value ? + JRST YES1 + +NO1: MOVSI A,TFALSE + MOVEI B,0 + JRST FINIS + +YES1: MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST FINIS + +NUMBR: 0 ;FLOATING PT ZERO + 201400,,0 ;FLOATING PT ONE + ;PRIMITIVES LESSP AND GREATERP + +MFUNCTION LEQP,SUBR,[L=?] + MOVEI E,3 + JRST ARGS + +MFUNCTION GEQP,SUBR,[G=?] + MOVEI E,2 + JRST ARGS + + +MFUNCTION LESSP,SUBR,[L?] + MOVEI E,1 + JRST ARGS + +MFUNCTION GREATERP,SUBR,[G?] + MOVEI E,0 + +ARGS: ENTRY 2 + MOVE B,VAL1 + MOVE A,TYP1 + GETYP 0,A + PUSHJ P,CMPTYP + JRST WTYP1 + MOVE D,VAL2 + MOVE C,TYP2 + GETYP 0,C + PUSHJ P,CMPTYP + JRST WTYP2 + PUSHJ P,ACOMPS + JFCL + JRST FINIS + +; COMPILERS ENTRIES TO THESE GUYS + +IRP NAME,,[CGQ,CLQ,CGEQ,CLEQ]COD,,[0,1,2,3] + +NAME: MOVEI E,COD + JRST ACOMPS +TERMIN + +ACOMPS: GETYP A,A + GETYP 0,C + CAIE 0,(A) + JRST COMPD ; COMPARING FIX AND FLOAT +TEST: CAMN B,D + JRST @TABLE4(E) + CAMG B,D + JRST @TABLE2(E) + JRST @TABLE3(E) + +CMPTYP: CAIE 0,TFIX + CAIN 0,TFLOAT + AOS (P) + POPJ P, +COMPD: EXCH B,D + CAIN A,TFLOAT + JSP A,BFLOAT + EXCH B,D + CAIN 0,TFLOAT + JSP A,BFLOAT +COMPF: JRST TEST + +MFUNCTION RANDOM,SUBR + ENTRY + HLRE A,AB + CAMGE A,[-4] ;At most two arguments to random to set seeds + JRST TMA + JRST RANDGO(A) + MOVE B,VAL2 ;Set second seed + MOVEM B,RLOW + MOVE A,VAL1 ;Set first seed + MOVEM A,RHI +RANDGO: PUSHJ P,CRAND + JRST FINIS + +CRAND: MOVE A,RHI + MOVE B,RLOW + MOVEM A,RLOW ;Update Low seed + LSHC A,-1 ;Shift both right one bit + XORB B,RHI ;Generate output and update High seed + MOVSI A,TFIX + POPJ P, + + + MFUNCTION SQRT,SUBR + PUSHJ P,ARGCHK + JUMPL B,NSQRT + PUSHJ P,ISQRT + JRST FINIS + +ISQRT: MOVE A,B + ASH B,-1 + FSC B,100 +SQ2: MOVE C,B ;NEWTON'S METHOD, SPECINER'S HACK. + FDVRM A,B + FADRM C,B + FSC B,-1 + CAME C,B + JRST SQ2 + MOVSI A,TFLOAT + POPJ P, + +MFUNCTION COS,SUBR + PUSHJ P,ARGCHK + FADR B,[1.570796326] ;COS(X)=SIN (X+PI/2) + PUSHJ P,.SIN + MOVSI A,TFLOAT + JRST FINIS + +MFUNCTION SIN,SUBR + PUSHJ P,ARGCHK + PUSHJ P,.SIN + MOVSI A,TFLOAT + JRST FINIS + +.SIN: MOVM A,B + CAMG A,[.0001] + POPJ P, ;GOSPER'S RECURSIVE SIN. + FDVR B,[-3.0] ;SIN(X)=4*SIN(X/-3)**3-3*SIN(X/-3) + PUSHJ P,.SIN + FSC A,1 + FMPR A,A + FADR A,[-3.0] + FMPRB A,B + POPJ P, + +CSQRT: PUSHJ P,CARGCH + JUMPL B,NSQRT + JRST ISQRT + +CSIN: PUSHJ P,CARGCH +CSIN1: PUSHJ P,.SIN + MOVSI A,TFLOAT + POPJ P, + +CCOS: PUSHJ P,CARGCH + FADR B,[1.570796326] + JRST CSIN1 + MFUNCTION LOG,SUBR + PUSHJ P,ARGCHK ;LEAVES ARGUMENT IN B + PUSHJ P,ILOG + JRST FINIS + +CLOG: PUSHJ P,CARGCH + +ILOG: JUMPLE B,OUTRNG + LDB D,[331100,,B] ;GRAB EXPONENT + SUBI D,201 ;REMOVE BIAS + TLZ B,777000 ;SET EXPONENT + TLO B,201000 ; TO 1 + MOVE A,B + FSBR A,RT2 + FADR B,RT2 + FDVB A,B + FMPR B,B + MOVE C,[0.434259751] + FMPR C,B + FADR C,[0.576584342] + FMPR C,B + FADR C,[0.961800762] + FMPR C,B + FADR C,[2.88539007] + FMPR C,A + FADR C,[0.5] + MOVE B,D + FSC B,233 + FADR B,C + FMPR B,[0.693147180] ;LOG E OF 2 + MOVSI A,TFLOAT + POPJ P, + +RT2: 1.41421356 + MFUNCTION ATAN,SUBR + PUSHJ P,ARGCHK + PUSHJ P,IATAN + JRST FINIS + +CATAN: PUSHJ P,CARGCH + +IATAN: PUSH P,B + MOVM D,B + CAMG D,[0.4^-8] ;SMALL ENOUGH SO ATAN(X)=X? + JRST ATAN3 ;YES + CAML D,[7.0^7] ;LARGE ENOUGH SO THAT ATAN(X)=PI/2? + JRST ATAN1 ;YES + MOVN C,[1.0] + CAMLE D,[1.0] ;IS ABS(X)<1.0? + FDVM C,D ;NO,SCALE IT DOWN + MOVE B,D + FMPR B,B + MOVE C,[1.44863154] + FADR C,B + MOVE A,[-0.264768620] + FDVM A,C + FADR C,B + FADR C,[3.31633543] + MOVE A,[-7.10676005] + FDVM A,C + FADR C,B + FADR C,[6.76213924] + MOVE B,[3.70925626] + FDVR B,C + FADR B,[0.174655439] + FMPR B,D + JUMPG D,ATAN2 ;WAS ARG SCALED? + FADR B,PI2 ;YES, ATAN(X)=PI/2-ATAN(1/X) + JRST ATAN2 +ATAN1: MOVE B,PI2 +ATAN2: SKIPGE (P) ;WAS INPUT NEGATIVE? + MOVNS B ;YES,COMPLEMENT +ATAN3: MOVSI A,TFLOAT + SUB P,[1,,1] + POPJ P, + +PI2: 1.57079632 + MFUNCTION IEXP,SUBR,[EXP] + PUSHJ P,ARGCHK ;LEAVE FLOATING POINT ARG IN B + PUSHJ P,IIEXP + JRST FINIS + +CEXP: PUSHJ P,CARGCH + +IIEXP: PUSH P,B + MOVM A,B + SETZM B + FMPR A,[0.434294481] ;LOG BASE 10 OF E + MOVE D,[1.0] + CAMG A,D + JRST RATEX + MULI A,400 + ASHC B,-243(A) + CAILE B,43 + JRST OUTRNG + CAILE B,7 + JRST EXPR2 +EXPR1: FMPR D,FLOAP1(B) + LDB A,[103300,,C] + SKIPE A + TLO A,177000 + FADR A,A +RATEX: MOVEI B,7 + SETZM C +RATEY: FADR C,COEF2-1(B) + FMPR C,A + SOJN B,RATEY + FADR C,[1.0] + FMPR C,C + FMPR D,C + MOVE B,[1.0] + SKIPL (P) ;SKIP IF INPUT NEGATIVE + SKIPN B,D + FDVR B,D + MOVSI A,TFLOAT + SUB P,[1,,1] + POPJ P, + +EXPR2: LDB E,[030300,,B] + ANDI B,7 + MOVE D,FLOAP1(E) + FMPR D,D ;TO THE 8TH POWER + FMPR D,D + FMPR D,D + JRST EXPR1 + +COEF2: 1.15129278 + 0.662730884 + 0.254393575 + 0.0729517367 + 0.0174211199 + 2.55491796^-3 + 9.3264267^-4 + +FLOAP1: 1.0 + 10.0 + 100.0 + 1000.0 + 10000.0 + 100000.0 + 1000000.0 + 10000000.0 + +;LSH AND ROT (ERB WOULD BE PLEASED) PDL 2/22/79 + +MFUNCTION %LSH,SUBR,LSH + ENTRY 2 + MOVE C,[LSH B,(A)] + JRST LSHROT + +MFUNCTION %ROT,SUBR,ROT + ENTRY 2 + MOVE C,[ROT B,(A)] +LSHROT: GETYP A,(AB) + PUSHJ P,SAT + CAIE A,S1WORD + JRST WRONGT + GETYP A,2(AB) + CAIE A,TFIX + JRST WTYP2 + MOVE A,3(AB) + MOVE B,1(AB) + XCT C + MOVE A,$TWORD + JRST FINIS + +;BITWISE BOOLEAN FUNCTIONS + +MFUNCTION %ANDB,SUBR,ANDB + ENTRY + HRREI B,-1 ;START ANDING WITH ALL ONES + MOVE D,[AND B,A] ;LOGICAL INSTRUCTION + JRST LOGFUN ;DO THE OPERATION + +MFUNCTION %ORB,SUBR,ORB + ENTRY + MOVEI B,0 + MOVE D,[IOR B,A] + JRST LOGFUN + +MFUNCTION %XORB,SUBR,XORB + ENTRY + MOVEI B,0 + MOVE D,[XOR B,A] + JRST LOGFUN + +MFUNCTION %EQVB,SUBR,EQVB + ENTRY + HRREI B,-1 + MOVE D,[EQV B,A] + +LOGFUN: JUMPGE AB,ZROARG +LOGTYP: GETYP A,(AB) ;GRAB THE TYPE + PUSHJ P,SAT ;STORAGE ALLOCATION TYPE + CAIE A,S1WORD + JRST WRONGT ;WRONG TYPE...LOSE + MOVE A,1(AB) ;LOAD ARG INTO A + XCT D ;DO THE LOGICAL OPERATION + AOBJP AB,.+2 ;ADD ONE TO BOTH HALVES + AOBJN AB,LOGTYP ;ADD AGAIN AND LOOP IF NEEDED + +ZROARG: MOVE A,$TWORD + JRST FINIS + REPEAT 0,[ +;routine to sort lists or vectors of either fixed point or floating numbers +;the components are interchanged repeatedly to acheive the sort +;first arg: the structure to be sorted +;if no second arg sort in descending order +;second arg: if false then sort in ascending order +; else sort in descending order + +MFUNCTION SORT,SUBR + ENTRY + HLRZ A,AB + CAIGE A,-4 ;Only two arguments allowed + JRST TMA + MOVE O,DESCEND ;Set up "O" to test for descending order as default condition + CAIE A,-4 ;Optional second argument? + JRST .+4 + GETYP B,TYP2 ;See if it is other than false + CAIN B,TFALSE + MOVE O,ASCEND ;Set up "O" to test for ascending order + GETYP A,TYP1 ;CHECK TYPE OF FIRST ARGUMENT + CAIN A,TLIST + JRST LSORT + CAIN A,TVEC + JRST VSORT + JRST WTYP1 + + + + +GOBACK: MOVE A,TYP1 ;RETURN THE SORTED ARGUMENT AS VALUE + MOVE B,VAL1 + JRST FINIS + +DESCEND: CAMG C,(A)+1 +ASCEND: CAML C,(A)+1 + ;ROUTINE TO SORT LISTS IN NUMERICAL ORDER + +LSORT: MOVE A,VAL1 + JUMPE A,GOBACK ;EMPTY LIST? + HLRZ B,(A) ;TYPE OF FIRST COMPONENT + CAIE B,TFIX + CAIN B,TFLOAT + SKIPA + JRST WRONGT + MOVEI E,0 ;FOR COUNT OF LENGTH OF LIST +LCOUNT: JUMPE A,LLSORT ;REACHED END OF LIST? + MOVE A,(A) ;NEXT COMPONENT + TLZ A,(B) ;SAME TYPE AS FIRST COMPONENT? + TLNE A,-1 + JRST WRONGT + AOJA E,LCOUNT ;INCREMENT COUNT AND CONTINUE + +LLSORT: SOJE E,GOBACK ;FINISHED WITH SORTING? + HRRZ A,VAL1 ;START THIS LOOP OF SORTING AT THE BEGINNING + MOVEM E,(P)+1 ;Save the iteration depth +CLSORT: HRRZ B,(A) ;NEXT COMPONENT + MOVE C,(B)+1 ;ITS VALUE + XCT O ;ARE THESE TWO COMPONENTS IN ORDER? + JRST .+4 + MOVE D,(A)+1 ;INTERCHANGE THEM + MOVEM D,(B)+1 + MOVEM C,(A)+1 + MOVE A,B ;MAKE THE COMPONENT IN "B" THE CURRENT ONE + SOJG E,CLSORT + MOVE E,(P)+1 ;Restore the iteration depth + JRST LLSORT + ;ROUTINE TO SORT VECTORS IN NUMERICAL ORDER + +VSORT: HLRE D,VAL1 ;GET COUNT FIELD OF VECTOR + IDIV D,[-2] ;LENGTH + JUMPE D,GOBACK ;EMPTY VECTOR? + MOVE E,D ;SAVE LENGTH IN "E" + HRRZ A,VAL1 ;POINTER TO VECTOR + MOVE B,(A) ;TYPE OF FIRST COMPONENT + CAME B,$TFIX + CAMN B,$TFLOAT + SKIPA + JRST WRONGT + SOJLE D,GOBACK ;IF ONLY ONE COMPONENT THEN FINISHED +VCOUNT: ADDI A,2 ;CHECK NEXT COMPONENT + CAME B,(A) ;SAME TYPE AS FIRST COMPONENT? + JRST WRONGT + SOJG D,VCOUNT ;CONTINUE WITH NEXT COMPONENT + +VVSORT: SOJE E,GOBACK ;FINISHED SORTING? + HRRZ A,VAL1 ;START THIS LOOP OF SORTING AT THE BEGINNING + MOVEM E,(P)+1 ;Save the iteration depth +CVSORT: MOVE C,(A)+3 ;VALUE OF NEXT COMPONENT + XCT O ;ARE THESE TWO COMPONENTS IN ORDER? + JRST .+4 + MOVE D,(A)+1 ;INTERCHANGE THEM + MOVEM D,(A)+3 + MOVEM C,(A)+1 + ADDI A,2 ;UPDATE THE CURRENT COMPONENT + SOJG E,CVSORT + MOVE E,(P)+1 ;Restore the iteration depth + JRST VVSORT +] + +MFUNCTION OVERFLOW,SUBR + + ENTRY + + MOVEI E,OVFLG + JRST FLGSET + + +MFUNCTION TIME,SUBR + ENTRY + PUSHJ P,CTIME + JRST FINIS + +IMPURE + +RHI: 267762113337 +RLOW: 155256071112 +OVFLG: -1 +PURE + + +END + \ No newline at end of file