From af40b429ae26c098c5d53c1094e90c4d947a0c5e Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Tue, 22 Nov 2022 23:13:25 +0100 Subject: [PATCH] HLOGO - "Hal hack" version of 11LOGO. --- build/misc.tcl | 4 + build/timestamps.txt | 4 + src/nlogo/halflg.4 | 3 + src/nlogo/halhac.86 | 428 +++++++++++++++++++++++++++++++++++++++++++ src/nlogo/halvar.7 | 19 ++ src/nlogo/hlogo.cmd | 2 + 6 files changed, 460 insertions(+) create mode 100755 src/nlogo/halflg.4 create mode 100755 src/nlogo/halhac.86 create mode 100755 src/nlogo/halvar.7 create mode 100755 src/nlogo/hlogo.cmd diff --git a/build/misc.tcl b/build/misc.tcl index ed426032..e5085b85 100644 --- a/build/misc.tcl +++ b/build/misc.tcl @@ -1668,6 +1668,10 @@ respond "*" ":cwd nlogo\r" respond "*" ":palx slogo_@slogo\r" expect ":KILL" +# HLOGO, "Hal hack" 11LOGO. +respond "*" ":palx hlogo_@hlogo\r" +expect ":KILL" + # TORTIS respond "*" ":midas;324 radia;_tortis\r" expect ":KILL" diff --git a/build/timestamps.txt b/build/timestamps.txt index 0aa0eac8..998ffd94 100644 --- a/build/timestamps.txt +++ b/build/timestamps.txt @@ -1610,6 +1610,10 @@ nlogo/gtfun.89 197910181535.11 nlogo/iggl.1 197711221847.09 nlogo/impure.77 197911252329.15 nlogo/init.56 197911252329.05 +nlogo/halflg.4 197708101330.52 +nlogo/halhac.86 197808011606.05 +nlogo/halvar.7 197608170406.56 +nlogo/hlogo.cmd 197807281845.57 nlogo/logoch.497 197808071946.48 nlogo/pure.96 197911252329.09 nlogo/sitss.3 197911252126.36 diff --git a/src/nlogo/halflg.4 b/src/nlogo/halflg.4 new file mode 100755 index 00000000..6de8ffd1 --- /dev/null +++ b/src/nlogo/halflg.4 @@ -0,0 +1,3 @@ +HALFLG==1 +HAL1==0 + \ No newline at end of file diff --git a/src/nlogo/halhac.86 b/src/nlogo/halhac.86 new file mode 100755 index 00000000..5f7c4b8f --- /dev/null +++ b/src/nlogo/halhac.86 @@ -0,0 +1,428 @@ + +.IFZ HAL1 + +;ORBIT HACK--CALL WITH THE NAME OF ARRAY OF DATA +;THE FORMAT FOR THE DATA IS +;NUMBER OF ATTRACTIVE SOURCES +;NUMBER OF INTEGRATION STEPS PER CALL (<50) +;DT +;OBJECT XPOS +; YPOS +; ZPOS +; XVEL +; YVEL +; ZVEL +; XFORCE +; YFORCE +; ZFORCE +; MINIMUM LEGAL RADIUS +;GRAV SOURCE XPOS +; YPOS +; ZPOS +; DIST FROM OBJECT +; FIELD CONSTANT +;THIS LAST BLOCK REPEATED FOR EACH SOURCE + +;THE ROUTINE UPDATES THE VARIABLES + +H.DT==0 +H.XP==H.DT+4 +H.YP==H.XP+4 +H.ZP==H.YP+4 +H.XV==H.ZP+4 +H.YV==H.XV+4 +H.ZV==H.YV+4 +H.XF==H.ZV+4 +H.YF==H.XF+4 +H.ZF==H.YF+4 +H.MINR==H.ZF+4 +H.S1==H.MINR+4 + +HALHACK: SPOPS A + JSR PC,AMAKE5 ;B NOW POINTS TO ARRAY HEADER + MOV B,C + CMP (C)+,(C)+ + CMP (C)+,#150001 ;TYPE=FLOATING #DIMS=1 + BEQ .+4 + ERROR+BAT + CMP (C)+,(C)+ + MOV (C)+,A ;ARRAY SIZE + ADD #8.,C ;C NOW POINTS TO 1ST DATA WORD + LDCFD (C)+,FA + LDCFD (C)+,FB + SETI + STCFI FA,D ;#OF ATTRACTORS + STCFI FB,B ;#OF INTEGRATION STEPS + SETL + TST B ;POSITIVE? + BGT .+4 + ERROR+DOR + CMP B,#50. ;NOT TOO BIG (PIGGY) + BLE .+4 + ERROR+DOR + MUL #5,D + ADD #H.S1/4,D ;SIZE ARRAY SHOULD BE + ADD #2,D + CMP A,D + BGE .+4 + ERROR+ROB ;ARRAY TOO SMALL + SUB #3,D + ASL D + ASL D + ADD C,D ;POINTS TO LAST DATA WORD + MOV C,A + ADD #H.S1,A ;POINTS TO XPOS OF FIRST BODY + PUSH A + SPUSH D + ;A NOW POINTS TO XPOS OF FIRST BODY +;B HAS NUMBER OF STEPS PER CALL +;C POINTS TO DT +;D POINTS TO CONSTANT FOR LAST BODY +;NOW COMPUTE THE FORCE ON THE OBJECT + + SETF +HALOP: MOV (P),D + MOV 2(P),A +HALOP1: LDF H.XP(C),FB ;POSITION OF OBJECT + LDF H.YP(C),FC + LDF H.ZP(C),FA + SUBF (A)+,FB ;DX + SUBF (A)+,FC ;DY + SUBF (A)+,FA ;DZ + STF FA,FE + STF FC,FD + MULF FD,FD ;DY^2 + STF FB,FA + MULF FA,FA ;DX^2 + ADDF FD,FA + FPUSH FB + LDF FE,FB + MULF FB,FB + STF FB,FE ;DZ^2 + ADDF FE,FA + FPOP FB + JSR PC,HALSQ ;GET SQRT OF FA INTO FD + STF FD,(A)+ ;RADIAL DISTANCE FROM SOURCE + CMPF H.MINR(C),FD ;IS RADIUS LESS THAN 10? + CFCC + BGT HALERR + MULF FD,FA + LDF (A)+,FD ;FIELD CONSTANT + DIVF FA,FD ;K/(R*R^2) + MULF FD,FB ;FX=(ABOVE)*DX + MULF FD,FC ;FY + LDF FE,FA + MULF FD,FA ;FZ + ADDF H.XF(C),FB + STF FB,H.XF(C) ;INCREMENT FORCE-X + ADDF H.YF(C),FC ;FORCE-Y + STF FC,H.YF(C) + ADDF H.ZF(C),FA + STF FA,H.ZF(C) + CMP A,D + BLO HALOP1 ;MORE FORCES? + +;NOW DO THE INTEGRATION + MOV C,E + LDF (C),FB ;DT + ADD #8.,C ;POINT TO DO Z COORD FIRST +HALOP2: LDF H.XF(C),FA + MULF FB,FA ;FORCE*DT + ADDF H.XV(C),FA ;V_V+A + STF FA,H.XV(C) + MULF FB,FA ;V*DT + ADDF H.XP(C),FA ;X_X+V*DT + STF FA,H.XP(C) + CMP C,E + BEQ HALOP3 + SUB #4,C ;NOW DO Y AND X COORDINATES + BR HALOP2 +HALOP3: MOV E,C ;RESTORE POINTER TO DT + CLRF H.XF(C) ;CLEAR THE FORCES + CLRF H.YF(C) + CLRF H.ZF(C) + SUB #1,B + BEQ HALOP4 + JMP HALOP + +HALOP4: SETD + CMP (P)+,(P)+ ;FIX THE STACK + SEZ + RTS PC + + +HALERR: SETD + ERROR+RTB + ;SQUARE ROOT ROUTINE RETURN ROOT OF FA IN FD + +HALSQ: JSR PC,PPUSHT + STF FB,-(P) ;SAVE FB + STF FA,FD + DIVF #40400,FD ;START ITER AT A/2 +HALSQ1: STF FD,FB + STF FA,FD + DIVF FB,FD ;A/B + ADDF FB,FD + DIVF #40400,FD ;(B+A/B)/2 + SUBF FD,FB + ABSF FB ;ERROR + DIVF FA,FB + CMPF #34000,FB ;ERR LESS THAN 2^(-15) ? + CFCC + BLT HALSQ1 + LDF (P)+,FB ; + RTS PC + +.ENDC + +.IFZ HAL1-1 + +;ORBIT HACK FOR ORBITS IN VELOCITY SPACE +;CALL TO UPDATE VX,VY,UX,UY,R,A,T BASED ON OLD VALUES AND ZX,ZY,L,U +;ALSO SUPPLY EITHER DA OR DT + +;IF DT IS NON-ZERO WILL COMPUTE BASED ON DT + +;IF DT IS ZERO COMPUTE BASED ON DA (BUT ADJUST VALUE OF DA TO BE +;NOT SO BIG AS TO GIVE LARGE ERROR + +;ARGUMENT TO THIS PRIMITIVE IS A FLOATING POINT ONE-DIMENSIONAL ARRAY + +;VALUES IN THE ARRAY ARE, IN ORDER +;DT,DA,T,A,X,Y,R,UX,UY,U,ZX,ZY,VX,VY,L + +H.DT=0 +H.DA=H.DT+4 +H.T=H.DA+4 +H.A=H.T+4 +H.X=H.A+4 +H.Y=H.X+4 +H.R=H.Y+4 +H.UX=H.R+4 +H.UY=H.UX+4 +H.U=H.UY+4 +H.ZX=H.U+4 +H.ZY=H.ZX+4 +H.VX=H.ZY+4 +H.VY=H.VX+4 +H.L=H.VY+4 + +H.ASIZE=15. + +;MAIN LOOP + +HALHAC: JSR PC,H.IN ;CHECK ARRAY TYPE AND SET UP C TO POINT TO 1ST WORD + SETF ;SET FPP TO FLOATING (NON-DOUBLE) + JSR PC,H.CDA ;STICK DA IN TEMP + +H.HK1: JSR PC,H.COM ;COMPUTE R,A SIN A, COS A + LDF H.DT(C),FD ;SEE IF DT=0 + TSTF FD + CFCC + BNE H.HK2 + + JSR PC,H.ER ;DT=0, CHECK ERROR + BEQ H.HK1 ;NO GOOD. GO BACK + JSR PC,H.CT ;COMPUTE T BASED ON R, L AND DA + BR H.HK3 + +H.HK2: LDF H.T(C),FC ;DT NON-ZERO, ADD TO OLD T TO GET NEW T + ADDF FD,FC + +H.HK3: JSR PC,H.ALL ;STORE ALL THE VALUES + SETD ;RESTORE DOUBLE PRECISION + SEZ ;SIGNAL NOT OUTPUTTING + RTS PC + ;INIT C TO POINT TO FIRST DATA WORD + +H.IN: SPOPS A + JSR PC,AMAKE5 ;B NOW POINTS TO ARRAY HEADER + MOV B,C + CMP (C)+,(C)+ + CMP (C)+,#150001 ;TYPE=FLOATING #DIMS=1 + BEQ .+4 + ERROR+BAT + CMP (C)+,(C)+ + MOV (C)+,A ;ARRAY SIZE + CMP A,#H.ASIZE + BEQ .+4 + ERROR+BAT + RTS PC + ;COMPUTE DA AND STORE IT IN TEMP +;CALLED WITH C POINTING TO BEGINNING OF ARRAY + +;IF DT=0 THEN DA=DA*(SGN L) +;OTHERWISE DA=L*DT/R**2 + +H.CDA: LDF H.DT(C),FA + TSTF FA + CFCC ;IS DT=0? + BNE H.CDA1 + + LDF H.DA(C),FA ;DT=0 + LDF H.L(C),FB ;L + TSTF FB + CFCC + BGT H.CDAR + NEGF FA ;IF L<0 NEGATE DA + BR H.CDAR + +H.CDA1: LDF H.L(C),FB ;COMPUTE DA FOR DT NOT EQUAL TO 0 + MULF FB,FA ;L*DT + LDF H.R(C),FB ;R + MULF FB,FB ;SQUARE IT + DIVF FB,FA ;L*DT/R**2 + +H.CDAR: STF FA,TEMP + RTS PC + ;COMPUTE A AND R +;LEAVE A IN FA, R IN FB +;SIN A IN TEMP+4 +;COS A IN TEMP+10 + +;A=OLD A + DA +;R=L/(U-ZX*COS A - ZY*SIN A) + +H.COM: LDF H.A(C),FB ;PREVIOUS A + LDF TEMP,FA ;DA + ADDF FB,FA + JSR PC,H.M360 ;REDUCE IT MOD 360 + FPUSH FA + SPUSH C + FPUSH FA + SETD ;SIN ROUTINE NEEDS DOUBLE PRECISION + JSR PC,SINDEG + STCDF FA,TEMP+4 + SETF ;RESTORE FOR THE POP + FPOP FA + SETD + JSR PC,COSDEG + STCDF FA,TEMP+10 + SETF + POP C + + LDF H.ZX(C),FB ;X COMPONENT OF Z VECTOR + MULF FA,FB ;ZX*COS A + LDF TEMP+4,FC ;SIN A + LDF H.ZY(C),FA + MULF FA,FC ;ZY*SIN A + ADDF FC,FB ;ZY*SIN A + ZX*COS A + LDF H.U(C),FA ;LENGTH OF U VECTOR + SUBF FB,FA ;U - (ABOVE) + LDF H.L(C),FB + DIVF FA,FB ;AND THAT'S R + FPOP FA ;A + RTS PC + +H.M360: LDF #42264,FB ;REDUCE A MOD 360 +H.M31: TSTF FA ;IS IT NEGATIVE? + CFCC + BGE H.M32 + ADDF FB,FA + BR H.M31 + +H.M32: CMPF FA,FB ;IS IT BIGGER THAN 360? + CFCC + BLT H.M3R + SUBF FB,FA + BR H.M32 + +H.M3R: RTS PC + ;COMPUTE THE ERROR TERM +;ENTER WITH A IN FA, R IN FB AND PRESERVE THESE +;ERROR TERM IS (ABS (R-OLD R)) + (ABS DA*R)/67 + +;IF E>10 SET DA TO DA/1.1 AND SIGNAL TO REDO COMPUTATION +;IF E<6 SET DA TO DA*1.1 AND REDO COMPUTATION + +;TO REDO COMPUTATION SET Z BIT ON LEAVING + +H.ER: FPUSH FA + FPUSH FB + LDF H.R(C),FC ;OLD R + SUBF FB,FC + ABSF FC ;ABS (R -OLDR) + LDF TEMP,FD ;DA + MULF FB,FD + ABSF FD ;ABS(R*DA) + DIVF #41606,FD ;ABOVE/67 + ADDF FC,FD ;THE ERROR TERM + + CMPF #41040,FD ;COMPARE WITH 10 + CFCC + BGT H.ER1 ;10>ERROR + + LDF H.1.1,FA ;TOO BIG--DIVIDE BY 1.1 + LDF TEMP,FB + DIVF FA,FB + STF FB,TEMP + BR H.ERL + +H.ER1:CMPF #40700,FD ;COMPARE WITH 6 + CFCC + BLT H.ERW ;6