File 12KFNS.PA (PAL assembler source file)

Directory of image this file is from
This file as a plain text file

/ FUNCTION PACKAGE FOR 12K U/W-FOCAL:		-JVZ-
/ 12KFNS.PA
/REVISIONS:
/ TAD TXTEND CHANGED TO TAD BUFEND AT 14447	1/3/79

/ FCOM AND FRA:  RANDOM ACCESS FUNCTIONS

/THE 'FCOM' FUNCTION PROVIDES ACCESS TO DATA ARRAYS IN FIELD
/2 (OR 4) USING EITHER OF 2 STORAGE MODES: SIGNED DOUBLE PRE-
/CISION OR 4-WORD FLOATING-POINT.  THE STORAGE MODE IS DETER-
/MINED BY THE SIGN OF THE 'FCOM' INDEX.  POSITIVE INDICES
/(0-1023) ACCESS FLOATING-POINT NUMBERS WHILE NEGATIVE VALUES
/REFERENCE DOUBLE PRECISION INTEGERS IN THE SAME WAY THAT THE
/KE-8E EAE DOES IT.  STORAGE BEGINS AT THE TOP OF THE FIELD &
/EXTENDS DOWNWARD TOWARD THE TEXT AREA.  THIS PROVIDES A REA-
/SONABLE TRADEOFF BETWEEN LARGE DATA ARRAYS AND LONG PROGRAMS.

/THE VALUE OF THE 'FCOM' FUNCTION IS JUST THE VALUE OF THE
/VARIABLE AT THE LOCATION REFERENCED.  TO STORE A NEW VALUE
/AT THAT LOCATION, SIMPLY INCLUDE A SECOND PARAMETER IN THE
/FUNCTION CALL; THE VALUE OF THIS EXPRESSION WILL THEN BE
/PLACED IN THE ARRAY AT THE SPECIFIED LOCATION.  DATA CON-
/VERSION BETWEEN INTEGER AND FLOATING-POINT MODES IS AUTO-
/MATIC.  EXAMPLES: SET X(I)=FCOM(I+100); X FCOM(J,FSIN(J))

/THE 'FRA' FUNCTION PROVIDES 'FCOM-LIKE' ACCESS TO DATA ARRAYS
/STORED IN BINARY FORM ON ANY MASS-STORAGE DEVICE.  SEVERAL
/DATA MODES ARE AVAILABLE: SINGLE WORD (SIGNED OR UNSIGNED),
/DOUBLE PRECISION AND 4-WORD FLOATING POINT.  A DIFFERENT
/INDEXING SCHEME IS EMPLOYED TO HANDLE ALL THESE MODES.

/THE FILE USED BY FRA MUST FIRST BE LOOKED UP USING THE
/'OPEN INPUT' COMMAND.  FOLLOWING THIS 'FRA' MUST BE INITIAL-
/IZED SO THAT THE NECESSARY POINTERS CAN BE TRANSFERRED AND
/THE DATA FORMAT SELECTED.  THE FOLLOWING TYPES OF CALLS ARE
/PERMITTED: (I IS NON-NEGATIVE, V IS ANY EXPRESSION)

/	FRA(I)		READ THE I-TH VALUE
/	FRA(I,V)	STORE V IN THIS LOCATION
/	FRA(-1)		UPDATE THE LAST BLOCK
/	FRA(-1,M)	INITIALIZE AND SET THE DATA MODE

/THE VALUE OF 'M' DETERMINES THE DATA MODE:

/	M=0		UNSIGNED INTEGERS
/	M=1		SIGNED INTEGERS
/	M=2		DOUBLE PRECISION
/	M=4		4-WORD FLOATING-POINT

/'FRA' RETURNS 0 WHEN CALLED WITH A NEGATIVE INDEX.

/'FRA' USES ITS OWN ROUTINES FOR MODES 0-1, AND THE 'FCOM'
/ROUTINES FOR MODES 2 & 4.  BOTH FUNCTIONS ARE COMPLETELY
/RECURSIVE, I.E. THEY MAY BE USED AS ARGUMENTS OF THEMSELVES.

	PAGE 21		/PRECEEDING THE 8K FUNCTIONS

FRA, TAD HORD /CHECK SIGN OF THE INDEX SPA CLA /INITIALIZATION? JMP INITL /YES, OR UPDATE FIXIT R3, CLA CLL RTL /=7306 PUSHF /SAVE THE INDEX FLAC TSTCMA /READ OR WRITE? JMP .+4 /READ PUSHJ /WRITE EVAL /EVALUATE THE EXPRESSION TAD P13 /ALTER THE INSTRUCTION DCA REED POPF /RECALL THE INDEX FLOP TAD SHIFTS DCA LAST1 JMS I R3 /SHIFT RIGHT ONE BIT ISZ LAST1 JMP .-2 TAD (BLKNO&0 /FIRST BLOCK OF THIS FILE SNA ERROR2 /FILE NOT AVAILABLE TAD AC1L /THIS IS NOW THE RELATIVE BLOCK # CIA TAD ARG3 /IS IT THE SAME AS THE LAST ONE? SNA CLA JMP CORE /YES, DATA IS IN CORE JMS LAST1 /CHECK FOR ANY UPDATES TAD (FLNGTH /FILE SIZE STL CIA TAD AC1L SNL CLA /IS THIS A LEGAL INDEX? ERROR2 /NO, IT'S TOO LARGE TAD AC1L TAD (BLKNO&0 DCA ARG3 /SET THE NEW BLOCK NUMBER JMS DISK /AND READ IT IN CORE, TAD REED /R OR W? SZA CLA DCA DISK /SET THE 'CHANGE' FLAG TAD REED TAD WRIT /SET UP THE PROPER EXIT DCA REED TAD OVR1 /DEVELOP THE BUFFER ADDRESS CLL RTR CLL RTR TAD (3200-1 /BUFFER ADDRESS CDF DCA XRT REED, JMP W0 /NOW FOR THE EASY PART! WRIT, JMP R0 /OR ELSEWHERE...
INITL, TSTCMA /UPDATE OR INITIALIZE? JMP FINAL /UPDATE PUSHJ EVAL FIXIT /GET THE DATA MODE TAD M4 SNA CLL IAC SZL /0-4? (EXCLUDING 3) ERROR2 /MODE ERROR TAD (-15 STL RAR /DETERMINE THE SHIFT COUNT DCA SHIFTS TAD LORD STL RAL TAD JMPR0 /AND THE PROPER R/W ROUTINE DCA WRIT CDF /NOW GET THE POINTERS TAD I ATSW /=BLKNO DCA (BLKNO&0 TAD I (ILNGTH DCA (FLNGTH TAD I W0+1 /=INHND DCA (HANDLR CDF P FINAL, JMS LAST1 /UPDATE THE LAST BLOCK DCA ARG3 FLOATR DISK, NOP /READ/WRITE SUBROUTINE TAD C200 /= 1 BLOCK IN FIELD 0 DCA ARG1 CIF /GO BELOW I0F /OR 'NOP' JMS I (HANDLR /CALL THE (INPUT) HANDLER ARG1, 200 3200 ARG3, 0 JMP W3 /DEVICE ERROR I0N JMP I DISK LAST1, 0 /CHECK FOR CHANGES & UPDATE TAD DISK /HAVE WE WRITTEN ANYTHING? SZA CLA JMPR0, JMP .+3 /NO SM0 /YES JMS DISK /RESET THE FLAG JMP I LAST1 /AND REALLY DO IT
/HERE ARE ALL THE READ AND WRITE ROUTINES: R0, TAD I XRT /UNSIGNED INTEGERS FL0ATR R1, TAD I XRT /SIGNED INTEGERS FLOATR R2, TAD W0 /DOUBLE PRECISION DCA EXP JMP I .+1 GET+6 R4, JMP I .+1 /FLOATING POINT GET+2 SHIFTS, 0 /SEPARATES THE LISTS BY 13 W0, 27 /SINGLE PRECISION INHND /<1000(8) W1, FIXIT /SIGNED OR UNSIGNED JMP I (GET-2 W2, JMP I .+1 PUT+6 W3, CIF /GENERATE ?29.70 JMP I R3 W4, JMP I .+1 PUT PAGE
/FCOM: STORAGE FUNCTION FOR DATA ARRAYS FCOM, FIXIT /FIX INDEX AND SET EXP, OVER PUSHA /SAVE INDEX ON THE STACK TSTCMA /CHECK FOR A SECOND ARGUMENT JMP GET PUSHJ /GET THE ARGUMENT EVAL JMS INDEX /COMPUTE THE INDEX JMP .+7 /IT WAS NEGATIVE PUT, TAD EXP /FLOATING STORAGE DCA I XRT TAD OVER DCA I XRT TAD LORD SKP FIXIT /INTEGER STORAGE DCA I XRT TAD HORD DCA I XRT RETURN /FUNCTION RETURN GET, JMS INDEX /FIGURE IT OUT JMP .+5 /NOTE: EXP=27, OVER=0 TAD I XRT /FLOATING RETRIEVAL DCA EXP TAD I XRT DCA OVER TAD I XRT /INTEGER RETRIEVAL DCA LORD TAD I XRT DCA HORD RETURN /'RETURN' FLOATS INTEGERS NOP INDEX, 0 /COMPUTE INDEX AND BRANCH POPA /EXAMINE THE ARGUMENT SPA /FLOATING JMP .+3 /INTEGER ISZ INDEX /SET POSITIVE RETURN CMA CLL RAL /-(I+1)*4 FOR FLOATING CLL RAL /*2 FOR INTEGER STORAGE STL CMA TAD BUFEND /'IAC' IF LAST PAGE FREE TAD BUFR /'NOP' FOR 20K SYSTEM SNL SZA /CHECK TEXT LIMIT ERROR2 /FCOM INDEX EXCEEDED RANGE CMA /SUBTRACT ONE TAD BUFR /'NOP' FOR 20K SYSTEM DCA XRT /LOAD INDEX REGISTER CDF T /'CDF 40' FOR 20K JMP I INDEX /NOTE: 'INDEX' IS EASILY CHANGED TO STORE IN FIELDS 4-7.
/THIS PATCH MODIFIES THE 'INDEX' ROUTINE SO THAT POSITIVE /INDICES FROM 0-2047 MAY BE USED TO ADDRESS ALL LOCATIONS /IN FIELDS 4 & 5. THE 'NEGATIVE INDEX' FEATURE HAS BEEN /ELIMINATED: ONLY FLOATING-POINT STORAGE IS AVAILABLE. NOPUNCH *PUT-1 NOP /ELIMINATE THE 'NEG.' RETURN *GET CDF 40 /USE THIS LOC. FOR A CONSTANT JMS INDEX /AND MOVE THIS DOWN ONE *INDEX+2 SPA /CHECK STORAGE LIMIT JMP .+10 /KEEP THE SAME ERROR CODE CLL RTL /MULTIPLY THE INDEX BY 4 SZA /LEAVING THE FIELD INFO CIA /IN THE LINK CMA /SUBTRACT ONE DCA XRT /AND SAVE THE INDEX RTL /SHIFT THE FIELD BIT OVER SKP ERROR2 /INDEX GREATER THAN 2047(10) RTL TAD GET /ADD THE 'CDF' INSTRUCTION DCA .+1 /THIS PATCH MODIFIES THE 'INDEX' ROUTINE SO THAT POSITIVE /INDICES FROM 0-4095 MAY BE USED TO ADDRESS ALL LOCATIONS /IN FIELDS 4-7. THE 'NEGATIVE INDEX' FEATURE HAS BEEN /ELIMINATED: ONLY FLOATING-POINT STORAGE IS AVAILABLE. *PUT-1 NOP /ELIMINATE THE 'NEG.' RETURN *GET CDF 40 /USE THIS LOC. FOR A CONSTANT JMS INDEX /AND MOVE THIS DOWN ONE *INDEX+2 CLL RTL /MULTIPLY THE INDEX BY 4 DCA XRT /LEAVING THE FIELD INFO IAC /IN BIT 11 AND THE LINK AND XRT RTL /SHIFT THE FIELD BITS OVER RTL TAD GET /ADD THE 'CDF' INSTRUCTION DCA .+6 /AND SAVE FOR LATER SM2 /=7776 AND XRT /CLEAN UP THE INDEX CIA CMA /SUBTRACT ONE ENPUNCH;*.+3 /THE CHANGES ARE CONSTRUCTED SO THAT THEY DO NOT INTER- /FERE WITH 'FRA' WHICH USES SOME OF THE 'FCOM' ROUTINES.
/THE 'HESITATE' COMMAND PROVIDES A PROGRAMMABLE PAUSE TO /BE USED WHENEVER IT IS NECESSARY TO SYNCHRONIZE THE PRO- /GRAM WITH AN EXTERNAL DEVICE. THE TIMING IS PROVIDED BY /A SOFTWARE LOOP WHICH MUST BE ADJUSTED FOR DIFFERENT MA- /CHINES. ASSEMBLY OPTIONS ARE PROVIDED FOR THE 8/E AND /8/I AND OTHERS ARE EASILY PATCHED. TIMES ARE EXPRESSED /IN MILLISECONDS, SO 'H 1000' PROVIDES A 1 SECOND DELAY. HESI, PUSHJ /PARAMETER = DELAY TIME EVAL / (IN MILLISECONDS) NEGATE SZL /ZERO OR MISSING ARGUMENT? CONTINUE /AVOID A 4HR 40MIN DELAY ! FIXIT /CONVERT TO DOUBLE PRECISION SNA /1ST CYCLE MAY BE A BIT OFF TAD TATE /GET LOOP CONSTANT IAC /COUNT DOWN SNA /DONE? ISZ LORD /1.003 MS PER MAJOR CYCLE JMP .-5 /TIMES THE NUMBER OF CYCLES ISZ HORD JMP .-6 CONTINUE /RETURN TO MAINLINE TATE, IFDEF TFLI <-320> /1.2 USEC (8/E) IFNDEF TFLI <-234> /1.6 USEC (8/I) /////
/ FUNCTION PACKAGE FOR 8K U/W-FOCAL: -JVZ- /THESE FUNCTIONS ARE BASED ON THE SERIES APPROXIMATIONS DE- /VELOPED BY D.A. DALBY AND D.E. WELLS OF THE BEDFORD INSTI- /TUTE OF OCEANOGRAPHY, DARTMOUTH, NOVA SCOTIA (DECUS 8-103) /WHILE EXHAUSTIVE TESTING HAS NOT BEEN CARRIED OUT, TYPI- /CALLY THE RESULTS ARE CORRECT TO CA. 3 IN THE TENTH DIGIT. *4600-12 /EXPONENTIAL CONSTANTS: E1, +0;4000;0000;0275 E2, -1;3777;7775;1652 E3, -2;5252;5353;1521 E4, -4;2524;7613;5106 E5, -6;5700;2131;0200 E6, -11;2560;3573;7333 E7, -14;5542;5227;4775
/BASE E EXPONENTIAL FUNCTION: FEXP, CHKSGN /TAKE THE ABSOLUTE VALUE 1 FENT FDIV LN2 /FORM N+F FPUT I FLARGP FEXT NEGATE FIXIT /FORM -N DCA T2 NORMALIZE ///// FENT FADD I FLARGP /FORM F FMUL LN2 FPUT I FLARGP FMUL E7 FADD E6 FMUL I FLARGP FADD E5 FMUL I FLARGP FADD E4 FMUL I FLARGP FADD I X3 FMUL I FLARGP FADD I X2 FMUL I FLARGP FADD I X1 FMUL I FLARGP FADD I X0 FEXT ///// TAD T2 /DIVIDE THE SUM BY 2^N TAD EXP DCA EXP TAD FINISH /POINT TO 'RETURN' DCA CHKARG TAD T3 JMP EXPX /FEXP(X)=1/FEXP(-X) ///// X3, E3 X2, E2 X1, E1 X0, E0
CHKARG, 0 /ARGUMENT CHECK FOR 'FLOG', 'FATN' DCA T2 /SET THE FLIP-FLOP CHKSGN /LOOK AT THE SIGN FIRST JMP I CHKARG /ZERO ISZ CHKARG /NON-ZERO CLA CMA /COMPARE WITH UNITY TAD EXP TAD T2 /.LT. OR .GT. ONE? EXPX, SPA CLA JMP I CHKARG /YOUR CHOICE FENT FPWR FEXP+1 /= -1.7427... FPUT I FLARGP /SAVE THE RECIPROCAL FEXT TAD .-2 JMP I CHKARG /T3=SIGN FLAG, AC=INVERSION FLAG ///// /LOGARITHM CONSTANTS: LN2, +0;2613;4413;7676 L12, -12;4132;5467;5141 L11, -7;3467;0413;5110 L10, -5;4633;3721;5500 L9, -4;3470;0312;3507 L8, -3;4770;3123;3611 L7, -2;2050;7523;5173
/NAPERIAN LOGARITHM FLOG, SM0 /CHECK OUT THE ARGUMENT JMS CHKARG ERROR2 /CAN'T TAKE THE LN OF ZERO DCA T3 CMA TAD EXP FLOAT /FLOAT THE EXPONENT IAC DCA I FLARGP /REPLACE IT WITH 1 NORMALIZE ///// FENT /DO THE SERIES FMUL LN2 FPUT I BUFFPT FGET I FLARGP /JUST THE MANTISSA NOW FSUB I FP1 FPUT I FLARGP /BACK AGAIN! FMUL L12 FADD L11 FMUL I FLARGP FADD L10 FMUL I FLARGP FADD L9 FMUL I FLARGP FADD L8 FMUL I FLARGP FADD L7 / PAGE BOUNDARY FMUL I FLARGP FADD L6 FMUL I FLARGP FADD L5 FMUL I FLARGP FADD L4 FMUL I FLARGP FADD L3 FMUL I FLARGP FADD L2 FMUL I FLARGP FADD L1 FMUL I FLARGP FADD I BUFFPT /ADD N*LN2 FEXT JMP I (EXIT2 /NEGATE RESULT IF NECESSARY
/ARCTANGENT FUNCTION FOR ANGLES IN RADIANS FATN, JMS I (CHKARG RETURN /ATN(0)=0 DCA INVRS /SET THE EXIT FENT FMUL FLAC FPUT I BUFFPT /SAVE THE SQUARE FMUL A23 FADD A21 FMUL I BUFFPT FADD A19 FMUL I BUFFPT FADD A17 FMUL I BUFFPT FADD A15 FMUL I BUFFPT FADD A13 FMUL I BUFFPT FADD A11 FMUL I BUFFPT FADD A9 FMUL I BUFFPT FADD A7 FMUL I BUFFPT FADD A5 FMUL I BUFFPT FADD A3 FMUL I BUFFPT FADD A1 FMUL I FLARGP /CONVERT TO ODD POWERS INVRS, FPUT I FLARGP /OR 'FEXT' FGET I (PIOV2 FSUB I FLARGP /ATN(X)=PI/2-ATN(1/X) FEXT JMP I (EXIT2 /TAKE CARE OF THE SIGN /////
/ARCTANGENT CONSTANTS A23, -12;5457;4432;1701 A21, -7;2145;4241;4605 A19, -6;4166;3357;4120 A17, -4;2040;1626;5457 A15, -4;4507;1221;3170 A13, -3;2222;2557;0167 A11, -3;5107;0475;7567 E0, +0;3777;7777/7775 A9, -3;3427;7472;2175 A7, -2;5555;7621;6402 A5, -2;3146;3041;1767 A3, -1;5252;5253;5611 A1, +0;3777;7777;7755
/LOGARITHM CONSTANTS L6, -2;5312;1653;0406 L5, -2;3137;6765;6402 L4, -2;4000;7041;0031 L3, -1;2525;2301;7431 L2, -1;4000;0006;2241 L1, +0;3777;7777;7445 PAGE
/EXTENDED PRECISION SIN & COS - TAKEN FROM DEC'S FLOATING- /POINT PACKAGE (R. BEAN) & FOCAL8-231 (DR. H.B. THOMPSON). /THE COEFFICIENTS HAVE BEEN OPTIMIZED FOR U/W-FOCAL (JVZ). FCOS, SM0 /ONLY NEGATE IF POSITIVE JMS I ABSOL /(SUGGESTED BY G. CHASE) FENT FADD PIOV2 /COS(X)=SIN(PI/2-X) FEXT FSIN, CHKSGN /CHECK THE SIGN JMP QUAD1 /ARGUMENT WAS 0 FENT FDIV PIOV2 /CONVERT TO QUADRANTS FPUT I FLARGP FEXT FIXIT /GET THE INTEGER PART AND SC3 /MODULO 4 TAD FSIN+1 DCA QUAD0 /SET UP THE BRANCH JMS FRCT /GET THE FRACTION QUAD0, 0 /AND PROCESS IT FENT FSUB I FP1 /SUBTRACT 1.0 FEXT JMP I QUAD0 NEGATE QUAD1, JMP QUAD5 /USE X QUAD2, JMS QUAD0 /USE 1-X QUAD3, JMP QUAD1-1 /USE -X QUAD4, JMS QUAD0 /USE X-1 QUAD5, FENT /SIX TERM POLYNOMIAL FPUT I FLARGP /SAVE THE ARGUMENT FMUL FLAC FPUT I BUFFPT /SAVE THE SQUARE FMUL C11 FADD C9 FMUL I BUFFPT FADD C7 FMUL I BUFFPT FADD C5 FMUL I BUFFPT FADD C3 FMUL I BUFFPT FADD PIOV2 FMUL I FLARGP /CONVERT TO ODD POWERS FEXT
/COMMON EXIT ROUTINE FOR EXTENDED FUNCTIONS EXIT2, TAD T3 /CHECK SIGN JMP FABS+1 /SINE AND COSINE CONSTANTS SC3, 3 C11, -22;4313;2133 C9, -14;2500;3207 C7, -7;5464;5650;4204 C5, -3;2431;5360;3221 C3, +0;5325;0414;3240 PIOV2, +1;3110;3755;2421 /COMMON ROUTINES FOR EXTENDED FUNCTIONS SGNCHK, 0 /ALSO CALLED BY 'GETLN' JMS I ABSOL /TAKE THE ABSOLUTE VALUE FENT FPUT I FLARGP /AND PUT IT BACK AGAIN FEXT TAD SIGN /'FPUT' LEAVES L=1 SZA ISZ SGNCHK /FIRST RETURN = ZERO DCA T3 TAD T3 JMP I SGNCHK /AC,T3 = SIGN OF THE ARGUMENT FRCT, 0 /CALLED BY 'FSIN', 'FRAC' FENT FIXER /='FNOR' FSUB I FLARGP FEXT NEGATE JMP I FRCT
/REVISED SQUARE ROOT FUNCTION FSR, LAS SKP /READ THE SWITCH REGISTER FSQT, CHKSGN /BETTER CHECK THE SIGN FLOATR /0 OR SWITCHES SPA CLA /WAS THE ARGUMENT NEGATIVE? ERROR2 /CAN'T TAKE IMAGINARY ROOTS TAD EXP /'CHKSGN' SETS L=1 SMA CLL /USE AN ARITHMETIC SHIFT RAR /DIVIDE EXPONENT BY TWO SZL /TEST IF IT WAS ODD OR EVEN IAC /ODD - ADD ONE DCA EXP TAD M5 /INITIALIZE ITERATION COUNTER DCA T3 SQRT, FENT /NEWTON'S METHOD IS USED FPUT I BUFFPT /SAVE APPROXIMATION FGET I FLARGP /GET BACK THE ARGUMENT FDIV I BUFFPT FADD I BUFFPT FMUL I (FLP5 /DIVIDE BY 2 FEXT ISZ T3 /5 ITERATIONS ARE SUFFICIENT JMP SQRT RETURN FRAC, FIXIT /FIND THE FRACTIONAL PART JMS FRCT RETURN FOUT, FIXIT /SINGLE-CHARACTER OUTPUT SNA SM0 /IN CASE IT'S ZERO PRINTC FSGN, TAD HORD /REAL SIGNUM FUNCTION SZA CLA IAC FLOAT /PREPARE 1.0 FITR, TAD P43 /IMPROVED INTEGER FUNCTION JMS I FRCT+2 /REPLACES 'FIXIT;CLA' (6D) FABS, TAD I (FLARG+1 /CHECK THE ORIGINAL SIGN SPA CLA NEGATE RETURN /ALSO USED BY OTHER FUNCTIONS PAGE 36 /MORE AFTER THE F.P. PACKAGE
/THE 'Y' COMMAND ADDS OR SUBTRACTS ONE TO A LIST OF VARI- /ABLES DEPENDING UPON WHETHER THE NAME IS PRECEEDED BY A /MINUS SIGN OR NOT. THUS 'Y I' IS THE SAME AS 'S I=I+1', /WHILE 'Y -I' IS LIKE 'S I=I-1'. SPACES, COMMAS OR MINUS /SIGNS MAY BE USED TO SEPARATE THE NAMES: 'Y N-O,P Q- R' /WILL ADD ONE TO 'N,P,Q' AND SUBTRACT ONE FROM 'O,R'. DECR, GETC /PASS THE MINUS SIGN TAD YNCR+2 /MODIFY THE INSTRUCTION DCA YNCR-3 /'FADD/FSUB I FP1' SPNOR SORTJ /CHECK ON WHAT TO DO YLST-1 YGO-YLST PUSHJ /ERRORS WILL BE TRAPPED HERE GETARG TSTCMA /REMOVE SEPARATORS FADD I FP1 /NOP FENT FGETIPT1 /LOAD THE VARIABLE FADD I FP1 /ADD OR SUBTRACT ONE FPUTIPT1 /STORE IT AWAY AGAIN FEXT YNCR, TAD .-6 /'Y' DO WE HAVE THIS COMMAND? JMP DECR+2 /REPEAT? FSUB I FP1 /BECAUSE THE USERS DEMAND IT! / 'FMIN' & 'FMAX' COMPARE TWO ARGUMENTS, RETURNING THE /LARGER OR SMALLER OF THE TWO. THANKS TO R. MAZUR OF /THE HOCHSHULE DER BUNDESWEHR IN MUENCHEN FOR THE IDEA. FMIN, SM0 /AC=4000 FMAX, PUSHA /REMEMBER THE ENTRY POINT PUSHF /SAVE THE FIRST ARGUMENT FLAC PUSHJ /GET THE SECOND ARGUMENT EVAL-3 POPF /RECALL ARGUMENT NO. 1 BUFFER FENT FSUB I BUFFPT /MAKE THE COMPARISON FEXT POPA /GET THE SWITCH TAD HORD /CHECK THE SIGN SPA CLA TAD .+2 JMP FSFX /GET THE RIGHT ONE & RETURN BUFFPT-FLARGP ///// FIN, READC /SINGLE CHARACTER INPUT TAD CHAR FLOAT /'FLOATR' RETURN /////
/FOCAL STATEMENT FUNCTIONS: F(N,ARG1,ARG2,...) /N IS A LINE OR GROUP NO. (USE A CONVENIENT VARIABLE TO /LABEL THE FUNCTION) AND THE ARGUMENTS REPLACE THE VALUE /OF THE SECRET VARIABLES, BEGINNING WITH '#'. FSF'S ARE /NOT FULLY RECURSIVE SINCE THEY ALL USE THE SAME SECRET /VARIABLES. THE VALUE RETURNED BY THE FUNCTION IS JUST /THE LAST EXPRESSION EVALUATED. *SNA FSF, PUSHJ /EVALUATE THE LINE NUMBER MODEPT /(ARG. IS ALREADY IN FLAC) PUSHF /SAVE LINENO, NAGSW, AND LASTC LINENO TAD FSFP ARG, DCA LASTC TSTCMA /MORE ARGUMENTS? JMP DOF /NO PUSHJ EVAL /GET THE NEXT ONE TAD LASTC DCA PT1 /MUST USE THE VAR. PTR. FENT FPUTIPT1 FEXT TAD GINC TAD LASTC /POINT TO THE NEXT JMP ARG DOF, POPA /RESTORE LINENO & NAGSW DCA LINENO POPA DCA NAGSW PUSHJ /EXECUTE A 'DO' CALL DO+2 POPA /RECALL PREVIOUS POINTER DCA LASTC ISZ PDLXR /DUMP 'FISW' FSFX, TAD (FGET I FLARGP DCA .+2 FENT FGET I FLARGP /GET THE RESULT AGAIN IN CASE FEXT /A 'FOR' COMMAND WIPED IT OUT RETURN ///// FSFP, WORDS^3+STVAR+10/# GETL, GETLN /READ LINE NUMBER FOR 'GTNAME' CDI L JMP NAMEND+2 /////
/IMPROVED RANDOM NUMBER FUNCTION (OMSI) USES A TTY WAIT /LOOP TO INITIALLY SET A RANDOM VALUE. AFTER THE FIRST /INPUT SUCCESSIVE NUMBERS ARE GENERATED FROM THE POWER /RESIDUE ALGORITHM DUE TO P.T. BRADY (DECUS 5-25). SEE /THE DISCUSSION BY G.A. GRIFFITH IN DECUS FOCAL8-1. FRAN, FENT / X(1)=(2^17+3)*X(0) MOD 2^35 FNOR I LEVEL0 / GET PREVIOUS VALUE FGET I (RANDOM+1/ SHIFT LEFT TWELVE FEXT DCA EXP / ZERO THE EXPONENT SHIFTL SHIFTL / SHIFT LEFT FOUR MORE SHIFTL SHIFTL JMS I (DUBLAD / PLUS 3 TIMES ORIGINAL SHIFTL JMS I (DUBLAD FENT FPUT I LEVEL0 / SAVE FOR THE NEXT CALL FEXT CMA CLL RAR /=3777 AND HORD DCA HORD /BE POSITIVE IT'S POSITIVE RETURN ///// VFN, TAD LORD /+HORD /GENERATE A NUMERIC FILE NAME SZA CLA /IS THE ARGUMENT ZERO? SM0 /ROUND UP DCA OVER NORMALIZE SM1 PRINTN /CONVERT TO ASCII CIF L JMP VFR /RETURN WITH STRING ADDRESS ///// LGETC, SNL /'GETC' FOR THE LIBRARY ROUTINES GETC TAD CHAR CDI L JMP MGETC+3 /SAME PAGE, DOWN BELOW ///// GETA, PUSHJ /CALLED BY 'GTNAME', 'O A' & 'O C' EVAL /EVALUATE AN EXPRESSION FIXIT CIF L JMP MGETA-1 /DF=P, L=0 ///// PAGE



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search