Trailing-Edge
-
PDP-10 Archives
-
decuslib20-04
-
decus/20-0134/focal.mac
There are 2 other files named focal.mac in the archive. Click here to see a list.
SUBTTL INTRODUCTION.
COMMENT \
*************************************
* *
* THIS IS THE STONE WHICH WAS *
* REJECTED BY YOU BUILDERS WHICH *
* IS BECOME THE HEAD OF THE CORNER. *
* ACTS 4:11 *
* RSV *
*************************************
THE AUTHOR OF FOCAL-10, IAN PUGSLEY, IS VERY INTERESTED IN YOUR COMMENTS,
CRITICISMS AND SUGGESTIONS, EVEN THOUGH NO GUARANTEE CAN BE GIVEN TO
RESPOND OR TO ACCEPT THE SUGGESTIONS.
PLEASE DIRECT YOUR REPORTS TO HIM AT:
DIGITAL EQUIPMENT AUSTRALIA
60 PARK STREET,
SOUTH MELBOURNE,
VICTORIA 3205,
AUSTRALIA.
\
IFDEF FNEW,<XLIST>
VWHO==1 ;IAN D. PUGSLEY DIGITAL EQUIPMENT AUSTRALIA.
VEDIT==127 ;17-JUL-72
VEDIT==131 ;11-SEP-72
VEDIT==132 ;CHANGED UINCH5+1 FROM AUTIO3 TO AUTIO4
VEDIT==133 ;ERROR MESSAGES IN UPPER AND LOWER CASE ETC.
VEDIT==134 ;KI-10 TRAP HANDLER FIXED; ALSO IFSKIP.
VEDIT==135 ;CATCH SUICIDE ON ERASE COMMAND CORRECTLY.
;ALSO USE QUICK GETLN ROUTINE.
VEDIT==136 ;CORRECT CODE AT AUTIO5+10,14.
VEDIT==137 ;INSERT AND USE VERSTR MACRO.
VEDIT==140 ;CORRECT # OF ITERATIONS IN ATAN (AT ATAN4).
VEDIT==141 ;FIX HANDLING OF EXTRA SPACES, ALSO WIDE FORMATS.
VEDIT==142 ;ALLOW DEVICE TTY IN I/O STATEMENTS; MORE OF #141
VEDIT==143 ;CORRECT TITLE; MORE OF #142.
VEDIT==144 ;STANDARDIZE USAGE OF <>
VEDIT==145 ;MINOR CLEAN-UPS;INTERP TO BIT 0;XECUTE COMMAND;WIDE FORMATS
VEDIT==146 ;CORRECT MODIFY ECHOING FOR FILE INPUT UNDER HALF DUPLEX
VEDIT==147 ;MODIFY SYMBOL-TABLE TYPE-OUT FORMAT; FIX ERROR PRINT AFTER DO.
VEDIT==150 ;FORCE ALL TEXT LINES TO BEGIN AT A WORD BOUNDARY.
VEDIT==151 ;ALLOW LINE NUMBERS UP 99.99.
VEDIT==152 ;DELETE ALL CCL CODE; CLEAN UP OTHER PLACES.
VEDIT==153 ;ALLOW NEGATIVE 'FOR' INDEX INCREMENTS; 'OPERATE' COMMAND IMPLEMENTED.
VEDIT==154 ;ALLOW MULTI-SUBSCRIPTED ARRAYS; INCLUDE FCHR FUNCTION.
VEDIT==155 ;VMAJOR 3.
VMAJOR==3 ;6-APR-73
VEDIT==156 ;CORRECT OCCURRENCES OF THE FORM OUTCH @ACCUM.
VEDIT==157 ;MAKE GETTAB COLLECT ALL 36 BITS.
VEDIT==160 ;SAVE ONE WORD AT UFSB:
VEDIT==161 ;CORRECT LOOP WHICH OCCURS ON ASK +X.
VEDIT==162 ;REMOVE CONTROL-C INTERCEPT FOR ASK DATA (NOW MUST USE CTRL-P)
VEDIT==163 ;ALLOW LEADING SPACES IN ASK DATA.
VEDIT==164 ;IMPROVE EXP. ROUTINE TIMING AND SIZE.
VEDIT==165 ;IMPROVE GETNM ROUTINE TIMING AND SIZE.
VEDIT==166 ;CORRECT DFLOAT TO MAKE FLOAT A SIGNED 36-BIT NUMBER.
VEDIT==167 ;PREFACE ODD FUNCTIONS WITH A CALL TO ODDFNC INSTEAD OF SPECIAL CODE
VEDIT==170 ;INCLUDE FUNCTION FOCAL(Q) TO RETRIEVE DATA FROM WITHIN FOCAL.
VEDIT==171 ;MOVED SOME ITEMS IN LOW SEGMENT TO MAKE ADDRESSES MORE PERMANENT
VEDIT==172 ;USED PDP-6 MACRO DEFINITION FOR FSBRI INSTEAD OF SPECIAL CASES.
VEDIT==173 ;ADDED EXTRA ERROR FLAG "Y" TO INDICATE TYPING " error".
VEDIT==174 ;ALLOWED CORE-EXPANSION IN HALF K PAGES IF MONITOR GIVES IT.
VEDIT==175 ;CLEANED UP THE GETNM ROUTINE A BIT.
VEDIT==176 ;ADDED "Device not correctly INITted" MESSAGE.
VEDIT==177 ;CHANGED INPUT/OUTPUT DEVICE ERROR MESSAGES.
VEDIT==200 ;CORRECT SO LOWER CASE LIBRA MODIFIER IS ACCEPTED.
VEDIT==201 ;CORRECT SO UNSUBSCRIPTED VARIABLE NAME PROPERLY TRUNCATED
VEDIT==202 ;CORRECT PFLOAT SO IS WORKS FOR SINGLE-PRECISION VERSION.
VEDIT==203 ;ELIMINATE DCAMGE UUO.
VEDIT==204 ;CORRECT PDP-6 VERSION OF NEGANS.
VEDIT==205 ;SAVE ONE WORD AT EACH OF RET:+2, FIX:+2 AND UINCH4:.
VEDIT==206 ;CLEAR BIT 0 OF LOW ORDER WORD OF ALL DATA MACRO ARGUMENTS.
VEDIT==207 ;IMPROVE PDP-6 DOUBLE PRECISION NEGANS ROUTINE AGAIN.
VEDIT==210 ;CORRECT FIT:+6 SO CORE EXPANSION WORKS FOR BUFFER SET-UP.
VMINOR==1 ;1-JUN-73.
VEDIT==211 ;ALLOW DELETION/MODIFICATION OF ACTIVE LINES.
VEDIT==212 ;SAVE ONE WORD AT NEGANS FOR PDP-6 VERSION.
VEDIT==213 ;CORRECT LOW ORDER BITS OF PIO180 CONSTANT.
VEDIT==214 ;RE-STRUCTURE SOURCE FILE SO PDP-6 FOCAL(CONST) WORKS.
VEDIT==215 ;MAKE MINOR ADJUSTMENTS TO LOGARITHM SERIES COMPUTATION
VEDIT==216 ;CORRECT LOW ORDER BITS OF ROOT8 CONSTANT.
VEDIT==217 ;MAKE RETURN WORK FOR LINES NUMBERS ABOVE 31.99
VEDIT==220 ;CORRECT NEWLIN ROUTINE FOR MODIFICATIONS OF A LINE.
VEDIT==221 ;CORRECT PDP-6 DOUBLE FLOATING DIVIDE ROUTINE.
VEDIT==222 ;MAKE DLOG REDUCTION IN FLOATING DIVIDE INSTEAD OF FIXED POINT
VEDIT==223 ;ADJUST SOME DOUBLE-PRECISION CONSTANTS FOR GREATER ACCURACY.
VEDIT==224 ;MAKE PDP-6 VERSION AUTOMATICALLY ONE-SEGMENT.
VEDIT==225 ;REMOVE PDP-6 AUTO-DEFAULT-3.27-MONITOR.
VEDIT==226 ;IMPROVE ACCURACY FOR SIND/COSD INTEGER ARGUMENTS.
VEDIT==227 ;RE-WRITE GETLN TO PREVENT LOOP IF GO TO .. OCCURS.
VEDIT==230 ;INCLUDE CODE TO DO A CLOSE ON DECTAPE AS PER THE MANUAL.
VEDIT==231 ;ADD HALF A BIT OF PRECISION TO PDP-6 DFDV.
VEDIT==232 ;DELETE SQRT,ATAN,ABS,SIGN;ADD FSIND,FCOSD,FLOG10 FUNCTIONS.
VEDIT==233 ;MAKE ASK,TYPE/0 OPERATE/0 WORK,MAKE CHANNEL NUMBER DECIMAL.
VEDIT==234 ;SAVE ACC. PC IN TRAP HANDLER FOR FXU/FOV ERROR MESSAGES.
VMINOR==2 ;14-NOV-73
VEDIT==235 ;ADD 1 BIT OF PRECISION TO PDP-6 DFMP.
VEDIT==236 ;LET GETBUF/GETASK USE A BUFFER ON THE STACK.
VEDIT==237 ;ADJUST .JBDDT/.JBCOR SO MONITOR 'SAVE' WORKS BETTER.
VEDIT==240 ;SAVE T2 SO TYPE %EMM.NN /CHN (NO COMMA) WORKS.
VEDIT==241 ;MAKE TYPE%10.5 ILLEGAL; MAKE FIX: WORK FOR NEGATIVE NUMBERS
VEDIT==242 ;ALLOW ** FOR EXPONENTIATION WITH SPACE BETWEEN.
VEDIT==243 ;CATCH ILLEGAL EXPRESSIONS ENDING IN AN OPERATOR.
VEDIT==244 ;ADD CODE FOR "TYPE $$" - OCTAL COMMENTS.
VEDIT==245 ;CORRECT TYPN7 SO NUMBER TYPES AS 0.000, NOT .000
VMINOR==3 ;14-FEB-74.
VEDIT==246 ;IMPROVE ACCURACY OF TYPE-OUT ROUTINE.
VEDIT==247 ;ADJUST TYPE-OUT ROUTINE SO LOG10 ERRORS DON'T MATTER.
VEDIT==250 ;MAKE DEFAULT %E FORMAT %E5.04.
VEDIT==251 ;SUPPRESS INDEX FIELD IN SYMBOL-TABLE PRINTOUT IF INDEX ZERO.
VEDIT==252 ;CORRECT BUG WHEREBY COULD NOT MODIFY A LINE BEGINNING WITH "?".
VEDIT==253 ;MAKE NAMES IN MONTHS TABLE BOTH UPPER AND LOWER CASE.
VEDIT==254 ;USE .JBSA/L INSTEAD OF .JBDDT FOR CORE STABILIZATION.
VMAJOR==4 ;26-JUN-74.
VEDIT==255 ;MAKE LIBRA SAVE WRITE THE SYMBOL TABLE TOO.
VEDIT==256 ;ENLARGE CORE CHUNK QUANTA TO SPEED UP LIBRA CALL.
VEDIT==257 ;IMPROVE NUMERIC INPUT ACCURACY BEYOND THE 11TH DECIMAL PLACE.
VEDIT==260 ;CORRECT BUG APPLYING TO LIBRARY FILES COMMENCING WITH CRLF.
VEDIT==261 ;SQUEEZ WAS CLEARING CORE TOO LATE, AND BEING DECEIVED BY GARBAGE.
VEDIT==262 ;IMPROVE SINE/COSINE - VARIABLE NUMBER OF TERMS IN POWER-SERIES.
VEDIT==263 ;CORRECT BUG IN SINGLE PRECISION FATN FOR VERY SMALL ARGUMENTS
VEDIT==264 ;FIX KA-10 DOUBLE PRECISION FEXP TO GIVE A NORMALIZED ANSWER.
VEDIT==265 ;MAKE EXP FUNCTION USE CONTINUED FRACTION METHOD.
VEDIT==266 ;ELIMINATE ?FOV ERROR DURING TYPEOUT OF SMALL NUMBERS UNDER %E25.20.
VEDIT==267 ;FORCE RE-USE OF CORE STORAGE FOR LIBRA-CALL OF SAME FILE TWICE
VEDIT==270 ;IMPROVE END-OF-FILE HANDLING. ALSO INVENT & USE RECIPR ROUTINE.
VEDIT==271 ;USE NEW FIXOAT ROUTINE SO 2^(-1)=.5 EXACTLY.
VEDIT==272 ;MORE OF EDIT #267.
VEDIT==273 ;IF ENOUGH CORE OUTLAW THE FORMS: ASK % AND ASK $.
VEDIT==274 ;WRITE A SMALL CORE LOGARITHM FUNCTION FOR KA DOUBLE PRECISION.
VEDIT==275 ;CHANGE ACCUMULATOR VALUE INCL. CA=13, TO ALLOW STD. CALLING SEQ
VEDIT==276 ;NEW FEATURE: STRING VARIABLES FUNCTIONS AND EXPRESSIONS
VEDIT==277 ;NORMALIZE AFTER DFN TO ALLOW SPECIAL CASE 576400000000,146001000000
VEDIT==300 ;DELETE BEMER'S FLOG METHOD. NEW RECURSIVE METHOD IS MORE ACCURATE
VEDIT==301 ;SAVE INSTRUCTIONS: TWO IN UERROR, ONE AT GO, ONE AT TYPINT-1.
VEDIT==302 ;OUTLAW THE FORMS X$= AND X$=() : FORCE THE FORMS X$="" OR X$=("").
VEDIT==303 ;DELETE SIN,COS,SIND,COSD,LOG,LOG10,EXP; ADD FHIBER.
VMAJOR==5 ;6-FEB-75.
VEDIT==304 ;GENERATE TITLE (FOR LISTING) WITH VERSION # DETAILS.
VEDIT==305 ;DON'T SAVE SYMBOL TABLE ON LIBRA SAVE IF A LIST EXISTS.
VEDIT==306 ;COMPLY WITH SUBROUTINE CALLING CONVENTIONS.
VMINOR==1 ;1-MAR-75.
VEDIT==307 ;REPAIR EDIT #305 TO SAVE INCHN, OUTCHN CORRECTLY.
VEDIT==310 ;.JBERR IS NOW INCREMENTED ON ERRORS AND GETTAB, FHIBER FAILURES.
VEDIT==311 ;GIVE ERROR MESSAGE ON TOO-WIDE FORMAT.
VMINOR==2 ;11-MAR-75.
VEDIT==312 ;ASK DATA INITIAL CHAR RUBBED OUT CLOBBERRED LEADING SPACE FLAG.
VEDIT==313 ;FOR INPUT AND ASK DATA, EMBED RUBBED OUT CHARACTERS IN "\".
VEDIT==314 ;IMPLEMENT CONTROL-R. ALSO CONTROL-P FOR ABORTING MODIFY.
VMINOR==3 ;5-APR-75.
VEDIT==315 ;MAKE OPERATE ON ILLEGAL DEVICE GIVE ERROR MESSAGE.
VMINOR==4 ;26-APR-75.
VEDIT==316 ;MAKE NON-FATAL ERROR MESSAGES COME OUT ALWAYS ON TTY.
VEDIT==317 ;ALLOW MODIFY COMMAND TO INSERT & SCAN FOR QUESTION MARK.
VMINOR==5 ;20-SEP-75.
VEDIT==320 ;ASK COMMAND NOW OUTPUTS ONLY TO TTY AND ONLY IF INCHN IS TTY.
VEDIT==321 ;SAME FOR MODIFY.
VEDIT==322 ;DEBUG OUTPUT ALWAYS HAS TO GO TO TTY. (IT'S HOPELESS TO DEBUG OTHERWISE.)
VEDIT==323 ;INPUT/OUTPUT DEVICE ERROR NOW GIVES MONITOR CODE
VMINOR==6 ;4-OCT-75.
VEDIT==324 ;MAKE ECHOES FOR RUBOUT, CONTROL-U ETC. APPLY ONLY FOR TTY INPUT.
VEDIT==325 ;IMPLEMENT LOGICAL IF FOR = AND # OPERATIONS.
VMINOR==7 ;10-OCT-75.
VEDIT==326 ;IMPLEMENT LOGICAL IF FOR .NE. AND .EQ. TOO.
VMINOR==10 ;13-OCT-75.
VEDIT==327 ;CHANGE ERROR MESSAGE FORMAT FROM ERROR-## TO ERROR #.
VMINOR==11 ;21-OCT-75.
VEDIT==330 ;ALLOW BACKSPACE FOR TELETYPE RUBOUT CHARACTER.
VMINOR==12 ;8-FEB-76.
VEDIT==331 ;SAVE SPACE AT LIMNXT:.
VEDIT==332 ;CHANGE GL.HDP TO GL.LCP; DELETE DPOP UUO; ABBREVIATE TRAP HANDLER.
VEDIT==333 ;SET X=0 CREATES NO NEW SYMBOL-TABLE ENTRY;REMOVE EXCESS CODE IN SQUEAZ.
VEDIT==334 ;ALLOW ONLY ALPHABETICS IN COMMANDS; CHANGE INCREM,DECREM MACROS.
VEDIT==335 ;ADD .LT.,.LE.,.GT.,.GE.; CHANGE MOST PRINTX TO PX.
VEDIT==336 ;IMPROVE DEXCH UUO FOR KI-10 D PREC; REMOVE INCREM, DECREM MACROS.
VEDIT==337 ;REARRANGE ERROR PRINTOUT AND WRITE CODE FOR MORE EFFICIENCY.
VEDIT==340 ;SPEED UP EVAL AND ALLOW -1#-1.
VEDIT==341 ;BETTER TRY.
VEDIT==342 ;SCAN NEW: AND OLD: AT FNEWGO:.
VEDIT==343 ;MAKE SYMBOL-TABLE SCAN METHOD BINARY SEARCH.
VEDIT==344 ;RESTRICT ASK STRING DELIMITERS TO LINE-FEED, ALT-MODE.
VEDIT==345 ;LIBRARY SAVE GENERATES BACKUP; LOOKUP ERRORS ARE NON-FATAL.
SUBTTL FEATURE-TEST SWITCHES.
;PROCESSOR TYPE.
;IFNDEF .CPU,<.CPU==3> ;KI-10 DEFAULT.
IFNDEF .CPU,<.CPU==4> ;KL-10 DEFAULT FOR DEC-20
;THIS MODIFICATION MADE BY PAUL ROBINSON, DECUS CONVERSION PROGRAMMER
;JULY '80. NOT INCLUDED IN EDIT HISTORY.
IF1 <
IFDEF PDP,IFDEF DECsystem,IFN PDP-DECsystem,.CPU=-1 ;ERRONEOUS CONFLICT.
IFDEF DECsystem,SYN DECsystem,PDP
IFNDEF PDP,<PDP=0>
IFNDEF KA,<KA=0>
IFNDEF KI,<KI=0>
IFNDEF KL,<KL=0>
IFN PDP!KA!KI!KL,<.CPU=0>
IFLE .CPU*<5-.CPU>,<
PRINTX <
?TO CHOOSE THE PROCESSOR OPTION, YOU SHOULD MERELY SET
.CPU=1 FOR PDP-6
OR .CPU=2 FOR KA-10
OR .CPU=3 FOR KI-10
OR .CPU=4 FOR KL-10
>;END PRINTX
PASS2
END
>;END IFLE .CPU*<5-.CPU>
>;END IF1
IFE .CPU-1, PDP==6
IFG .CPU-1, PDP==10
IFE .CPU-2, KA==10
IFE .CPU-3, KI==10
IFE .CPU-4, KL==10
IFNDEF MONITOR, MONITOR==5.06 ;NUMBER OF EARLIEST MONITOR TO BE USED.
;ARITHMETIC PRECISION. WPV. NUMBER OF WORDS PER VALUE
IFNDEF WPV,<WPV==2> ;=2 DOUBLE PRECISION.
DECsystem==PDP
KA==KA
KI==KI
KL==KL
MONITOR==MONITOR
WPV==WPV
XPV==WPV-1 ;EXTRA WORDS PER VALUE.
SIZE==0 ;EXCESS SPACE AVAILABLE.
IFE KA-10,<IFG XPV,<SIZE==-1>> ;SOME VERSIONS ARE OVER QUOTA.
SUBTTL ACCUMULATOR ASSIGNMENTS
;EXCEPT FOR ACCUMULATOR ZERO, THE HIGHER THE ACCUMULATOR, THE MORE GLOBAL,
;AND THE LOWER THE ACCUMULATOR, THE MORE TEMPORARY AND UNPRESERVED IT IS.
F0=0 ;FLAGS.
UA=1 ;UUO SCRATCH ACCUMULATOR NUMBER 1.
PC=2 ;USED FOR SAVE/RESTORE AND TRAP HANDLER.
AC=3 ;FLOATING ACCUMULATOR HIGH PART / TEMPORARY ACCUMULATOR.
MQ=AC+1 ;FLOATING ACCUMULATOR LOW PART / OTHERWISE UNUSED.
AA=MQ+1 ;AUXILIARY ACCUMULATOR. (ALSO AS UUO SCRATCH #2)
T2=6 ;TEMPORARY ACCUMULATOR.
T3=T2+1 ;TEMPORARY ACCUMULATOR.
T4=T3+1 ;TEMPORARY ACCUMULATOR.
T5=T4+1 ;TEMPORARY ACCUMULATOR.
T6=T5+1 ;TEMPORARY ACCUMULATOR.
CA=13 ;CUSTOMER ACCUMULATOR; NOT USED BY FOCAL.
RL=14 ;SYMBOL-TABLE RELOC REGISTER. NORMALLY C(RL)=C(.JBREL)+1
CH=15 ;CHARACTER JUST ABOVE PNTR POINTER.
CC=CH+1 ;NATURE OF "CH".
PP=17 ;PROGRAM PUSH-DOWN POINTER. FORTRAN-COMPATIBLE.
COMMENT \
USAGE OF AC,MQ,AA.
1. AS FLOATING-POINT ACCUMULATOR.
AC HIGH ORDER PART.
MQ LOW ORDER PART IF DOUBLE PRECISION.
AA GENERALLY UNUSED EXCEPT BY FIXOAT ROUTINE (Q.V.)
2. AS INTEGER. (ALWAYS TWO WORDS, EVEN IN SINGLE-PRECISION VERSION)
AC HIGH ORDER.
MQ LOW ORDER.
AA UNUSED.
3. AS FOCAL LOGIC POINTER.
AC LINE NUMBER.
MQ BYTE POINTER.
AA INDEX ENTRY.
4. AS SIXBIT VARIABLE NAME.
AC BIT 0: =1 NUMERIC VARIABLE, =0 STRING VARIABLE.
BITS 1-17: SIXBIT
BITS 18-35: SIXBIT OR INDEX.
MQ UNUSED.
AA UNUSED.
\
SUBTTL PARAMETER ASSIGNMENTS.
IFDEF FNEW,<.XCREF>
MLON
IFN PDP-6,<IFNDEF FNEW,<TWOSEG>> ;PDP-6 UUO HANDLER IS NON-REENTRANT
;MISCELLANEOUS MONITOR AND HARDWARE BITS.
EOF==20000 ;END-OF-FILE ON INPUT.
DV.IN==2 ;DEVICE CAN DO INPUT
DV.OUT==1 ;DEVICE CAN DO OUTPUT
DV.DTA==1B11 ;THE DEVICE IS A DECTAPE
ASCII==1 ;MODE ZERO IS LEGAL
AP.FOV==100 ;FLOATING OVERFLOW FLAG
FXU==1B11 ;FLOATING UNDERFLOW FLAG
FOV==1B3 ;FLOATING OVERFLOW FLAG.
AP.REN==400000 ;REPETITIVE ENABLE
NOECHO==200 ;TTY NO-ECHO STATUS BIT.
.RBDEV==16 ;LOGICAL UNIT NAME ON WHICH FILE IS LOCATED
;TELETYPE LINE CHARACTERISTICS.
GL.LCP==1B15 ;LINE IS LOCAL-COPY.
;PROGRAM PARAMETERS
TTYCHN==0 ;TELETYPE I/O CHANNEL.
LIBCHN==1 ;LIBRARY CALL/SAVE CHANNEL NUMBER.
DOUCHN==2 ;DEFAULT OUTPUT CHANNEL NUMBER.
DINCHN==3 ;DEFAULT INPUT CHANNEL NUMBER.
EOL==0 ;DELIMITER FOR FOCAL TEXT LINES.
IFN EOL,PRINTX EOL MUST BE ZERO
PDC==400 ;SIZE OF PROGRAM PUSH-DOWN LIST.
DEFINE MCALL (NAME) <
DEFINE PCALL (PREC) <
DEFINE VCALL (MAJOR,MINOR,EDIT,WHO) <
DEFINE VFIG (AMIN) <
X=0
IRPC AMIN <
IFE X-MINOR,<
DEFINE NCALL (PROC) <
DEFINE TITEL <
TITLE 'NAME ('PROC') 'PREC'-PRECISION V'MAJOR''AMIN'('EDIT')-'WHO
>;END DEFINE TITEL
IFE VWHO,<
DEFINE TITEL <
TITLE 'NAME ('PROC') 'PREC'-PRECISION V'MAJOR''AMIN'('EDIT')
>;END DEFINE TITEL
>;END IFE VWHO
>;END DEFINE NCALL (PROC)
STOPI
>;END IFE X-MINOR
X=X+1
>;END IRPC AMIN
>;END DEFINE VFIG (AMIN)
VFIG ( ABCDEFGHIJKLMNOPQRSTUVWXYZ)
>;END DEFINE VCALL (MAJOR,MINOR,EDIT,WHO)
>;END DEFINE PCALL (PREC)
>;END DEFINE MCALL (NAME)
MCALL FOCAL FOR DECsystem-10
IFN PDP-6,<IFDEF FNEW,<MCALL FOCALL FNEW LOW SEGMENT JACKET>>
IFE XPV,<PCALL SINGLE>
IFG XPV,<PCALL DOUBLE>
VCALL (\VMAJOR,\VMINOR,\VEDIT,\VWHO)
IFE KA-10,<NCALL KA-10>
IFE KI-10,<NCALL KI-10>
IFE KL-10,<NCALL KL-10>
IFE PDP-6,<NCALL PDP-6>
TITEL
PURGE MCALL,NCALL,VFIG,VCALL,PCALL,X,TITEL
SUBTTL MACRO DEFINITIONS
OPDEF JSPPC [PUSHJ PP,] ;DISGUISE THE FACT THAT THIS IS A PUSHJ
;AND MAKE READER REALIZE THE STACK IS CHANGED.
IFE XPV*<KI-10>*<KL-10>*<PDP-6>,<DEFINE HALVE (A)< FSC AC,-1>>
IFN XPV*<KI-10>*<KL-10>*<PDP-6>,<DEFINE HALVE (A)< DFMP AC,HALF>>
IFN <KI-10>*<KL-10>,< DEFINE NEGATE (A) < PUSHJ PP,NEGANS>>
IFE <KI-10>*<KL-10>,< DEFINE NEGATE (A) < DMOVN AC,AC>>
IFE XPV,< DEFINE NEGATE (A) < MOVNS AC>>
DEFINE DATA (A,B)<
A
B
>;END DEFINE DATA (A,B)
IFE KA-10,<
DEFINE DATA (A,B)<
A
IFN <<<B+200>&<-1B36>>_<-8>>,<
IFGE A,<A&<777B8>-33B8+<<B+200>&<-1B36>>_<-8>>
IFL A,<<-A&<777B8>>-33B8+<<B+200>&<-1B36>>_<-8>>
>;END IFN <<<B+200>&<-1B36>>_<-8>>
IFE <<<B+200>&<-1B36>>_<-8>>,<0>
>;END DEFINE DATA (A,B)
>;END IFE KA-10
IFE XPV,<DEFINE DATA (A,B)<A+<<B&1B1>_-^D34>>>
;ITERATION COUNT FOR DATAN POWER SERIES.
DATANCOUNT=<<12+33*WPV+KI*XPV+KL*XPV>/4*2>&-2 ;COMPUTE ITERATION COUNT.
DEFINE GETT5 (A) <
RADIX 10
DEFINE GETTT5 (B) <MOVSI T5,('B'.)>
GETTT5 \A
RADIX 8
>;END DEFINE GETT5 (A)
;LOGARITHM OF (MANTISSA SIZE/10.)
LGMNSZ=7.12780988293 ;B*LOG10(2)-1;B= # OF BITS.;27-BIT FRACTION
IFG XPV,<LGMNSZ=17.66385973117> ;62-BIT FRACTION.
IFG XPV,<IFE KA-10,<LGMNSZ=15.2556197658>> ;54-BIT FRACTION.
DEFINE ENDSEG <
IFDEF FNEW,IF2,END FNEWGO
IFDEF FNEW,LOC 400010
IFNDEF FNEW,RELOC 400000
DEFINE ENDSEG <>
>;END DEFINE ENDSEG
IFE PDP-6,DEFINE ENDSEG <>
DEFINE .ADCHR (CHR),<
.STRG==.STRG+<<CHR>_.SHFT>
.SHFT==.SHFT-7
IFL .SHFT,<
EXP .STRG
.STRG==0
.SHFT==^D29
>;END IFL .SHFT
>;END DEFINE .ADCHR (CHR)
DEFINE .ADSTR (STR),<
IRPC STR,<
.ADCHR ("STR")
>;END IRPC STR
>;END DEFINE .ADSTR (STR)
DEFINE VERSTR (NAME,MAJOR,MINOR,EDIT,WHO),<
.STRG==0
.SHFT==^D29
.ADSTR (NAME)
.ADSTR (\MAJOR)
IFN MINOR,<
.ADCHR (MINOR+"A"-1)
>;END IFN MINOR
IFN EDIT,<
.ADCHR "("
.ADSTR (\EDIT)
.ADCHR ")"
>;END IFN EDIT
IFN WHO,<
.ADCHR ("-")
.ADSTR (\WHO)
>;END IFN WHO
.ADCHR (" ")
EXP .STRG
>;END DEFINE VERSTR (NAME,MAJOR,MINOR,EDIT,WHO)
SUBTTL UUO ASSIGNMENTS AND OPDEFS
;UUOLIST CONTAINS TRIPLETS OF ARGUMENTS FOR THE X MACRO.
;THE FIRST ARGUMENT IS THE SIMPLE NAME
;THE SECOND ARGUMENT IS THE TYPE OF THE UUO ....
; 0 MEANS NOT DATA
; 1 MEANS DATA OPERATION
; 2 MEANS DATA ARITHMETIC OPERATION
;THE THIRD ARGUMENT INDICATES WHETHER THE OP IS DONE
; BY HARDWARE (IF ZERO), OR
; BY UUO (IF POSITIVE).
; BY OTHER SOFTWARE (IF NEGATIVE).
DEFINE UUOLIST <
X ERROR,0,1
X GLIDE,0,PDP-7
X HOP,0,PDP-7
X INCHR,0,PDP-7
X OUTCH,0,PDP-7
X OUTST,0,PDP-7
X PUSH,1,XPV
X EXCH,1,XPV*<1-KI-KL>
X MOVE,1,<-XPV*<KI+KL-10>>
X MOVEM,1,<-XPV*<KI+KL-10>>
X FAD,2,<-XPV*<KI+KL-10>>
X FSB,2,<-XPV*<KI+KL-10>>
X FMP,2,<-XPV*<KI+KL-10>>
X FDV,2,<-XPV*<KI+KL-10>>
>;END DEFINE UUOLIST
DEFINE X (A,B,C) <
IFE C,<
IFE XPV,<
IFE B-1,<OPDEF D'A [A]>
IFE B-2,<OPDEF D'A [A'R]>
>;END IFE XPV
>;END IFE C
IFG C,<
XXX=XXX+1
IFG B,<OPDEF D'A [XXX_33]>
IFE B,<OPDEF A [XXX_33]>
>;END IFG C
>;END DEFINE X (A,B,C)
XXX=0
UUOLIST
OPDEF ERRORR [Y!<ERROR>]
DEFINE PX (A),<
PRINTX <
?A
>;END PRINTX
>;END DEFINE PX (A)
IFN PDP-6,<
; OPDEF GLIDE [GLIDE 0,] ;SET UP CH & CC THEN JRST ADR
OPDEF GLIDEP[GLIDE 1,] ;SET UP CH & CC THEN PUSHJ PP,ADR
OPDEF STEP [GLIDE 2,] ;STEP OVER SPACES THEN GLIDE ADR
OPDEF STEPP [GLIDE 3,] ;STEP OVER SPACES THEN GLIDEP ADR
; OPDEF HOP [HOP 0,] ;HOP OVER 1 CHARAC, THEN GLIDE ADR
OPDEF HOPP [HOP 1,] ;HOP OVER 1 CHARAC, THEN GLIDEP ADR
OPDEF HPSTP [HOP 2,] ;HOP OVER 1 CHARAC, THEN STEP ADR
OPDEF HPSTPP[HOP 3,] ;HOP OVER 1 CHARAC, THEN STEPP ADR
>;END IFN PDP-6
IFE PDP-6,<
;ON THE PDP-6 ALL UUO'S TRAP TO THE MONITOR WHICH SHUNTS UUO'S BACK
;TO THE USER. THIS PROCESS IS RATHER INEFFICIENT, SO ON THE PDP-6
;WE SHALL DEFINE THE MOST COMMONLY-USED UUO'S AS MACROS, WHICH ONLY
;ASSEMBLE ONE INSTRUCTION IN THE IN-LINE SEQUENCE, AND WHICH GO TO
;A MULTI-LINE LITERAL TO SET UP THE ARGUMENTS AND CALL THE APPROPRIATE
;"UUO" ROUTINE.
DEFINE UUOMAC (LIST)<
IRP LIST,<
DEFINE LIST(A)<
JRST [ MOVEI UA,A
JRST U'LIST]
>;END DEFINE LIST(A)
DEFINE LIST'P(A)<
PUSHJ PP,[MOVEI UA,A
JRST U'LIST]
>;END DEFINE LIST'P(A)
>;END IRP LIST
>;END DEFINE UUOMAC (LIST)
UUOMAC <GLIDE,HOP,STEP,HPSTP>
DEFINE INCHR (A)<
PUSHJ PP,[MOVEI UA,A
JRST UINCHR]
>;END DEFINE INCHR (A)
DEFINE OUTCH (A)<
PUSHJ PP,[MOVEI UA,A
JRST UOUTCH]
>;END DEFINE OUTCH (A)
DEFINE OUTST (A)<
PUSHJ PP,[MOVEI UA,A
JRST UOUTST]
>;END DEFINE OUTST (A)
DEFINE FADRI (A,B) <FADR A,[EXP <B>_^D18]>
DEFINE FSBRI (A,B) <FSBR A,[EXP <B>_^D18]>
DEFINE FMPRI (A,B) <FMPR A,[EXP <B>_^D18]>
>;END IFE PDP-6
IFN XPV,<
IFE KI+KL-10,<
DEFINE DEXCH (A,B),<
IFDIF <B> <-XPV(PP) >,PX DEXCH ERRONEOUS USE
PUSHJ PP,[EXCH AC,-WPV(PP)
EXCH MQ,-XPV(PP)
POPJ PP,]
>;END DEFINE DEXCH (A,B)
>;END IFE KI+KL-10
>;END IFN XPV
IFE XPV,<OPDEF DLSH [LSH]>
IFE XPV,<OPDEF DASH [ASH]>
IFG XPV,<OPDEF DLSH [LSHC]>
IFG XPV,<OPDEF DASH [ASHC]>
IFN KL-10,<
DEFINE ADJSP(A,B),<
IFL B+1,SUB A,[XWD -<B>,-<B>]
IFE B+1,POP A,(A)
IFG B, ADD A,[XWD B,B]
>;END DEFINE ADJSP(A,B)
>;END IFL KL-10
SUBTTL LIST OF FUNCTION NAMES AND ENTRY POINTS.
;NAMES OF THE FORM FABC$ (I.E. STRING FUNCTIONS) MUST BE WRITTEN AS &ABC
DEFINE FNCLIST <
X FSIN,SIN
X FSIND,SIND
X FCOS,COS
X FCOSD,COSD
X FLOG10,LOG10
X FLOG,LOG
X FEXP,EXP
X FSQT,SQRT
X FATN,ATAN
X FABS,ABS
X FSGN,SIGN
X FRAN,FRAN
X FITR,FITR
X FOCAL,FOCALF
X GETTAB,GETAB
X FNEW,FNEWH
X FCHR,FCHR
X &CHR,FCHR$
X FHIBER,FHIBER
>;END DEFINE FNCLIST
SUBTTL ERROR CODES.
;ERROR CODE FIELDS.
;BITS 18-22,30-35 MONITOR CODE.
;BITS 23-27 SERIAL #.
;BITS 9,28-29 FLAGS.
Y=1B9 ;TYPE " error" AFTER MESSAGE.
F=1B28 ;FATAL ERROR FLAG.
M=1B29 ;MONITOR ERROR FLAG.
DEFINE ERRLIST <
X NULL,F,<Program re-started>
X BADLIN,F,<Illegal number>
X NOLINE,F,<Nonexistent line>
X ILLCOM,F,<Illegal command>
X SETERR,F,<Illegal variable>
X MISMAT,F,<Mismatched parentheses>
X NOCOR,F,<Insufficient core>
X ILSQRT,0,<Imaginary roots required>
X SYNTAX,F,<Unexpected character>
X INPERR,F!M,<Input device>
X OUTERR,F!M,<Output device>
X INIERR,F,<INIT>
X ENTERR,F!M,<ENTER>
X LUKERR,F!M,<LOOKUP>
X RENERR,F!M,<RENAME>
X FRMERR,0,<Illegal format (ignored)>
X FOVERR,0,<Floating-point overflow>
X FXUERR,0,<Floating-point underflow>
X CHNERR,0,<Channel not correctly INITted>
>;END DEFINE ERRLIST
DEFINE X(ERNAME,FLAGS,TEXT),<
ERNAME=<XXX_10>!FLAGS
XXX=XXX+1
>;END DEFINE X(ERNAME,FLAGS,TEXT)
XXX=0
ERRLIST
SUBTTL STATUS FLAG BITS (F0).
;RIGHT HALF. (EXTERNAL USE)
;CUSTOMER PLEASE USE BITS 18,19,20,...
;I WILL USE BITS 35,34,33,...
COLSUP==1B35 ;SUPPRESS COLON CUE IN ASK COMMAND.
EQUSUP==1B34 ;SUPPRESS EQUALS PRIOR TO VALUE TYPE-OUT.
ERRSUP==1B33 ;SUPPRESS NON-FATAL ERROR MESSAGES.
;LEFT HALF. (INTERNAL USE)
STRING==1B17 ;WE WERE, ARE OR WILL BE EVALUATING A STRING.
NUMBER==1B16 ;WE WERE, ARE OR WILL BE EVALUATING A NUMBER.
LOGICL==1B15 ;WE WERE, ARE OR WILL BE EVALUATING A LOGICAL EXPRE.
EXTGIV==1B11 ;=1 SPECIFIC FILE EXTENSION GIVEN.
CUETTY==1B10 ;OUTPUT ONLY TO TTY AND ONLY IF TTY INPUT.
IFCMD==1B9 ;WE ARE EXECUTING AN IF COMMAND.
ACCSGN==1B5 ;PDP-6 ARITHMETIC ACC SIGN.
MEMSGN==1B4 ;PDP-6 ARITHMETIC MEM SIGN.
BTHSGN==1B3 ;PDP-6 ARITHMETIC RESULT SIGN.
MODRUB==1B2 ;DURING 'MODIFY',RUBOUT WAS LAST CHARACTER TYPED
DEBFLG==1B1 ;=1 DEBUG IS "ACTIVE". - PRINT EACH CHARACTER
NO.INT==1B0 ;=0 MEANS PNTR POINTS TO A STRING BEING INTERPRETED.
;=1 MEANS PNTR POINTS TO DATA.
;NO.INT FLAG OFF MAKES THE INTERPRETER
;LISTEN TO QUESTION MARKS, AND
;TYPE EACH CHARACTER IF DEBFLG=1
;THIS FLAG MUST BE SET/CLEARED
;EVERY TIME PNTR IS MOVED TO ANOTHER STRING
SUBTTL CHARACTER CHARACTERISTICS (CC).
;LEFT HALF. NATURE OF NEXT CHARACTER FROM ILDB PNTR.
;AN MUST BE THE SIGN BIT.
LP==1B5 ;LEFT PARENS (,<, OR [
RP==1B4 ;RIGHT PARENS ),>, OR ]
E==1B3 ;E (THE LETTER)
N==1B2 ;NUMERIC 0-9 INCLUSIVE OR POINT (.).
A==1B1 ;ALPHABETIC A-Z INCLUSIVE.
AN==1B0 ;ALPHANUMERIC 0-9 OR A-Z BUT NOT E.
NBITS==6 ;NUMBER OF BITS OF CC USED.
SUBTTL INTERNAL PROGRAMMING STANDARDS.
COMMENT \
1.0 GENERAL PROGRAMMING STANDARDS.
1.1 ACCUMULATOR USAGE SHALL BE STRICTLY ADHERED TO.
1.2 LINE LAYOUT IS:
LABEL:(TAB)OP(TAB)ACCUMULATOR,ADR(TABS);COMMENT
WHERE COMMENTS ARE AS FAR AS POSSIBLE RESTRICTED TO ONE LINE.
; IS IN COLUMN 40 OR 5TH TAB POSITION.
1.2.1 MULTILINE LITERALS
INSIDE MULTILINE LITERALS THE OP,ACCUMULATOR AND ADR ARE SHIFTED
RIGHT ONE TAB SPACE. COMMENTS ARE NOT SHIFTED.
IF THE CALLING INSTRUCTION HAS AN ACCUMULATOR FIELD, THE MULTILINE
LITERAL MUST START ON THE NEXT LINE.
IF THE CALLING INSTRUCTION HAS NO ACCUMULATOR FIELD, WRITE
OP-SPACE-[-TAB THEN START THE LITERAL.
1.2.2 SINGLE-LINE-LITERALS
THE LITERAL IS WRITTEN WITHOUT SPACES OR TABS EITHER
BEFORE OR AFTER THE "[".
1.3 SUBROUTINES ARE CALLED WITH A PUSHJ AS A GENERAL RULE,
AND RETURN WITH A POPJ AT THE SAME LEVEL.
THE MAIN ARGUMENT(S) IS (ARE) CARRIED TO AND FROM
THE SUBROUTINE IN AC,MQ,AA.
ACCUMULATORS T2-T6 ARE ALWAYS PRESERVED.
VARIATIONS FROM THE ABOVE MUST BE STATED IN WRITING
AT THE HEAD OF THE SUBROUTINE, WHEN DESCRIBING THE
CALLING SEQUENCE.
UNLESS OTHERWISE STATED, AC,MQ,AA ARE NOT PRESERVED.
\
COMMENT \
2.0 SPECIAL RULES.
2.1 CC,CH ARE IMMEDIATELY UPDATED WHENEVER C(PNTR) IS CHANGED.
2.2 THE FLOATING POINT TRAP ROUTINE ASSUMES THE FOLLOWING ...
1. UFA MAY ONLY BE USED IN DOUBLE PRECISION KA-10
UUO ARITHMETIC ROUTINE DELIMITED BY DFABEG & DFAEND.
2. ACCUMULATOR "PC" IS AVAILABLE FOR TRAPPING.
3. THE XCT AND JRSTF INSTRUCTIONS DO NOT CAUSE A TRAP.
4. NO FLOATING-POINT INSTRUCTION IN FOCAL STORES A RESULT IN
"MEMORY" MODE OR "BOTH" MODE.
5. THE RESULT MAY BE STORED IN THE ACCUMULATOR AND, IF FOCAL IS
DOUBLE-PRECISION, ACCUMULATOR+1, EVEN IF THE INSTRUCTION WOULD
NORMALLY STORE ONLY IN THE ACCUMULATOR (SUCH AS FSC).
THIS TURNS OUT TO BE THE CORRECT PROCEDURE FOR FOCAL ANYWAY.
2.3 THE UUO HANDLER CAN BE CALLED RECURSIVELY (FROM WITHIN ITSELF).
THE UUO SCRATCH ACCUMULATOR MUST THEREFORE BE USED WITH
CONSIDERABLE DISCRETION.
2.4 THE DOUBLE PRECISION UUO'S MAY ONLY BE USED WITH CERTAIN SPECIFIC
ACCUMULATORS:
UUO ALLOWABLE ACCUMULATORS
---------- ----------------------
DPUSH PP ONLY.
ALL OTHERS AC ONLY (MEANING THE AC,MQ PAIR.)
2.5 THE EFFECTIVE ADDRESS USED WITH THE DOUBLE PRECISION UUO'S ALWAYS
REFERS TO THE PAIR OF WORDS AT THAT ADDRESS
2.6 THE DOUBLE PRECISION UUO'S MAY BE USED WITH ANY EFFECTIVE ADDRESS
BUT IF THE EFFECTIVE ADDRESS IS AN ACCUMULATOR PAIR, IT MUST BE
ONE OF - AC,MQ OR T2,T3 OR T3,T4 OR T4,T5 OR T5,T6
\
COMMENT \
3.0 DATA HANDLING.
3.1 FLOATING-POINT DATA.
DATA IS HELD IN STANDARD DECsystem-10 FORMAT
ACCORDING TO THE HARDWARE IT IS ASSEMBLED FOR.
FLOATING-POINT DATA MAY BE HELD IN ONE OF THREE PLACES:
3.1.1 IN ACCUMULATOR: AC ALONE OR AC,MQ.
3.1.2 ON THE STACK: ONE OR TWO WORDS, HIGH ORDER PUSHED FIRST.
3.1.3 IN THE SYMBOL TABLE: ONE OR TWO WORDS, IN ORDER: HIGH, LOW, NAME.
3.2 FIXED-POINT DATA IS HELD IN AC AND MQ.
THE DATA TAKES THE FORM OF A 71-BIT TWO'S COMPLEMENT
NUMBER, IN AC BITS 0-35, MQ BITS 1-35.
THE SIGN BIT, AC(0) IS DUPLICATED IN MQ(0) FOR CONVENIENCE.
3.3 STRING DATA.
STRING DATA MAY BE HELD IN THE FOLLOWING FORMS:
3.3.1 IN "ACCUMULATOR": AC POINTS TO THE STRING,
AND MQ POINTS TO THE LAST CHARACTER.
THE ACTUAL STRING IS AT BUFH.
3.3.2 ON THE STACK: TO PUT DATA ON THE STACK, USE:
PUSH PP,AC
PUSH PP,MQ
MOVEM MQ,BUFH
TO REMOVE DATA FROM THE STACK, USE:
POP PP,MQ
POP PP,AC
MOVEM AC,BUFH
3.3.3 IN THE SYMBOL TABLE: THE STRING IS STORED IN CORE ABOVE THE SYMBOL TABLE.
THE SYMBOL TABLE ENTRY IS OF THE FORM:
1. POINTER TO THE DATA (INDEX FIELD REFERENCING RL).
2. UNUSED WORD (DOUBLE PRECISION FOCAL-10).
3. NAME.
\
COMMENT \
4.0 DESIGN CRITERIA
THE ALGORITHMS AND METHODS USED IN THIS PROGRAM SHALL BE
DECIDED BY THE FOLLOWING CRITERIA IN THIS ORDER ...
4.1 CORE SIZE
UNDER NO CIRCUMSTANCES WILL THE HIGH SEGMENT EXCEED 2K.
4.2 ACCURACY
ALL ARITHMETIC WILL GIVE EXACT ANSWERS WHERE POSSIBLE EXCEPT
THAT IN THE CASE OF OVERFLOW OR UNDERFLOW THE CLOSEST REPRESENTATION
OF THE NUMBER WILL BE USED
4.3 MAINTAINABILITY
IN ORDER TO CONCURRENTLY MAINTAIN THIS SOFTWARE FOR BOTH
SINGLE AND DOUBLE PRECISION AND FOR PDP-6, KA-10, KI-10 AND KL-10,
SIMPLER AND MORE GENERAL CODING IS PREFERRED, EVEN THOUGH
IT MIGHT NOT BE AS TIGHT OR FAST AS POSSIBLE.
4.4 SPEED
AFTER ALL THE ABOVE CONSIDERATIONS HAVE BEEN TAKEN INTO ACCOUNT,
EXTRA CODE MAY BE INTRODUCED TO IMPROVE SPEED.
\
SUBTTL ABSOLUTE LOCATIONS
INTERNAL .JB41,.JBVER ;CONSISTENCY CHECK.
.JB41=41
LOC .JB41
IFE PDP-6,< JSR UUOH.>
IFN PDP-6,< PUSHJ PP,UUOH>
.JBVER=137
LOC .JBVER
BYTE (3)VWHO (9)VMAJOR (6)VMINOR (18)VEDIT
SUBTTL LOW SEGMENT DATA
RELOC 0
;******** DATA-BLOCK POINTERS ********
BUFH: BLOCK 1 ;POINTER TO LAST CHAR IN LIBRA CALL TEXT AREA.
DBP: ;THIS GROUP IS CHECKED BY THE SQUEEZ ROUTINE.
INDEX: BLOCK 1 ;LEFT HALF - UNUSED. (CONTAINS -1)
;RIGHT HALF - ADDRESS OF INDEX DATA BLOCK.
TEXTL: BLOCK 1 ;RIGHT HALF POINTS JUST BELOW FOCAL PROGRAM TEXT.
;LEFT HALF CONTAINS -1.
PNTR: BLOCK 1 ;CURRENT BYTE POINTER TO FOCAL TEXT.
THISPT: BLOCK 1 ;POINTER TO BEGINNING OF EXECUTION OF CURRENT LINE.
BUFL: BLOCK 1 ;POINTER TO JUST BELOW LIBRA CALL TEXT AREA.
;LEFT HALF CONTAINS 010700.
DBPEND=+. ;END OF DATA-BLOCK POINTERS.
;******** PROGRAM STATUS DATA WORDS ********
OUTCHN: BLOCK 1 ;CURRENT-OUTPUT-CHANNEL.
INCHN: BLOCK 1 ;CURRENT-INPUT-CHANNEL.
WPC==3 ;THREE WORDS PER CHANNEL.
HEDTAB: BLOCK 20*WPC ;BUFFER HEADERS.
BUFTAB: BLOCK 20 ;TABLE OF POINTERS TO BUFFER SPACE
;ALLOCATED TO EACH CHANNEL.
;IF ENTRY IS ZERO, THEN NO BUFFERS ARE ALLOCATED.
;IF THE WORD IS NEGATIVE, IT MEANS THE CHANNEL IS
;INITTED FOR OUTPUT. FOLLOWING DATA IS GOTTEN
;BY NEGATING THE WHOLE WORD FIRST....
;LEFT HALF - SIZE OF BUFFER SPACE.
;RIGHT HALF - ADDRESS OF BUFFER SPACE.
FORFLA: BLOCK 1 ;CONTAINS ZERO IF NO 'FOR' IN EXECUTION.
;OTHERWISE XWD -1,LINNUM-OF-FOR.
FOVSUP: BLOCK 1 ;IF THIS WORD IS NON-ZERO (SET TO -1),
;THEN SUPPRESS FLOATING-POINT TRAP ERROR MESSAGES.
LUPARG: BLOCK 2 ;MOST RECENT ARGUMENT OF REPETITIVE LOOP.
;(2 LOCATIONS TO PRESERVE HISTORICAL MAP.)
THISLN: BLOCK 1 ;# OF THE LINE BEING EXECUTED.
LINNUM: BLOCK 1 ;RIGHT-HALF - LINE NUMBER OF CURRENT INTEREST
;(ALWAYS POSITIVE).
;LEFT HALF IF NEGATIVE IS A LINK
;TO NESTED LINES AND POINTERS.
;PREVIOUS LINNUM IS AT PDLEND-2+LH(LINNUM).
;PREVIOUS PNTR IS AT PDLEND-1+LH(LINNUM).
;******** SYMBOL TABLE POINTERS ********
SYMTBL: BLOCK 1 ;Address just below bottom of symbol-table.
;Left half contains index RL.
SYMTBC: BLOCK 1 ;Address of first name in symbol table.
;Left half contains index RL.
SYMTBH: BLOCK 1 ;Highest location of symbol table.
;Normally contains same as .JBREL.
FORMAT: BLOCK 1 ;FORMAT CONTROL FOR TYPING NUMBERS.
;BITS 0-28: TOTAL # DIGITS.
;BITS 29-35: # DIGITS RIGHT OF POINT.
EORMAT: BLOCK 1 ;FORMAT CONTROL FOR E-FORMAT OUTPUT
IFN <FORMAT+1-EORMAT>,PX <FORMAT,EORMAT OUT OF SEQUENCE>
OLDRAN: BLOCK WPV ;SAVE LAST RANDOM NUMBER.
FORMAX: BLOCK WPV ;LOGARITHM OF UPPER SIZE LIMIT FOR F-FORMAT
;OUTPUT BEFORE ROUNDING.
EORMAX: BLOCK WPV ;LOGARITHM OF UPPER SIZE-LIMIT
;OF F-PART OF E-FORMAT TYPE-OUT.
IFN <FORMAX+WPV-EORMAX>,PX <FORMAX,EORMAX OUT OF SEQUENCE>
;******** TEMPORARY STORAGE ********
TEMP1: BLOCK WPV ;THIS STORAGE IS NOT ...
TEMP2: BLOCK WPV ;...GUARANTEED PRESERVED BY SUBROUTINES ...
TEMP3: BLOCK WPV ;...THEREFORE ONLY USE IT ON THE ONE PAGE.
TEMP4: BLOCK WPV
TEMPE: BLOCK WPV ;TEMPORARY STORAGE FOR EXP. ROUTINE.
TEMPR: BLOCK WPV ;TEMPORARY STORAGE FOR RECIPR ROUTINE.
TEMPT: BLOCK WPV ;TEMPORARY STORAGE FOR TYPE-OUT ROUTINE.
LUKENT: BLOCK .RBDEV+2+AA ;LOOKUP/ENTER BLOCK.
IFLE MONITOR-4.72,<
WPD=4 ;WORDS PER DIRECTORY ENTRY.
FILTAB: BLOCK 20*WPD ;SPACE FOR FILE NAME ETC.
>;END IFLE MONITOR-4.72
BUFBOT: BLOCK 1 ;SAVE .JBFF HERE.
;******** PUSH-DOWN LIST ********
PDL: BLOCK PDC ;PROGRAM PUSH-DOWN LIST.
PDLEND: BLOCK 2 ;TWO SPARE FOR OVERFLOW.
IFG XPV,<
IFE PDP-6,<
;PDP-6 DOUBLE FLOATING ARITHMETIC SUBROUTINES.
;INITIALIZATION.
; 1. PLACE ACC SIGN IN ACCSGN BIT.
; 2. PLACE MEM SIGN IN MEMSGN BIT.
; 3. PLACE XOR OF THESE IN BTHSGN BIT.
; 4. PUT FRACTION MAGNITUDES IN AC,MQ AND A1,A2 BITS 9-71
; 5. PUT EXPONENT MAGNITUDES IN AA,A3 WITHOUT EXCESS 200.
;CALL - PUSHJ PP,AINI ;ENTER WITH NORMALIZED ARGUMENTS.
; RETURN IF ACC ZERO ;WITH MEM UNTOUCHED.
; RETURN IF MEM ZERO ;WITH ACC UNTOUCHED.
; NORMAL RETURN.
AINI: MOVEM AC,A1 ;SET UP IN CASE EFFECTIVE ADDRESS
MOVEM MQ,A2 ;IS "AC".
TDNN MQ,[377777777777] ;CHECK FOR ZERO ACCUMULATOR.
JUMPE AC,AINI0 ;INCLUDING UNNORMALIZED CHECK.
AOS (PP) ;TAKE SECOND OR THIRD RETURN.
SKIPN (UA) ;MEM ZERO?
SKIPE 1(UA) ;(ALSO CHECK UNNORMALIZED)
AOS (PP) ;NORMAL RETURN NOW.
AINI0: TLZ F0,(ACCSGN!MEMSGN!BTHSGN);CLEAR BITS.
PUSHJ PP,AINI1 ;FIX ACC ARGUMENT.
PUSHJ PP,UMOVE ;GET MEM ARGUMENT.
AINI1: JUMPGE AC,AINI2 ;POSITIVE ALREADY?
TLC F0,(ACCSGN!BTHSGN) ;NO. MARK NEGATIVE
PUSHJ PP,NEGANS ;AND MAKE NEGATIVE.
AINI2: LDB AA,[POINT 8,AC,8] ;PICK EXPONENT.
SUBI AA,200 ;REMOVE THE EXCESS 200.
TLZ AC,777000 ;MAKE FRACTION PURE.
AEXCH: TLNE F0,(BTHSGN) ;ACCSGN SAME AS MEMSGN?
TLC F0,(ACCSGN!MEMSGN) ;NO. SWAP THEM.
AEXCH0: EXCH AA,A3 ;EXCHANGE ALL.
AEXCH1: EXCH MQ,A2 ;
EXCH AC,A1
POPJ PP,
A1: Z ;SPACE TO STORE MEM HI ORDER.
A2: Z ;SPACE TO STORE MEM LOW ORDER.
A3: Z ;SPACE TO STORE MEM EXPONENT.
>;END IFE PDP-6
>;END IFG XPV
IFN <KI+KL-10>*<XPV>,<
DFABEG: ;DOUBLE-FLOATING ARITHMETIC.
IFE PDP-6,<
UFMP: PUSHJ PP,AINI ;ARITHMETIC INITIALIZATION.
JRST ZERANS ;ACC ZERO.
JRST ZERANS ;MEM ZERO.
ADDB AA,A3 ;MAKE NEW EXPONENT.
ASHC AC,8 ;ADJUST FOR MULTIPLY.
SUBI AA,2 ;MAKE SPACE FOR TWO BITS OF MOVEMENT
PUSHJ PP,AEXCH0 ;INTERCHANGE MULTIPLIER & MULTIPLICAND
ASHC AC,2 ;MAKE SPACE FOR TWO BITS OF MOVEMENT
MUL MQ,A1 ;FIRST CROSS-PRODUCT.
MULM AC,A2 ;SECOND CROSS-PRODUCT.
JCRY1 .+1 ;CLEAR CRY1 FLAG.
ADDM MQ,A2 ;ADD CROSS-PRODUCTS.
MUL AC,A1 ;MULTIPLY HI ORDERS.
JCRY1 [ AOJA AC,.+1] ;ADD CARRY FROM XPROD-ADD.
AOJA MQ,UFAD2 ;ADD ROUNDING, THEN COMBINE AND GOTO NR.
UFDV: PUSHJ PP,AINI ;ARITHMETIC INITIALIZATION.
JRST ZERANS ;ACC ZERO.
JRST FOVANS ;MEM ZERO.
PUSHJ PP,AEXCH1 ;MEM TO ACC TEMPORARILY.
ASHC AC,8 ;ADJUST FOR DIVIDE.
PUSHJ PP,AEXCH1 ;RESTORE ACC TO MEM.
SUBB AA,A3 ;MAKE NEW EXPONENT.
DIV AC,A1 ;FIRST DIVISION.
;OLD V. MULM AC,A2 ;GET QUOTIENT TIMES HI MEM.
;OLD V. SUB MQ,A2 ;
EXCH MQ,A2 ;NEW V. I SUSPECT THAT THESE FOUR LINES
MOVNS MQ ;NEW V. OF CODE ARE MORE ACCURATE THAN
MUL MQ,AC ;NEW V. THE PREVIOUS TWO, ALTHOUGH
ADD MQ,A2 ;NEW V. I HAVE NO FIRM BASIS FOR THIS.
DIV MQ,A1 ;SECOND DIVISION.
JUMPGE MQ,NR1 ;NORMALIZED RETURN.
SOJA AC,NR1 ;NORMALIZED RETURN.
>;END IFE PDP-6
IFE KA-10,<
UFMP: MOVEM AC,AA ;COPY HIGH ACCUMULATOR OPERAND TO AA.
FMPR AA,1(UA) ;FIRST CROSS PRODUCT TO AA
FMPR MQ,(UA) ;SECOND CROSS PRODUCT TO MQ
UFA MQ,AA ;STORE SUM OF CROSS PRODUCTS IN AA
FMPL AC,(UA) ;STORE PRODUCT OF HIGH PARTS IN AC,MQ
JRST UFAD1 ;COMBINE AC,MQ AND AA INTO AC,MQ THEN RETURN
UFDV: FDVL AC,(UA) ;HIGH ORDER DIVISION
MOVN AA,AC ;COPY NEGATIVE OF THE QUOTIENT INTO AA
FMPR AA,1(UA) ;MULTIPLY LOW PART OF DIVISOR
UFA MQ,AA ;ADD REMAINDER & STORE IN AA
FDVR AA,(UA) ;DIVIDE SUM BY HIGH PART OF DIVISOR
JRST UFAD2 ;ADD RESULT TO ORIGINAL QUOTIENT & RETURN
>;END IFE KA-10
UFSB: NEGATE ACCUM ;NEGATIVE ADD
PUSH PP,JNEG ;SIGNAL TO NEGATE AFTER ADDING.;FALL INTO UFAD
>;END IFN <KI+KL-10>*<XPV>
IFG XPV,<
IFE PDP-6,<
UFAD: PUSHJ PP,AINI ;ARITHMETIC INITIALIZATION.
SKIPA ;ACC ZERO.
JFCL ;MEM ZERO.
CAMLE AA,A3 ;FIND SMALLER EXPONENT.
PUSHJ PP,AEXCH ;AND PUT IT IN ACC.
SUB AA,A3 ;GET EXPONENT DIFFERENCE.
CAMG AA,[-76] ;GUARD AGAINST EXCESS SHIFTS.
SETZB AC,MQ ;WHICH MIGHT BE OMITTED.
ASHC AC,(AA) ;ALIGN BOTH OPERANDS.
TLZE F0,(BTHSGN) ;ACC,MEM OPPOSITE SIGNS?
PUSHJ PP,NEGANS ;YES. MAKE SIGN FOR AN ADD.
TLZE F0,(MEMSGN) ;THEN TRANSFER RESULT SIGN ...
TLO F0,(BTHSGN) ;... TO BTHSGN BIT.
ADD AC,A1 ;ADD HI ORDERS.
JCRY1 .+1 ;CLEAR CRY1 FLAG.
UFAD2: ADD MQ,A2 ;ADD LO ORDERS.
JCRY1 [ AOJA AC,.+1] ;ADD IN POSSIBLE CARRY.
JUMPGE AC,NR1 ;CHECK FOR NEGATIVE RESULT.
TLC F0,(BTHSGN) ;ADJUST SIGN.
PUSHJ PP,NEGANS ;AND DATA.
;HERE WITH FRACTION RESULT IN AC,MQ,
; EXPONENT RESULT IN A3, SIGN RESULT IN BTHSGN BIT OF F0.
NR1: TDNN MQ,[377777777777] ;DOUBLE-CHECK FOR ZERO.
JUMPE AC,ZERANS ;WHICH IS NORMALIZED BY DEFINITION.
AOSA AA,A3 ;EXPONENT INTO AA.
NR2: ASHC AC,1 ;ONE LOOP.
TLNN AC,2000 ;DONE?
SOJA AA,NR2 ;NO.
ASHC AC,-2 ;YES. PUT TO FINAL POSITION.
ADDI AA,201 ;GET FINAL EXPONENT.
JUMPL AA,FXUANS ;UNDERFLOW?
CAILE AA,377 ;OVERFLOW?
JRST FOVANS ;TOO BAD!
DPB AA,[POINT 8,AC,8] ;DEPOSIT EXPONENT IN ITS FIELD.
TLZE F0,(BTHSGN) ;SIGN OF RESULT.
JRST NEGANS ;NEGATIVE.
POPJ PP, ;POSITIVE.
>;END IFE PDP-6
IFE KA-10,<
UFAD: UFA MQ,1(UA) ;PUT SUM OF LOW PARTS IN AA
FADL AC,(UA) ;ADD HIGH ORDER PARTS INTO AC,MQ
UFAD1: UFA MQ,AA ;SET AA=MQ+AA
UFAD2: FADL AC,AA ;SET AC,MQ=AC+(AA=MQ+AA)
POPJ PP, ;NO. RETURN.
DFAEND:
>;END IFE KA-10
>;END IFG XPV
SUBTTL FNEW HANDLER
IFNDEF FNEW,<FNEWH: BLOCK 1> ;FLAG THAT NO FNEW HANDLER IS LOADED.
IFDEF FNEW,<
IFN PDP-6,<ASUPPRESS> ;REMOVE PROPRIETARY SYMBOLS FROM REL FILE.
.CREF
LIST
FNEWH: JSPPC PROT26 ;SAVE SOME TEMPORARY ACCUMULATORS
MOVE T4,T2-T6-2(PP) ;GET LAST ITEM ON STACK.
MOVE T2,PP ;REMEMBER WHERE THE STACK WAS.
TDZA T3,T3 ;CLEAR ARGUMENT COUNTER.
FNEWH1: HPSTPP EVAL ;GET NEXT ARGUMENT.
HRRZI T5,3(PP) ;POINT TO THE ARGUMENT.
HRLI T5,(<1B10>_XPV) ;SET UP ARG-TYPE IN AC FIELD.
TLZN F0,(NUMBER) ;WAS IT A STRING ARGUMENT?
TLO T5,(17,) ;YES.
PUSH PP,T5 ;SAVE THE POINTER.
MOVEI AA,WPV+2 ;NUMBER OF WORDS ON PDL.
PUSH PP,AA ;SAVE THE COUNTER.
TLZN F0,(STRING) ;WAS IT A STRING ARGUMENT?
JRST FNEWH4 ;NO.
MOVEI T5,(PP) ;POINT TO THE COUNTER.
MOVE AC,BUFH ;MAKE A LOADING POINTER.
HRLZI UA,(POINT 7,(T5),34) ;MAKE A DEPOSITING POINTER.
FNEWH2: TLNN UA,760000 ;IS THERE ROOM FOR ANOTHER CHARACTER?
AOSA (T5) ;NO. INCREMENT THE COUNT....
SKIPA ;(YES.)
PUSH PP,ZERO ;.... AND MAKE ROOM FOR 5 MORE.
CAMN AC,MQ ;DONE?
SETZB AC,MQ ;FLAG END OF STRING.
ILDB AA,AC ;PICK UP CHARACTER.
IDPB AA,UA ;DEPOSIT IT IN THE STACK.
JUMPN AC,FNEWH2 ;LOOP.
FNEWH4: DPUSH PP,AC ;HERE TO STORE NUMERIC VALUE.
CAIE T4,EVALY ;WERE THERE ANY ARGUMENTS?
JRST FNEWH5 ;NO.
CAIN CH,"," ;ARE THERE ANY MORE ARGUMENTS?
SOJA T3,FNEWH1 ;YES.
FNEWH5: HRLZI T3,-1(T3) ;GET ARGUMENT COUNT.
PUSH PP,T3 ;SAVE ARGUMENT COUNT WORD
HRRZI 16,1(PP) ;SET UP AC16 TO POINT TO ARG LIST.
HRRZI T4,1(T2) ;POINT TO NEXT ARGUMENT.
FNEWH6: PUSH PP,(T4) ;ENTER ARG ENTRY INTO LIST.
ADD T4,1(T4) ;POINT TO NEXT ARGUMENT
AOBJN T3,FNEWH6 ;PUT ALL ENTRIES IN LIST.
MOVEM 0,AC ;SAVE AC0.
PUSHJ PP,FNEW ;PERFORM FUNCTION.
EXCH 0,AC ;RESTORE AC0, GET ANSWER.
IFG XPV,<MOVEM 1,AC+1> ;AND LOW ORDER.
MOVE PP,T2 ;RESTORE PP.
TLO F0,(NUMBER) ;INDICATE NUMERIC ANSWER.
GLIDE CPOPJ ;RESTORE CH (16).
IFN <F0-0>!<UA-1>!<CC-16>!<PP-17>,PX AC CONFLICT AT FNEWGO:
>;END IFDEF FNEW
IFDEF FNEW,<
IFN PDP-6,<
FNEWGO::JFCL ;ALLOW A START AT FNEWGO+1
SKIPE T2,.JBHRL## ;.JBHRL SHOULD CONTAIN ZERO.
OUTSTR FNEWM1 ;PRINT ERROR MESSAGE.
JUMPN T2,FNEWER ;AND IDENTIFY IT.
IORI T2,BUFH-140 ;LOW SEGMENT MUST START AT 140.
SKIPE T2 ;O.K. IF T2 CONTAINS ZERO.
OUTSTR FNEWM2 ;OTHERWISE NOT O.K.
JUMPN T2,FNEWER ;ERROR EXIT.
MOVEI AC,2 ;INITIAL TARGET IS TWO DIRECT HITS.
FNEWG1: MOVEM AC,TARGET ;STORE A TARGET WHICH, IF HIT, WILL EXIT.
SETOM SCORE ;INITIALIZE SCORE CARD.
SKIPA AC,.+1 ;POINT TO LIST OF DEVICES TO SCAN.
POINT 36,DEVLST ;POINT TO LIST OF DEVICES TO SCAN.
MOVEM AC,PNTR ;POINT TO THE LIST.
FNEWG3: ILDB AA,PNTR ;GET NEXT DEVICE NAME.
JUMPE AA,FNEWG9 ;END OF LIST.
SKIPA AA+1,.+1 ;FILE NAME
SIXBIT "FOCAL" ;FILE NAME.
SETZB AA+2,AA+3 ;EXTENSION.
SETZB AA+4,AA+5 ;PPN, OPTIONAL CORE ASSIGNMENT.
MOVEI AC,AA ;POINT TO GETSEG ARGUMENTS.
GETSEG AC, ;TRY TO FIND FOCAL.SHR.
JRST FNEWG3 ;ERROR! NOT FOUND.
SETZM AC ;PRE-SET TO COUNT THE SCORE FOR THIS HIT.
MOVE MQ,.JBHVR##+400000 ;GET VERSION # OF HIGH SEGMENT.
CAMN MQ,FCLLVN ;INSTRUCTION TO GO INTO FNEWG3.
AOS AC ;VERSION NUMBER OK: SCORE 1.
MOVS MQ,NINETY ;GET A VALUE FROM THE END OF THE HI SEG.
CAIN MQ,(90.0) ;COMPARE FEATURES.
SOJE AC,FNEWEX ;SCORE TWO! A WINNER!
MOVMS AC ;NON-ZERO HERE MEANS WE HIT ONE OF THEM.
CAMLE AC,SCORE ;ZERO MEANS THAT AT LEAST WE FOUND .SHR.
MOVEM AC,SCORE ;MARK BEST SCORE SO FAR.
CAME AC,TARGET ;DID WE REACH TARGET YET?
JRST FNEWG3 ;NO. TRY AGAIN.
OUTSTR FNEWM5 ;COMPLAIN IF DIFFERENT.
FNEWEX::JRST ONCE ;THEN GO ANYWAY.
FNEWG9: SKIPL AC,SCORE ;HERE WHEN DONE SCANNING DEVLST.
JRST FNEWG1 ;TRY ANOTHER SCAN WITH LOWER TARGET.
OUTSTR FNEWM3 ;ERROR MESSAGE.
FNEWER: OUTSTR FNEWM4 ;TYPE IDENTIFICATION MESSAGE.
EXIT
FCLLVN: BYTE (3)VWHO (9)VMAJOR (6)VMINOR (18)VEDIT;MUST BE HERE 'COS 137 HAS FORTRAN'S
TARGET: EXP 1 ;IF SCORE REACHES TARGET WE WIN.
SCORE: EXP -1 ;SCORE 1 IF VERSION # OK, +1 IF NINETY OK.
DEVLST: SIXBIT "DSK"
SIXBIT "SYS"
SIXBIT "NEW"
SIXBIT "OLD"
Z
FNEWM1: ASCIZ "?Loading error: High segment is forbidden.
"
FNEWM2: ASCIZ "?Loading error: FOCALL.REL must be loaded first.
"
FNEWM3: ASCIZ "?Cannot find FOCAL.SHR on DSK: or SYS: or NEW: or OLD:.
"
FNEWM4: ASCIZ "?Error detected by FNEWGO routine in FOCALL.REL.
"
FNEWM5: ASCIZ "%
%FOCALL.REL and FOCAL.SHR are different versions.
"
>;END IFN PDP-6
>;END IFDEF FNEW
SUBTTL INITIALIZATION
IFE <KI+KL-10>*<<KA-10>!XPV>,ENDSEG
FOCAL:
;THIS ROUTINE INITIALIZES THE WHOLE OF THE LOW SEGMENT
ONCE: SETZB F0,T2 ;CLEAR ALL FLAGS. ; SET INDEX TO FORMAT.
MOVE PP,PDS ;ENSURE PDL SET UP.
HLRZ AC,.JBSA## ;FIND PLACE FOR INDEX DATA BLOCK.
MOVEM AC,BUFBOT ;REMEMBER WHERE FREE CORE STARTS.
HRROM AC,TEXTL ;SET UP TEXTL.
HRROM AC,INDEX ;POINT TO INDEX DATA BLOCK.
PUSHJ PP,CLRVA1 ;ENSURE CORE, SETUP SYMBOL-TABLE POINTERS
AOS AC,TEXTL ;MAKE SPACE FOR INDEX DATA BLOCK; RESTORE AC.
HRLI AC,(POINT 7,,34) ;MAKE UP POINTER.
MOVEM AC,BUFL ;MARK TOP OF TEXT.
SETOM -1(AC) ;SET ONES IN FIRST WORD OF INDEX TABLE
SETOM (AC) ;AND LAST WORD OF INDEX TABLE
MOVEI AC,8B28+4 ;LOAD A PRE-SET FORMAT %8.04
PUSHJ PP,SETMAX ;AND COMPUTE NUMBER-LIMITS.
MOVEI AC,5B28+4 ;PRESET E-FORMAT
MOVEI T2,1 ;SET UP ...
PUSHJ PP,SETMAX ;... THE EORMAX VALUE.
HRRZI AC,RESTART ;GET NEW START ADDRESS.
HRRM AC,.JBSA## ;AND SET SO AS NOT TO WIPE OUT DATA BASE.
HRRZI AC,REENTER ;SET UP RE-ENTRY ADDRESS
HRRM AC,.JBREN## ;ONLY WHEN DATA BASE IS READY.
IFG XPV,<IFE KA-10,< JRST UERR7>> ;GO TO HIGH SEGMENT.
ENDSEG
UERR7: TLZ F0,777777 ;CLEAR INTERNAL FOCAL FLAGS.
START: MOVEI AC,17 ;CLEAR OUT ALL BUFFER-SPACE POINTERS
START1: SETZB T2,INCHN ;CLEAR CURRENT INPUT CHANNEL SELECTION
SETZB AA,OUTCHN ;AND CURRENT OUTPUT CHANNEL SELECTION.
PUSHJ PP,LIBIN1 ;RELEASE THIS CHANNEL.
SOJGE AC,START1 ;ONE WORD FOR EACH CHANNEL.
RESET ;CLEAR ALL PC FLAGS
IFN PDP-6,<
MOVEI AC,TRAP.H ;ADDRESS OF TRAP HANDLER
HRRZM AC,.JBAPR## ;SET UP TRAP INTERRUPT POINTER.
MOVEI AC,AP.FOV+AP.REN ;ENABLE FOR FLOATING POINT OVERFLOW
APRENB AC, ;FOR MULTIPLE CALLS.
>;END IFN PDP-6
SUBTTL MAIN CONTROL ROUTINE
QUIT: SETZB T2,FORFLAG ;SAY "WE ARE NOT IN A 'FOR'".
SETZB T4,LINNUM ;CLEAR LINE NUMBER
SETZM FOVSUP ;ALLOW FLOATING-POINT TRAP ERROR MESSAGES
MOVE RL,SYMTBH ;SET UP ACCUM RL IN CASE OF ^C^C START.
AOS RL ;POINT JUST ABOVE SYMBOL-TABLE.
MOVE AC,BUFL ;FIND OLD LIBRA CALL BUFFER START.
MOVEM AC,BUFH ;CLEAR THE LIBRA CALL BUFFER AREA.
MOVSI T3,(SIXBIT "TTY") ;PREPARE TO INIT TTY.
OPEN TTYCHN,T2 ;INIT TTY IN ASCII MODE.
PDS: IOWD PDC,PDL ;WE HOPE "OPEN" ALWAYS SKIPS THIS.
MOVE PP,PDS ;SET UP PUSH-DOWN POINTER.
MOVEI UA,"*" ;SET CUE CHARACTER.
JSP PC,GETBUF ;ACCEPT AN INPUT BUFFER.
MOVEM AC,PNTR ;POINT TO THE INPUT BUFFER.
JUMPGE T4,EXECLQ ;IF NOT NEAR END-OF-FILE, EXECUTE THEN QUIT.
PUSHJ PP,EXECLN ;EXECUTE A SINGLE LINE.
STOP:
IFLE MONITOR-4.72,<
MOVEI AC,17 ;CLOSE ALL I/O CHANNELS.
STOP1: SETZB AA,T2 ;SET FOR RELEASE.
PUSHJ PP,AUTIO4 ;RELEASE THIS CHANNEL.
SOJGE AC,STOP1 ;CONTINUE UNTIL ALL FILES PROTECTED.
>;END IFLE MONITOR-4.72
EXIT
REENTE:IFGE MONITOR-5.04,<
MOVEI AC,TTYCHN ;CHECK WHETHER THE TELETYPE IS INITTED.
DEVCHR AC, ;TO SEE WHETHER IT'S A TRUE REENTER.
>;END REENTE:IFGE MONITOR-5.04
IFL MONITOR-5.04,<
.JBJDA=75 ;ADDRESS OF JOB DATA AREA.
SETZB AC,.JBJDA+TTYCHN ;CLEAR LOCATION OF JDA TABLE.
SLEEP AC, ;FORCE MONITOR TO REFRESH TABLE.
MOVE AC,.JBJDA+TTYCHN ;SEE IF TTY CHANNEL WAS INITTED.
>;END IFL MONITOR-5.04
QUITT: JUMPN AC,QUIT ;YES. IT'S O.K.
RESTAR: SETZ F0, ;CLEAR ALL FLAGS.
MOVEI PP,PDL+36 ;PRESERVE PREVIOUS INITIAL COMMAND
ERROR NULL ;ENTER FOCAL WITH AN ERROR MESSAGE.
;THE INTENTION HERE IS THAT WE SET UP A TEMPORARY PUSH-DOWN POINTER SO WE CAN
;TYPE OUT AN ERROR MESSAGE. THE CORRECT PUSH-DOWN POINTER WILL BE SET UP AFTER
;WE COME TO THE QUIT ROUTINE AFTER THE ERROR MESSAGE HAS BEEN OUTPUT.
;THE REASON THAT WE START THE POINTER PART-WAY UP THE STACK IS THAT MAYBE
;THISPT POINTS TO THE STACK, AND WE DON'T WANT TO CLOBBER IT IF WE CAN HELP IT.
;THE INITIAL COMMAND IS ON THE STACK BECAUSE WE CAN'T GUARANTEE ANY OTHER SPACE.
;FOR EXAMPLE A PROGRAM RUNS OUT OF CORE; WE WANT TO ALLOW ONE LAST COMMAND
IFL PDC-77,PX INSUFFICIENT PUSH-DOWN LIST SPACE.
;ERROR HANDLING REQUIRES 26 OCTAL LOCATIONS IN THE WORST CASE.
SUBTTL COMMAND DE-CODER
;ROUTINE TO EXECUTE A LINE
EXECLQ: PUSH PP,QUITT ;RETURN TO QUIT AFTER EXECUTING ONE LINE.
EXECLN: HRRZ AC,LINNUM ;GET NUMBER OF LINE TO BE EXECUTED.
SKIPA MQ,PNTR ;GET POINTER TO BEGINNING OF LINE
EXECL.: MOVEM MQ,PNTR ;ENTER HERE WITH AC,MQ & LINNUM SET UP.
EXECL1: PUSH PP,LINNUM ;CREATE LINKAGE...
PUSH PP,THISPT ;SAVE BEGINNING-OF-LINE POINTER.
HLLM PP,LINNUM ;...SEAL THE LINKAGE.
PUSH PP,THISLN ;SAVE PREVIOUS LINE NUMBER.
EXECL2: HRRZM AC,THISLN ;SAVE FOR ERROR MESSAGES.
MOVEM MQ,THISPT ;TO SAVE FOR ERROR MESSAGES.
EXECL3: STEPP EXECL6 ;GO TO SCAN FOR A COMMAND.
EXECL4: CAIN CH,";" ;SEMICOLON?
HPSTP EXECL3 ;YES. CONTINUE ALWAYS.
JUMPN CH,SYNERR ;MUST BE END-OF-LINE NOW!
POP PP,THISLN ;RESTORE PREVIOUS LINE NUMBER.
POP PP,THISPT ;RESTORE POINTER FOR ERROR MESSAGES
POP PP,AC ;RESTORE LINNUM LINKAGES.
HLLM AC,LINNUM ;WITHOUT RUINING THE RETURN COMMAND
TLNE F0,(DEBFLG) ;WERE WE DEBUGGING?
OUTSTR CRLF ;YES. FOLLOW LINE WITH CRLF.
CPOPJ: POPJ PP, ;RETURN.
EXECL6: TLNE CC,(N) ;NUMERIC (OR PERIOD)?
JRST NEWLIN ;YES. INSERT IT.
TLNN CC,(A) ;IS IT A VALID COMMAND?
POPJ PP, ;NO.
ANDI CH,37 ;GET THE OFFSET FROM "A" OR "a".
ROT CH,-1 ;GET TABLE OFFSET.
SKIPL CH ;ODD LETTER OF THE ALPHABET?
SKIPA AC,COMTAB-1(CH) ;NO. USE RIGHT-HALF OF TABLE ENTRY.
HLRZ AC,COMTAB-0(CH) ;YES. USE LEFT-HALF OF ENTRY.
HRRZM AC,(PP) ;SAVE COMMAND DISPATCH.
NOCOM==0 ;ILLEGAL COMMANDS TRAP HERE...
TRNN AC,777777 ;VALID COMMAND?
NOCOM1: ERROR ILLCOM ;NO.
HOPP SWALLOW ;SWALLOW THE REST OF THE COMMAND.
EXECL7: TLZ F0,(NUMBER!STRING!LOGICL!NO.INT!CUETTY!IFCMD);CLEAR SOME FLAGS.
PUSHJ PP,@(PP) ;DISPATCH.
CAIN CH,"," ;STOPPED ON A COMMA?
HPSTP EXECL7 ;YES. REPEAT THE COMMAND.
POP PP,AC ;RESTORE PREVIOUS COMMAND NAME.
JRST EXECL4 ;CHECK FOR ERRONEOUS LINE TERMINATION.
SWALLO: TLNE CC,(A) ;HAVE WE FOUND A NON-LETTER YET?
HOP SWALLOW ;NOT YET.
STEP CPOPJ ;YES! SWALLOW THE DELIMITER TOO.
COMTAB: XWD ASK, NOCOM ;AB
XWD ENDLN, DO ;CD
XWD ERASE, FOR ;EF
XWD GO, NOCOM ;GH
XWD IF, NOCOM ;IJ
XWD NOCOM, LIBRA ;KL
XWD MOD, NOCOM ;MN
XWD OPERAT, NOCOM ;OP
XWD QUIT, RET ;QR
XWD SET, TYPE ;ST
XWD NOCOM, NOCOM ;UV
XWD WRITE, EVAL ;WX
XWD NOCOM, NOCOM ;YZ
SUBTTL UUO HANDLER.
IFE PDP-6,<
UUOH.: Z ;JSR HERE FROM .JB41
PUSH PP,UUOH. ;SAVE RETURN.
>;END IFE PDP-6
UUOH: MOVE UA,40 ;PRESET CONTENTS OF UA.
LDB AA,[POINT 9,UA,8] ;INDEX DISPATCH TABLE ENTRY.
JRSTF @UUOTAB-1(AA) ;CLEAR FLAGS AND DISPATCH.
DEFINE X(A,B,C) <
IFG C,<XWD 0,U'A>
>;END DEFINE X(A,B,C)
UUOTAB: UUOLIST
IFE UUOTAB+1-.,<
;E.G. PDP-6 SINGLE PRECISION VERSION.
RELOC UUOH+1 ;SAVE TIME AND SPACE.
JRST UERROR ;IF ONLY ONE UUO.
>;END IFE UUOTAB+1-.
;UUO'S - GLIDE, HOP, STEP, HPSTP, GLIDEP, HOPP, STEPP, HPSTPP
IFE PDP-6,<
UHPSTP: TLO UA,(2,) ;PDP-6 HPSTP & HPSTPP ENTER HERE.
>;END IFE PDP-6
UHOP: ILDB CH,PNTR ;HOP OVER THIS CHARACTER.
JUMPL F0,UGLIDE ;CAN WE EXAMINE ?'S OR DEBFLG?
CAIN CH,"?" ;YES. IS THIS A "?"?
TLCA F0,(DEBFLG) ; YES. DON'T PRINT THE "?".
TLNN F0,(DEBFLG) ; NO. ARE WE PRINTING?
JRST UGLIDE ; NO.
OUTCHR CH ;PRINT THE CHARACTER.
IFE PDP-6,<
SKIPA
USTEP: TLO UA,(2,) ;PRESET STEP SECTION.
>;END IFE PDP-6
UGLIDE: MOVE AA,PNTR ;DO THIS SO DON'T INCREMENT.
ILDB CH,AA ;GET ANSWER.
CAIN CH,"?" ;NO. IS IT A Q.M.?
JUMPGE F0,UHOP ;YES. DON'T EXIT WITH ? UNLESS IT'S DATA
TLNN UA,(2,) ;STEP SECTION?
JRST UGLID1 ;NO. GO SET UP CC AND RETURN
CAIG CH," " ;CONTROL CHAR OR SPACE?
JUMPN CH,UHOP ;YES. LOOK FOR ANOTHER.
;HERE TO SET UP CC.
UGLID1: SETZM CC ;CLEAR CC IN CASE NO TABLE ENTRY.
SUBI CH,"(" ;IS THERE A TABLE ENTRY?
JUMPL CH,UGLID2 ;NO.
IDIVI CH,NBYTES ;GET INDEX + REMAINDER.
MOVE CH,BYTAB(CH) ;GET ENTRY FROM INDEX.
IMULI CC,NBITS ;GET POSITION OF BITS IN WORD.
LSHC CH,-44(CC) ;PUT BITS INTO CC.
UGLID2: LDB CH,AA ;RESTORE CH.
IFN PDP-6,<
TLNN UA,(1,) ;GLIDEP, HOPP, STEPP OR HPSTPP?
ADJSP PP,-1 ;NO. DON'T RETURN.
>;END IFN PDP-6
JRST (UA) ;RETURN.
NBYTES==^D36/NBITS ;BYTES OF BITS PER TABLE WORD.
DEFINE BYTES (VALUE,FLAGS,NUMBER)<
IFL VALUE-XX,PX BYTAB ERROR VALUE
REPEAT VALUE-XX,<X 0>
REPEAT NUMBER,<X FLAGS>
>;END DEFINE BYTES (VALUE,FLAGS,NUMBER)
DEFINE X(FLAGS)<
XXX=XXX!<<FLAGS>_<-NBITS*XXXX>>
XXXX==XXXX+1
IFE XXXX-NBYTES,<
EXP XXX
XXX==0
XXXX==0
>;END IFE XXXX-NBYTES
XX==XX+1
>;END DEFINE X(FLAGS)
XXX==0
XXXX==0
XX==<"(">
BYTAB: BYTES <"(">,LP,1
BYTES <")">,RP,1
BYTES <".">,N,1
BYTES <"0">,AN!N,^D10
BYTES 74,LP,1;"<"
BYTES 76,RP,1;">"
BYTES <"A">,AN!A,4
BYTES <"E">,A!E,1
BYTES <"F">,AN!A,^D21
BYTES <"[">,LP,1
BYTES <"]">,RP,1
BYTES <"a">,AN!A,4
BYTES <"e">,A!E,1
BYTES <"f">,AN!A,^D21
BYTES 177,0,1
IFN XXXX-NBYTES,<EXP XXX>
IFG XPV,<
;DOUBLE-PRECISION UUO HANDLER.
IFN KI+KL-10,<
UMOVE: MOVE AC,(UA) ;HIGH ORDER PART
MOVE MQ,1(UA) ;LOW ORDER PART
POPJ PP, ;RETURN
UMOVEM: MOVEM AC,(UA) ;HIGH ORDER PART
MOVEM MQ,1(UA) ;LOW ORDER PART
POPJ PP, ;RESTORE & RETURN.
UEXCH: EXCH AC,(UA) ;HIGH ORDER PART.
EXCH MQ,1(UA) ;LOW ORDER PART.
POPJ PP, ;RESTORE AND RETURN.
>;END IFN KI+KL-10
UPUSH: POP PP,AA ;SAVE RETURN ADDRESS
PUSH PP,(UA) ;NO. MUST BE DPUSH
PUSH PP,1(UA) ;LOW ORDER
JRST @AA ;RETURN
>;END IFG XPV
;CHARACTER-INPUT ROUTINE.
UINCHR: SKIPN AA,INCHN ;TELETYPE INPUT?
JRST UINCH2 ;YES.
IMULI AA,WPC ;GET INDEX TO BUFFER HEADER.
SOSG HEDTAB+2(AA) ;BUFFER EMPTY?
JRST UINCH3 ;YES.
UINCH: ILDB AA,HEDTAB+1(AA) ;GET CHARACTER.
UINCH0: JUMPE AA,UINCHR ;IGNORE NULL CHARACTERS.
MOVEM AA,(UA) ;STORE WHERE REQUESTED.
POPJ PP, ;RETURN.
;HERE IF TELETYPE INPUT.
UINCH2: INCHRW AA ;ACCEPT A KEYBOARD CHARACTER.
CAIE AA,32 ;WAS IT A CONTROL-Z?
JRST UINCH0 ;NO. RETURN.
JRST STOP ;YES. RELEASE AND EXIT.
;HERE TO RE-FILL AN INPUT BUFFER.
UINCH3: MOVE PC,INCHN ;GET CHANNEL NUMBER
LSH PC,27 ;IN ACCUMULATOR FIELD,
TLO PC,(IN) ;TO MAKE AN 'IN' INSTRUCTION,
XCT PC ;WHICH WE CAN THEN EXECUTE.
JRST UINCH ;FILLED OK.
HRRI PC,PC ;RESULTS OF GETSTS IN PC.
TLC PC,(<GETSTS>^!<IN>) ;GETSTS.XOR.IN
XCT PC ;EXECUTE GETSTS UUO.
TRZN PC,EOF ;END OF FILE?
ERRORR INPERR(PC) ;NO. MUST HAVE BEEN ERRORS.
SETOM (UA) ;YES. END-OF-FILE.
POPJ PP, ;RETURN FROM UUO.
;OUTPUT ROUTINES.
;SUBROUTINE TO OUTPUT A CHARACTER TO THE OUTPUT FILE OR LIBRARY SAVE FILE.
;THE CHARACTER MUST BE IN UA, THEN COME HERE WITH A PUSHJ.
UOUTCH: JSP PC,UOUTI ;TELETYPE OUTPUT?
OUTCHR UA ;YES.
UOUTC1: SOSG HEDTAB+2(AA) ;NO. BUFFER FULL?
PUSHJ PP,UOUTC2 ;YES.
IDPB UA,HEDTAB+1(AA) ;DEPOSIT CHARACTER.
POPJ PP, ;RETURN.
;HERE TO EMPTY A BUFFER.
UOUTC2: MOVE PC,OUTCHN ;GET CHANNEL NUMBER
LSH PC,27 ;IN ACCUMULATOR FIELD,
TLO PC,(OUT) ;TO MAKE AN 'OUT' INSTRUCTION,
XCT PC ;WHICH WE CAN THEN EXECUTE.
POPJ PP, ;FILLED OK.
HRRI PC,PC ;GETSTS WILL PUT STATUS IN PC.
TLC PC,(<GETSTS>^!<OUT>) ;GETSTS.XOR.OUT
XCT PC ;EXECUTE GETSTS UUO.
ERRORR OUTERR(PC) ;ERROR ON OUTPUT.
;HERE TO OUTPUT A STRING TO THE OUTPUT FILE OR LIBRA SAVE FILE.
UOUTST: JSP PC,UOUTI ;TELETYPE OUTPUT?
OUTSTR (UA) ;YES.
HRLI UA,(POINT 7,,) ;NO. MAKE A POINTER WORD
MOVEM UA,40 ;WHERE IT CAN BE USED.
OUTST1: ILDB UA,40 ;GET NEXT CHARACTER OF STRING.
JUMPE UA,CPOPJ ;TERMINATING NULL? YES.
PUSHJ PP,UOUTC1 ;OUTPUT A CHARACTER.
JRST OUTST1 ;LOOP TO COMPLETE.
;HERE TO SET BUFFER HEADER INDEX INTO AA UNLESS ASK COMMAND OR TTY OUTPUT.
;IN WHICH CASE EXECUTE TTCALL UUO OR MERELY POPJ.
UOUTI: TLNE F0,(CUETTY) ;ASK MODIFY OR LINE-INPUT?
SKIPA AA,INCHN ;YES. ONLY OUTPUT IF TTY IS INPUT.
SKIPA AA,OUTCHN ;NO. GET OUTPUT CHANNEL NUMBER.
JUMPN AA,CPOPJ ;ASK MODIFY OR LINE-INPUT - DONE IF INPUT NOT TTY.
IMULI AA,WPC ;GET INDEX TO BUFFER HEADER.
JUMPN AA,1(PC) ;NOT ASK COMMAND - NORMAL OUTPUT IF NOT TTY.
XCT 0(PC) ;EXECUTE TTCALL UUO.
POPJ PP,
;ERROR UUO
UERROR: PUSH PP,AC ;SAVE AC.
PUSH PP,MQ ;SAVE MQ.
PUSH PP,OUTCHN ;SAVE IN CASE NON-FATAL.
SETZB MQ,OUTCHN ;FLAG FATAL ("?") & PUT ERROR MESSAGES ON TTY.
HRRZI AA,UERR7 ;GET FATAL RETURN-ADDRESS.
TRZN UA,F ;FATAL ERROR?
AOSA MQ ;NO.
HRRM AA,-3(PP) ;YES. MAKE IT RETURN TO START.
TRNE F0,ERRSUP ;SUPPRESS MESSAGE?
JUMPN MQ,UERR6 ;YES.
SKPINC ;AWAKEN TELETYPE OUTPUT IF ASLEEP.
JFCL ;AND IGNORE THE NON-SKIP RETURN.
OUTSTR UERR9(MQ) ;TYPE CARRIAGE-RETURN-LINE-FEED AND ? OR %
LDB MQ,[POINT 4,UA,26] ;GET MESSAGE NUMBER TIMES TWO.
MOVE MQ,ERRTAB(MQ) ;ASSUME IT WAS AN ODD NUMBERED MESSAGE
TRZN UA,1B27 ;WAS IT?
MOVSS MQ ;NO. GET MESSAGE ADDRESS.
OUTSTR 0(MQ) ;PRINT ERROR MESSAGE.
TLZE UA,(Y) ;WANT " error " TYPED?
OUTSTR UERR8 ;YES.
TRZN UA,M ;IS A MONITOR CODE VALID?
JRST UERR1 ;NO.
HRRZM UA,AC ;SAVE ERROR CODE.
ANDI AC,760077 ;RESTRICT TYPE-OUT IN SIZE.
MOVEI AA,8 ;OCTAL
PUSHJ PP,TYPIN1 ;PRINT A TWO-FIGURE NUMBER.
UERR1: MOVE AC,THISLN ;GET LINE OF EXECUTION.
SKIPN MQ,THISPT ;IN WHICH CASE USE THISPT.
JRST UERR6 ;AVOID THE CASE WHERE NO THISPT IS SET UP.
PUSHJ PP,TYPLIN ;TYPE LINE NUMBER AND CONTENTS.
SETZM AC ;INITIALIZE COUNTER.
UERR2: CAMN MQ,PNTR ;POINTER-MATCH YET?
JRST UERR3 ;YES. MARK IT.
ILDB AA,MQ ;FOLLOWED BY CHARACTERS
CAIN AA," " ;TAB?
TROA AC,7 ;YES. COUNT TO TAB POSITION.
CAIL AA,40 ;NO. PRINTING CHAR?
AOS AC ;YES.
JUMPN AA,UERR2 ;UNTIL END OF LINE
JRST UERR6 ;AVOID CASE WHERE NO MATCH WAS FOUND
UERR3: SKIPE THISLN ;LINE NUMBER TYPED OUT ABOVE?
OUTCH " " ;YES. ALIGN OURSELVES UNDERNEATH.
JUMPE AC,UERR5 ;POINTER AT BEGINNING OF LINE?
UERR4: OUTCH " " ;NO. SPACE ACROSS TO IT.
SOJG AC,UERR4 ;COUNT UNTIL TIME TO DO "^".
UERR5: OUTCH "^" ;PRINT "^" BELOW ERROR.
OUTST CRLF ;THEN END OF LINE.
UERR6: AOS .JBERR## ;INCREMENT ERROR COUNT.
POP PP,OUTCHN ;RESTORE OUTPUT CHANNEL.
POP PP,MQ ;RESTORE MQ.
JRST TPOPJ ;RETURN IF NON-FATAL.
UERR8: ASCIZ " error "
UERR9: ASCIZ "?
?"
ASCIZ "%
%"
DEFINE X(ERNAME,FLAGS,TEXT) <
IFE XXX&1,<
DEFINE XX(XXX) <
XWD [ASCIZ "TEXT"],XXX
>;END DEFINE XX(XXX)
>;END IFE XXX&1
IFN XXX&1,<
XX [ASCIZ "TEXT"]
>;END IFN XXX&1
XXX=XXX+1
>;END DEFINE X(ERNAME,FLAGS,TEXT)
XXX=0
ERRTAB: ERRLIST
IFN XXX&1,<XX 0>
SUBTTL TRAP HANDLER FOR FLOATING OVERFLOW, UNDERFLOW OR DIVIDE CHECK
FOVANS: TLZA PC,(FXU) ;HERE TO GIVE FOV ANSWER.
FXUANS: TLO PC,(FXU!FOV) ;HERE TO GIVE FXU ANSWER.
IFE KI-10,<IFL MONITOR-5.06,<TLO PC,(FOV)>>;SATISFY KI-10 THAT IT'S TRUE.
HRRI PC,ABS+1 ;POINT TO AN INSTRUCTION LIKE FADL
MOVEM PC,.JBTPC## ;PRETEND WE CAME FROM THERE.
TRAP.H:IFG XPV,<
IFE KA-10,<
HRRZ PC,.JBTPC## ;GET TRAP ADDRESS
CAIG PC,DFAEND ;INSIDE UUO HANDLER?
CAIG PC,DFABEG ;INSIDE UUO HANDLER?
JRST TRAP01 ;NO.
HRRI PC,ABS+1 ;YES. PRETEND LIKE FADL.
HRRM PC,.JBTPC## ;AND POPJ.
TRAP01:
>;END IFE KA-10
>;END TRAP.H:IFG XPV
HLLZ PC,.JBTPC## ;GET TRAP FLAGS.
IFE KI-10,<
IFL MONITOR-5.06,<
TLNN PC,(FOV) ;ARITHMETIC OVERFLOW FROM KI-10?
JRST TRPXIT ;YES. ONLY COME HERE FOR KI-10.
>;END IFL MONITOR-5.06
>;END IFE KI-10
PUSH PP,UA ;SAVE UA FOR ERROR UUO.
PUSH PP,AA ;SAVE AA FOR ERROR UUO.
TLNN PC,(FXU) ;OVERFLOW?
MOVEI PC,FOVERR-FXUERR ;YES!
SKIPN FOVSUP ;ARE ERROR MESSAGES SUPPRESSED?
ERROR FXUERR(PC) ;NO. UNDERFLOW.
MOVE PC,.JBTPC## ;RESTORE PC.
HRLOI AA,377777 ;STORE INFINITY FOR OVERFLOW.
TLNE PC,(FXU) ;UNDERFLOW?
SETZM AA ;YES. CLEAR ANSWER.
LDB PC,[POINT 4,-1(PC),12] ;PICK THE INSTRUCTION'S ACCUMULATOR.
MOVEM AA,(PC) ;STORE TO ACCUMULATOR.
IFG XPV,<
IFE KA-10,TLZ AA,033000 ;FIDDLE LOW ORDER KA-10 WORD.
MOVEM AA,1(PC) ;STORE TO ACCUM+1.
>;END IFG XPV
POP PP,AA ;RESTORE AA.
POP PP,UA ;AND UA.
TRPXIT: HRRZ PC,.JBTPC## ;CLEAR FLAGS.
JRSTF @PC ;RETURN. -- PDP-6 REQUIRES @ NOT ().
SUBTTL GUTS
COMMENT \
THE FOLLOWING RULES WILL APPLY TO EACH ROUTINE IN THE GUTS SECTION:
ON ENTRY, THE EXECUTION POINTERS F0,CH,PNTR ARE SET UP FOR
THE FIRST NON-BLANK AFTER THE COMMAND NAME.
ALL ACCUMULATORS MAY BE USED WITHOUT RESTORING THEM.
ON EXIT, THE EXECUTION POINTERS MUST POINT TO THE FIRST NON-BLANK NOT
YET EXECUTED (NORMALLY CR OR SC). THIS CAN USUALLY BE ACCOMPLISHED
BY USING STEP CPOPJ.
\
;RETURN STATEMENT.
RET: MOVEI AC,777776 ;PICK HIGHEST POSSIBLE LINE NUMBER
HRRM AC,LINNUM ;AND PRETEND THAT'S WHERE WE'VE BEEN.
IFLOG: JUMPL AC,CPOPJ ;COME HERE AFTER A LOGICAL IF.
;COMMENT OR CONTINUE STATEMENT.
ENDLN: JUMPE CH,CPOPJ ;WAIT FOR END OF LINE.
HPSTP ENDLN ;KEEP LOOKING.
;GO STATEMENT.
GO: CAIE CH,";" ;GO WITH NULL ARGUMENT?
JUMPN CH,GO1 ;(OTHERWISE IT'S "DO ALL")
PUSHJ PP,ENDLN ;IGNORE COMMENTS AFTER COMMAND.
;DO STATEMENT.
DO: JSPPC LIMSET ;READ ARGUMENT, SET LUPARG,LINNUM
;DO NOT RETURN HERE IF NOTHING TO DO.
JRST EXECL. ;EXECUTE ONE LINE - RETURN TO LIMNXT.
;ERASE STATEMENT.
ERASE: JUMPGE CC,CLRVAR ;ERASE VALUES IF NO ARGUMENT.
JSPPC LIMSET ;READ ARGUMENT, SET LUPARG,LINNUM
JRST DELINE ;ERASE ONE LINE - RETURN TO LIMNXT.
;FOR STATEMENT.
FOR: TLO F0,(NUMBER) ;FORCE A NUMERIC-ONLY SET.
PUSHJ PP,SET ;HANDLE UP TO FIRST ARGUMENT.
;RETURN WITH T3/ SYMBOL TABLE INDEX.
CAIE CH,"," ;ANY MORE ARGUMENTS?
POPJ PP, ;NO. HANDLE AS SPECIFIED.
PUSH PP,FORFLAG ;SAVE STATUS.
HRRO AC,LINNUM ;GET CURRENT LINE NUMBER.
MOVEM AC,FORFLAG ;SAY "WE ARE IN A 'FOR'."
PUSH PP,T2 ;SAVE SYMBOL.
DPUSH PP,ONE ;SAVE DEFAULT INCREMENT.
HPSTPP EVALN ;GET NEXT NUMERIC ARGUMENT.
CAIE CH,"," ;THIRD ARGUMENT?
JRST FOR1 ;NO.
DMOVEM AC,-XPV(PP) ;YES. LAST MUST HAVE BEEN SECOND.
HPSTPP EVALN ;GET REAL THIRD.
FOR1: DPUSH PP,AC ;SAVE FINAL VALUE.
FOR2: JSP PC,DUPLIC ;REPLICATE CURRENT LINNUM & PNTR.
HRRZ AC,LINNUM ;SET UP AC TO SAVE LINNUM.
MOVE MQ,THISPT ;SET UP MQ TO SAVE THISPT.
PUSHJ PP,EXECL1 ;EXECUTE REMAINDER OF LINE.
POP PP,PNTR ;RESTORE POINTER TO MID-LINE.
POP PP,LINNUM ;RESTORE PP STACK.
MOVE T2,-<WPV*2>(PP) ;RETRIEVE SYMBOL.
DMOVE AC,-2*WPV+1(PP) ;RETRIEVE INCREMENT.
JSP PC,FINDSYMBOL ;SEARCH SYMBOL TABLE.
JRST FOR3 ;ABORT FOR IF SYMBOLS DESTROYED.
DFAD AC,@T3 ;UPDATE.
DMOVEM AC,@T3 ;UPDATE.
DFSB AC,-XPV(PP) ;COMPARE VARIABLE WITH 3RD ARG
SKIPGE -2*WPV+1(PP) ;NEGATIVE INCREMENT?
MOVNS AC ;YES. REVERSE COMPARISON.
JUMPLE AC,FOR2 ;RE-CYCLE TO MORE EXECUTION.
FOR3: ADJSP PP,-WPV*2-1 ;RESTORE PP.
POP PP,FORFLAG ;RESTORE 'FOR' STATUS.
POPJ PP, ;RETURN.
;NOTE: WE EXIT WITH PNTR IN MIDDLE OF LINE BUT CC,CH AT AN EOL.
;THIS SHOULD NOT CAUSE SERIOUS PROBLEMS EXCEPT AT LIBCL2:.
;DIRECT TRANSFER.
GO1: CAIE CH,"T" ;"GO TO" - CHECK SPELLING, AT LEAST FIRST CH
CAIN CH,"t" ;OR LOWER CASE T.
PUSHJ PP,SYMB ;READ IT IN WHATEVER IT IS.
GO2: PUSHJ PP,GETLN ;PICK UP ARGUMENT.
PUSHJ PP,FINDLN ;FIND THE LINE IN THE TEXT.
ERROR NOLINE ;NOT FOUND.
ADJSP PP,-2 ;REMOVE ITEMS PUSHED BY EXECLN ROUTINE.
HRRO T4,LINNUM ;GET CURRENT LINE
TRNE T4,777777 ;IMMEDIATE MODE OR LIBRA CALL?
JRST GO4 ;NO.
PUSHJ PP,ENDLN ;MOVE PNTR TO END OF LINE.
POP PP,THISLN ;RESTORE PREVIOUS LINE NUMBER
POP PP,THISPT ;RESTORE PREVIOUS POINTER
POP PP,LINNUM ;RESTORE LINKAGE.
DMOVEM AC,T2 ;SAVE OBJECT LINE NUMBER.
IFE XPV,<MOVEM MQ,T3> ;SAVE OBJECT LINE POINTER.
CAME T4,FORFLAG ;FOR...GOTO ON SAME LINE?
SETZM AC ;NO. MAKE IT "DO ALL".
JSPPC LIMSE2 ;YES. DUMMY UP PRIOR "DO ALL".
MOVE MQ,T3 ;RESTORE OBJECT LINE POINTER.
HRRM T2,LINNUM ;OVERWRITE OLD NUMBER.
MOVE PC,GO3 ;PREPARE FOR A DO LOOP.
MOVEM PC,-1(PP) ;PUT THE REPEAT SPOT ON THE STACK.
GO3: JRST EXECL. ;EXECUTE LINE.
GO4: HRRM AC,LINNUM ;OVERWRITE OLD NUMBER.
MOVEM MQ,PNTR ;SET FOR EXECUTION.
JRST EXECL2 ;GO DO IT.
;IF COMMAND.
IF: TLO F0,(IFCMD) ;FLAG THAT IT'S AN IF COMMAND.
PUSHJ PP,EVAL ;GET NUMERIC OR LOGICAL VALUE.
TLNE F0,(STRING) ;STRING?
ERROR SYNTAX ;THAT'S ILLEGAL.
TLNE F0,(LOGICL) ;WAS IT A LOGICAL-IF?
JRST IFLOG ;YES.
JUMPL AC,GO2 ;IF LESS, GOTO.
PUSHJ PP,IFSKIP ;SKIP OVER LINE NUMBER.
JUMPE AC,GO2 ;IF EQUAL, GOTO.
PUSHJ PP,IFSKIP ;SKIP OVER LINE NUMBER.
JRST GO2 ;MUST BE GREATER.
IFSKIP: TLNE CC,(N) ;PASS OVER LINE NUMBER, EVEN IF IT IS ILLEGAL
HOP IFSKIP ;MOVE OVER ONE CHAR.
STEP .+1 ;PASS TRAILING SPACES.
CAIN CH,"," ;COMMA?
HPSTP CPOPJ ;YES. SKIP IT AND CONTINUE.
JRST APOPJ ;RETURN TWO LEVELS.
;SET STATEMENT.
;THIS ROUTINE IS ALSO CALLED BY THE 'FOR' ROUTINE, FOR WHICH AN ARGUMENT
;IS RETURNED IN T2, NAMELY THE SYMBOL NAME.
SET: PUSHJ PP,SYMBOL ;GET SYMBOL & SUBSCRIPT INTO T2.
CAIE CH,"=" ;CHECK.
SYNERR: ERROR SYNTAX ;UH!
HPSTPP EVAL ;GET VALUE INTO AC,MQ.
SET1: JSP PC,FINDSYMBOL ;SCAN THE SYMBOL TABLE TO MATCH THE NAME.
SKIPA ;NO MATCH.
JRST SET4 ;FOUND A MATCH.
TLNN F0,(IFCMD) ;AN IF COMMAND?
JUMPE AC,CPOPJ ;NO. PRESUMABLY SET. DON'T STORE A NEW NULL VALUE.
PUSHJ PP,FIT ;WILL A NEW SYMBOL FIT IN CORE?
MOVNI AA,WPV*2 ;GET MODIFICATION.
ADDM AA,SYMTBL ;MODIFY IT BACK.
HRRI PC,@SYMTBL ;GET BOTTOM OF SYMBOL TABLE.
HRLI PC,WPV*2(PC) ;FIND LOWEST USEFUL WORD.
HRRI UA,@T3 ;FIND HIGHEST WORD TO SHIFT.
BLT PC,-WPV*2(UA) ;SHIFT PART OF SYMBOL TABLE.
MOVEM T2,@T3 ;STORE THE NAME.
SUBI T3,WPV ;POINT TO THE DATA.
SET4: JUMPL T2,SET6 ;ARE WE STORING A STRING VALUE?
PUSH PP,BUFH ;YES. MAKE SPACE.
MOVEI AC,1(MQ) ;FIRST FIND THE LENGTH OF THE STRING.
SUBI AC,@BUFH ;WHICH STARTS AT WHERE BUFH POINTS.
ADDM AC,BUFH ;COVER THE SOURCE DATA.
ADDM AC,BUFH ;COVER THE NEW SPACE NEEDED.
PUSHJ PP,FIT ;ENSURE THERE IS SPACE AVAILABLE.
POP PP,BUFH ;RESTORE BUFH.
MOVNS AC ;GET NUMBER OF WORDS TO MOVE IN NEG. FORM.
HRLI AA,@SYMTBL ;SOURCE FOR BLOCK TRANSFER.
ADDM AC,SYMTBL ;MAKE NEW LOW LIMIT.
ADDM AC,T3 ;THE SLOT WILL MOVE TOO.
HRRI AA,@SYMTBL ;DESTINATION FOR BLOCK TRANSFER.
ADDB AC,SYMTBC ;AND NEW HIGH LIMIT.
BLT AA,@AC ;MOVE SYMBOL TABLE TO MAKE SPACE FOR STRING
MOVE PC,BUFH ;GET SOURCE POINTER.
MOVE UA,AC ;GET DESTINATION POINTER.
SET5: CAMN PC,MQ ;LAST CHARACTER YET?
TDZA AA,AA ;YES. DEPOSIT A NULL.
ILDB AA,PC ;NO. PICK UP A BYTE.
IDPB AA,UA ;DEPOSIT IT.
JUMPN AA,SET5 ;CONTINUE UNTIL A NULL IS FOUND.
SET6: DMOVEM AC,@T3 ;DEPOSIT NEW VALUE IN TABLE.
POPJ PP, ;RETURN.
;ASK STATEMENT.
ASK: TLOA F0,(CUETTY) ;FLAG FOR DIRECTING OUTPUT.
;TYPE STATEMENT.
TYPE: TDZA T2,T2 ;INDEX TO OUTCHN.
MOVEI T2,1 ;INDEX TO INCHN.
TLZ F0,(NUMBER!STRING) ;ALLOW CASES LIKE TYPE FOO"HELLO"
JUMPE CH,CPOPJ ;PREVENT INDEXING TYPDSP BY ZERO.
PUSH PP,-1(PP) ;SET TO LOOP FOR CASES LIKE TYPE !!!
IFGE SIZE,< ;IF ENOUGH CORE ...
CAILE CH,43 ;AVOID DISPATCH FOR ASK %, ASK $.
JUMPN T2,TYP1 ;(ASK WILL JUMP)
>;END IFGE SIZE
CAIG CH,45 ;SELECT !"#$%
XCT TYPDSP-41(CH) ;FOR A DIRECT DISPATCH.
TYP1: CAIN CH,"'" ;FIRST SINGLE QUOTE?
HOP TYPE1S ;YES.
CAIE CH,"/" ;CHANNEL SELECTION?
JRST TYPE4 ;NO.
HPSTPP GETLN ;GET CHANNEL NUMBER.
LSH AC,-7 ;MAKE IT AN INTEGER.
CAIG AC,17 ;CHECK CHANNEL BUT REMEMBER MQ IS ZERO.
MOVE MQ,BUFTAB(AC) ;GET I/O INDICATOR WORD.
SKIPN T2 ;TYPE?
MOVNS MQ ;YES. SHOULD MAKE IT POSITIVE.
SKIPE AC ;CHANNEL ZERO IS TTY:.
JUMPLE MQ,TYPERR ;WRONG IF NO CHANNEL SELECTED.
;OR WRONG MODE SELECTED.
MOVEM AC,OUTCHN(T2) ;SAVE NEW SELECTION OF CHANNEL.
STEP CPOPJ ;RETURN.
TYPERR: ERROR CHNERR ;WRONG SELECTION.
STEP CPOPJ ;(WARNING MESSAGE ONLY.)
TYPDSP: HPSTP TLFPPJ ;! PRINT CRLF.
JUMPG T2,TYPE1A ;" ASK: PRINT TEXT. TYPE: PRINT STRING EXP.
HPSTP TYPE3 ;# PRINT CR ONLY.
HPSTP TYPE6 ;$ PRINT SYMBOL TABLE.
HOP TYPE2 ;% CHANGE FORMAT.
;'
TYPE1S: OUTCH 42 ;PRINT A DOUBLE QUOTE.
;"
TYPE1: TLZ F0,(NO.INT) ;ENABLE DEBUG SENSOR.
JUMPE CH,TPOPJ ;END OF LINE?
CAIN CH,42 ;NO. CLOSING DOUBLE QUOTE?
HPSTP CPOPJ ;YES.
OUTCH 0(CH) ;NO. TYPE THE CHARACTER.
TYPE1A: TLO F0,(NO.INT) ;SUPPRESS DEBUG TYPEOUT.
HOP TYPE1 ;CONTINUE.
;%
TYPE2: TLNE CC,(E) ;%E OR %?
AOJA T2,[HOP .+1
] ;%E. HOP OVER THE "E".
PUSHJ PP,GETLN ;READ SPECIFIED VALUE
SETMAX: MOVEM AC,T3 ;SAVE NEW FIELD WIDTHS.
IDIVI AC,200 ;PUT TOTAL DIGITS IN AC
CAIL AC,^D100 ;LIMIT WIDTH TO 99
JRST TYPE2E ;SO AVOID PDL OV ON TYPE-OUT.
IFL PDC-100,PRINTX %MAY HAVE PROBLEMS TYPING WIDE FORMATS.
MOVE T4,AC ;SAVE # DIGITS TOTAL.
SUB AC,MQ ;SUBTRACT DIGITS RIGHT
JUMPL AC,TYPE2E ;LEGAL SPECIFIER?
JUMPE T2,TYPE2B ;YES. %E?
JUMPE AC,TYPE2E ;YES.
MOVEI T4,1(MQ) ;LEGAL %E - SET F-PART WIDTH.
MOVEI AC,1 ;AND MAX SIZE OF F-PART TYPEOUT.
TYPE2B: MOVEM T3,FORMAT(T2) ;STORE FORMAT OR EORMAT.
IMULI T2,WPV ;MAKE AN INDEX TO FORMAX/EORMAX.
PUSHJ PP,DFLOAT ;COMPUTE APPROXIMATE LOG
DMOVEM AC,FORMAX(T2) ;TO COMPARE WITH VALUES FOR TYPING.
CAIL T4,^D20 ;PREVENT ERROR MESSAGE ...
STEP CPOPJ ;... FOR WIDE FORMATS.
MOVN AC,T4 ;RESTORE DIGITS TOTAL
PUSHJ PP,ANTILI ;GET 10**<-#DIGITS TOTAL>
HALVE ACCUM ;GET ROUNDING FACTOR
NEGATE ACCUM ;TO COMPARE
DFAD AC,ONE ;WITH TOTAL # DIGITS
PUSHJ PP,LOG10 ;FORMAX IS A LOGARITHM
DFAD AC,FORMAX(T2) ;ADD ROUNDING IN.
DMOVEM AC,FORMAX(T2) ;ADD ROUNDING IN.
STEP CPOPJ
TYPE2E: ERROR FRMERR ;NO.
STEP CPOPJ ;IGNORE AN ILLEGAL %E.
TYPE3: OUTCH 15 ;CR.
IFLE MONITOR-3.27,<OUTCH 15> ;ADD FILLER FOR OLD MONITORS.
POPJ PP,
ASK4: TLNN CC,(A) ;VALID SYMBOL FOLLOWING?
JRST TPOPJ ;NO. RETURN.
PUSHJ PP,SYMBOL ;COLLECT SYMBOL & SUBSCRIPT IN T2.
MOVEI UA,":" ;SET CUE CHARACTER.
TRNE F0,COLSUP ;SHOULD IT BE SUPPRESSED?
SETZM UA ;YES.
JSP PC,GETBUF ;READ IN THE NUMBER.
ASK2: CAIN T4,33 ;WAS THE DELIMITER AN ESCAPE?
POPJ PP, ;YES. DO NOT MODIFY VALUE.
JSP PC,NEWTXT ;SET TO POINT TO
XWD LINNUM,AC ;... INPUT DATA.
SKIPGE T2 ;STRING VALUE BEING INPUT?
STEPP GETNM ;NO. COLLECT NUMERIC VALUE.
PUSHJ PP,GETVL2 ;IF IT'S A STRING, COLLECT IT.
JSP PC,OLDTXT ;RESTORE POINTERS.
JRST SET1 ;SET IN VALUE AND RETURN
;TYPE ALL VARIABLES IN ALPHABETICAL ORDER.
TYPE6O: MOVSI T2,(1B0) ;FLAG THAT OCTAL IS REQUIRED.
TYPE6: CAIN CH,"$" ;DOUBLE DOLLAR?
HPSTP TYPE6O ;YES. INCLUDE OCTAL IN COMMENT
MOVEI T3,@SYMTBL ;SET TO BOTTOM OF TABLE.
TYPE60: OUTST CRLF
MOVEI T3,WPV*2(T3) ;MOVE TO NEXT ENTRY.
CAILE T3,@SYMTBC ;ARE THERE MORE ENTRIES?
POPJ PP, ;NO.
OUTST [ ASCIZ "S "] ;FORMAT SO YOU CAN READ IT BACK.
HLLZ AC,@T3 ;SIXBIT SECTION TO LEFT/AC.
TLO AC,(1B0) ;REMOVE THE FLAG BIT.
TYPE61: ROT AC,6 ;GET SIX BITS.
OUTCH 40(AC) ;TYPE IT IN ASCII.
HLLZS AC ;CLEAR RIGHT HALF.
JUMPN AC,TYPE61 ;LOOP UNTIL SYMBOL IS TYPED OUT
SKIPL T4,@T3 ;GET INDEX.
OUTCH "$" ;GET CORRECT NAME IF A STRING NAME.
HRRZ AC,T4 ;GET THE INDEX.
JUMPE AC,TYPE62 ;DON'T PRINT A ZERO INDEX.
OUTCH "(" ;TYPE "(".
PUSHJ PP,TYPINT ;TYPE IT.
OUTCH ")" ;CLOSE OFF THE INDEX FIELD.
TYPE62: OUTCH " " ;SEPARATE SYMBOL FROM VALUE
DMOVE AC,-WPV(T3) ;GET VALUE.
JUMPL T4,TYPE65 ;NUMBER?
OUTST [ ASCIZ /= "/] ;NO. TYPE A STRING EXPRESSION.
SKIPA T5,AC ;SAVE ADDRESS OF STRING.
TYPE63: OUTCH 0(AC) ;OUTPUT A CHARACTER.
TYPE64: ILDB AC,T5 ;GET NEXT CHARACTER OF THE STRING.
JUMPE AC,TYPE68 ;DONE IF WE REACH A NULL.
CAIE AC,42 ;SPECIAL TREATMENT FOR A DOUBLE-QUOTE.
IFL MONITOR-5.05,<CAIL AC,175> ;SPECIAL TREATMENT FOR ALTMODE OR RUBOUT.
IFGE MONITOR-5.05,<CAIL AC,177> ;SPECIAL TREATMENT FOR RUBOUT.
JRST TYPE69 ;SPECIAL TREATMENT.
CAIL AC,40 ;SPECIAL TREATMENT FOR CONTROL CHARACTERS
JRST TYPE63 ;OTHERWISE ITS STRING CHARACTER EQUIVALENT
TYPE69: OUTST [ ASCIZ /"+FCHR$(/] ;TERMINATE THE CONSTANT.
PUSHJ PP,TYPINT ;TYPE ITS VALUE.
OUTST [ ASCIZ /)+"/] ;TERMINATE THE FUNCTION.
JRST TYPE64 ;CONTINUE THE STRING CONSTANT.
TYPE65: PUSHJ PP,TYPNUM ;TYPE IT.
JUMPGE T2,TYPE60 ;OCTAL COMMENTS? NO.
DMOVE AC,-WPV(T3) ;YES. TYPE OCTAL AS WELL.
OUTST <[ASCIZ " ;C "]> ;APPEND OCTAL TO THE LINE.
MOVE T4,[POINT 3,AC] ;SET UP PICKING POINTER.
TYPE66: MOVEI T6,^D12 ;12 OCTAL DIGITS PER WORD.
TYPE67: ILDB T5,T4 ;PICK ONE OCTAL DIGIT.
OUTCH "0"(T5) ;PRINT IT.
SOJG T6,TYPE67 ;FINISH THE WORD.
IFE XPV<JRST TYPE60> ;THEN WE ARE DONE IF SINGLE PRECISION
IFG XPV,<
HRRZI T6,-AC-XPV(T4) ;LOOK AT THE POINTER.
JUMPE T6,TYPE60 ;FINISHED ALL WORDS?
OUTCH " " ;NO. SPACE ACROSS.
JRST TYPE66 ;AND DO ANOTHER WORD.
>;END IFG XPV
TYPE68: OUTCH 42 ;TYPE CLOSING DOUBLE-QUOTE.
JRST TYPE60 ;CONTINUE SYMBOL-TABLE TYPE-OUT.
TYPE4: JUMPN T2,ASK4 ;ASK? YES.
MOVE T3,PNTR ;SAVE THE PLACE.
PUSHJ PP,EVAL ;EVALUATE EXPRESSION.
CAMN T3,PNTR ;DID WE EVALUATE ANYTHING?
JUMPE AC,TPOPJ ;ANYTHING OF VALUE?
TLZN F0,(STRING) ;DID WE EVALUATE A STRING?
JRST TYPE42 ;NO. A NUMBER.
MOVE AC,BUFH ;GET BEGINNING.
TYPE41: CAMN AC,MQ ;LAST CHARACTER?
POPJ PP, ;YES.
ILDB T3,AC ;NO. GET NEXT CHARACTER.
OUTCH 0(T3) ;OUTPUT IT.
JRST TYPE41 ;CONTINUE.
TYPE42: TRNN F0,EQUSUP ;PROVIDED IT IS NOT BEING SUPPRESSED.
TYPNUM: OUTCH "=" ;TYPE "=".
JSPPC PROT26 ;PROTECT T2-T6
MOVNI T5,1 ;SET OUR MINDS THAT IT WILL BE F-FORMAT.
DMOVEM AC,TEMPT ;SAVE THE VALUE.
SKIPE AC ;DON'T GET LOG IF ZERO
PUSHJ PP,LOG10 ;GET LOG TO BASE TEN.
DFMP AC,TYPN1D ;ENSURE ROUNDING ERRORS ARE ALL +VE
IFG XPV,<CAMN AC,FORMAX> ;WILL NUMBER FIT THE SPACE?
IFG XPV,<CAML MQ,FORMAX+1> ;IF A NEAR GO, COMPARE LOW ORDER WORDS
CAMGE AC,FORMAX ;WILL THE NUMBER FIT THE SPACE?
SKIPN FORMAT ;YES. IS F-FORMAT REQUESTED?
SETZM T5 ;NO. SET INDEX AND FLAG FOR E-FORMAT.
MOVE T3,EORMAT(T5) ;GET FORMAT SPECS.
IDIVI T3,200 ;SEPARATE THESE SPECS.
JUMPL T5,TYPN3 ;E-FORMAT?
PUSH PP,AC ;SAVE LOG10 OF THE VALUE.
DFSB AC,EORMAX ;YES. FIND THE EXPONENT.
PUSHJ PP,FIX ;AS INTEGER. (EORMAX IS BETWEEN 0 AND 1)
POP PP,AC ;RESTORE LOG10 OF THE VALUE.
AOS T6,MQ ;(IN FACT EORMAX IS NEARLY =1).
SUBM T4,T6 ;GET DECIMAL PLACE OF F-PART.
TROA T5,(MQ) ;SAVE EXPONENT IN CASE E-FORMAT
TYPN3: MOVE T6,T4 ;GET # DIGITS RIGHT.
FSBR AC,[EXP LGMNSZ] ;GET LOG10(VALUE) - LOG10(MANTISSA-SIZE)
PUSHJ PP,FIX ;AS AN INTEGER TRUNCATED.
ADD MQ,T6 ;ADD THE SCALING FACTOR # OF DIGITS
MOVE T2,T6 ;GET THE SCALING FACTOR # OF DIGITS
SKIPLE T6,MQ ;GET SIZE OF ADJUSTED VALUE
SUB T2,T6 ;OR MAXIMUM IF LOW-ORDER-ZEROES.
DMOVE AC,TEMPT ;GET ORIGINAL NUMBER TO BE TYPED.
PUSHJ PP,[DPUSH PP,TEN ;MULTIPLY IT BY 10**(T2).
JRST EXP.1] ;RETURN WITH T2 ZERO.
JUMPGE AC,TYPN1 ;POSITIVE?
MOVEI T2,"-" - " " ;NO. TYPE SIGN.
NEGATE ACCUM ;MAKE POSITIVE
TYPN1: PUSHJ PP,RFIX ;AS A DOUBLE-WORD INTEGER.
JUMPL T5,TYPN4 ;AND GO TYPE IT IF IT'S F-FORMAT.
PUSHJ PP,TYPN4 ;OTHERWISE TYPE OUT THE FRACTION, THEN
OUTCH "E" ;TYPE "E"
MOVEI AC,"-" ;SET OUR HEARTS ON NEGATIVE EXPONENT.
TRNN T5,400000 ;IS IT REALLY NEGATIVE?
TRCA AC,6 ;NO. GET "+".
MOVNI T5,(T5) ;YES. GET POSITIVE #.
OUTCH 0(AC) ;TYPE SIGN.
HRRZ AC,T5 ;EXPONENT TO TYPE.
;SUBROUTINE TO TYPE AN INTEGER.
;ARGUMENTS ARE:
;AC/ NUMBER TO BE TYPED.
;AA/ LEFT HALF - MINIMUM # OF DIGITS TYPED OUT -1 - TO GIVE LEADING ZEROES.
; (NOT REQUIRED IF ENTERED AT TYPINT - 1 ASSUMED.)
; RIGHT HALF - RADIX. (NOT REQUIRED IF ENTERED AT TYPINT - DECIMAL ASSUMED.)
TYPINT: SETZM AA ;ENTER HERE TO MAKE MINIMUM ONE DIGIT
TYPIN0: HRRI AA,^D10 ;SET DECIMAL RADIX.
TYPIN1: MOVE UA,AC ;PRESERVE AC.
TYPIN2: IDIVI UA,(AA) ;GET NEXT REMAINDER INTO PC.
TRO PC,"0" ;ENSURE ASCII FIGURES
HRLM PC,(PP) ;SAVE IN LEFT HALF-WORD IN STACK.
SUBI AA,777777 ;SUBTRACT ONE FROM LEFT HALF.
SOSG AA ;DECREMENT COUNT OF LEADING ZEROES.
SKIPE UA ;ANY MORE TO DIVIDE?
PUSHJ PP,TYPIN2 ;YES. CONTINUE.
TYPBAK: HLRZ PC,(PP) ;UNLOAD LEFT HALF FROM STACK.
OUTCH 0(PC) ;TYPE IT.
POPJ PP, ;GET NEXT TO TYPE OR ELSE RETURN.
IFN UA-PC+1,PX ACCUMULATOR VALUE CONFLICT AT TYPINT:.
TYPN1D:IFN KA-10,<DATA <<1.0+1-XPV>>,2>
IFE KA-10,<DATA <<1.0+1-XPV>>,1400>
;ROUTINE TO TYPE A FLOATING-POINT NUMBER.
;ENTER AT TYPN4 WITH THE NUMBER IN AC,MQ
; T2/ ASCII SIGN LESS "SPACE".
; T3/ # OF PLACES TOTAL (EXCLUDING DECIMAL POINT AND SIGN)
; T4/ # OF PLACES RIGHT
; T6/ # OF INSIGNIFICANT LOW-ORDER PLACES ("0"-FILL).
TYPN4: SETZM AA ;CLEAR IN CASE "0"-FILL.
SOJGE T6,TYPN6 ;"0"-FILL ON LOW-ORDER PLACES?
MOVEM MQ,AA ;NO. SAVE LOW ORDER PART.
IDIVI AC,^D10 ;DIVIDE HIGH ORDER PART
DIVI MQ,^D10 ;DIVIDE LOW ORDER PART.
JUMPG T4,TYPN6 ;LEFT OF DECIMAL POINT YET?
JUMPG AC,TYPN6 ;YES. HIGH ORDER FINISHED YET?
JUMPG MQ,TYPN6 ;YES. LOW ORDER FINISHED YET?
JUMPG AA,TYPN6 ;YES. LAST DIGIT FINISHED YET?
SKIPE T3 ;YES. LAST FORMAT SPACE?
JUMPE T4,TYPN6 ;NO. BEYOND JUST-LEFT-OF-DECIMAL-POINT?
TRO AA," "(T2) ;YES. PUT SIGN IN IF T2 NON-ZERO.
TDZA T2,T2 ;CLEAR SIGN.
TYPN6: TRO AA,"0" ;ASSURE CHARACTER IS A DIGIT.
HRLM AA,(PP) ;STACK IT UP.
SOSN T4 ;DECREMENT COUNT OF # DIGITS RIGHT
PUSH PP,[XWD ".",TYPBAK] ;INSERT DECIMAL POINT.
SOJL T3,TYPBAK ;DECREMENT COUNT OF # DIGITS TOTAL + SIGN
PUSHJ PP,TYPN4 ;CYCLE FOR MORE
JRST TYPBAK ;TYPE FROM PP LIST THEN RETURN
LIBRA: TRZA CH,40 ;FORCE UPPER CASE TO DISTINGUISH COMMANDS
OPERAT: TRO CH,40 ;FORCE LOWER CASE TO DISTINGUISH COMMANDS
SETZM T2 ;CLEAR A VALIDITY FLAG.
CAIN CH,"C" ;LIBRA CALL?
HRLOI T2,LIBCAL ;YES.
CAIN CH,"S" ;LIBRA SAVE?
HRLZI T2,LIBSAV ;YES.
CAIN CH,"D" ;LIBRA DELETE?
HRLZI T2,LIBDEL ;YES.
CAIN CH,"o" ;OPERATE OUTPUT?
HRLZI T2,OPER.O ;YES.
CAIN CH,"i" ;OPERATE INPUT?
HRLOI T2,OPER.I ;YES.
JUMPE T2,NOCOM1 ;VALID COMMAND?
PUSHJ PP,SWALLOW ;YES. SKIP OVER COMMAND MODIFIER
PUSHJ PP,RCM ;READ A COMMAND STRING
HLRZ PC,T2 ;GET ADDRESS TO GO TO.
ANDI T2,1 ;GET I/O DIRECTION.
JRST 0(PC) ;GO TO ROUTINE.
LIBDEL: MOVE T2,AA ;SAVE DEVICE-CHARACTERISTICS WORD
SETZB AC,AA ;CLEAR I/O MODE; SPEC NO BUFFERS.
OPEN LIBCHN,AC ;TRY TO INIT.
TROA T4,INIERR-LUKERR ;SAY INIT ERROR.
LOOKUP LIBCHN,T3 ;FIND FILE.
MOVEI AA,LUKERR-RENERR(T4) ;SET AA NON-ZERO IF NO FILE FOUND.
IFG MONITOR-3.27,< TLNE T2,(DV.DTA)> ;DECTAPE SPECIFICATION REQUIRES A CLOSE.
CLOSE LIBCHN, ;BUT FOR DISK, DON'T LOSE FILE TO ANOTHER JOB
SKIPN MQ,AA ;THEN SEE IF WE WANT TO RENAME.
RENAME LIBCHN,MQ ;RENAME TO ZERO.
ERRORR RENERR-F(AA) ;CAN'T DELETE FILE.
RELEASE LIBCHN,
POPJ PP,
LIBSAV: PUSH PP,OUTCHN ;SAVE CURRENT OUTCHN.
PUSHJ PP,LIBINI ;INITIALIZE LIBRARY CHANNEL.
MOVE T3,PNTR ;REMEMBER WHERE WE'RE UP TO.
LIBSV0: PUSHJ PP,WRITE ;PRETEND IT WAS A 'WRITE' COMMAND.
CAIN CH,"," ;MORE IN LIST?
HPSTP LIBSV0 ;YES.
CAMN T3,PNTR ;WAS THERE A LIST FOR LIBRA SAVE?
PUSHJ PP,TYPE6O ;NO. WRITE OUT THE SYMBOL TABLE.
SETZM T2 ;RESTORE THE I/O-DIRECTION FLAG.
PUSHJ PP,LIBREL ;RELEASE THE LIBRARY CHANNEL.
POP PP,OUTCHN ;RESTORE OUTCHN.
POPJ PP, ;RETURN.
LIBREL: SETZM AA ;HERE TO RELEASE LIBRARY CHANNEL.
LIBINI: ;HERE TO INIT. LIBRARY CHANNEL.
MOVEI AC,LIBCHN ;SPECIFY LIBRARY CHANNEL.
LIBIN1: SOJA AA,AUTIO4 ;INITIALIZE.
LIBCAL: JSP PC,NEWTXT ;SET UP LINNUM & PNTR
XWD ZERO,BUFH ;TO EXECUTE THIS LINE.
JSP PC,DUPLICATE ;SAVE OLD BUFH.
PUSH PP,INCHN ;SAVE CURRENT INCHN.
PUSHJ PP,LIBINI ;INITIALIZE LIBRARY CHANNEL.
;BEWARE OF THE SKIP RETURN ON ERROR.
LIBCL0: INCHR AC ;READ A CHARACTER FROM THE FILE.
CAIE AC,15 ;IGNORE CARRIAGE-RETURNS.
CAIN AC,177 ;IGNORING ILLEGAL RUBOUTS
JRST LIBCL0 ;(WHICH ARE IN THERE FROM LIBRA SAVE)
CAIN AC,12 ;LINE-FEED?
MOVEI AC,EOL ;YES. CHANGE TO EOL.
PUSHJ PP,FIT ;MAKE ROOM.
IDPB AC,BUFH ;SAVE CHARS IN INPUT BUFFER.
AOJG AC,LIBCL0 ;UNTIL BUFFER COMPLETE.
DPB AC,BUFH ;SO BUFFER IS TOPPED OFF OK.
MOVEI AC,177 ;INSERT RUBOUT AT END OF THIS LIB FILE.
IDPB AC,BUFH ;SO WE KNOW WHEN TO STOP EXECUTING IT.
PUSHJ PP,LIBREL ;RELEASE THE LIBRARY CHANNEL.
POP PP,INCHN ;RESTORE CURRENT INPUT CHANNEL.
LIBCL1:
IFGE VMAJOR-60,<JSP PC,DUPLICATE> ;SAVE POINTERS.
PUSHJ PP,EXECLN ;EXECUTE OR STORE ONE LIBRA INPUT LINE.
IFGE VMAJOR-60,<
JSP PC,RETRACE ;GO BACK AND RELEASE THE CORE
LIBCL2: ILDB AC,PNTR ;SCAN UNTIL END OF LINE.
SETZM CH ;CREATE A NULL.
DPB CH,PNTR ;CLEAR SOME OF WHAT WE JUST EXECUTED
JUMPE AC,LIBCL1 ;HAVE WE REACHED END OF LINE?
CAIE CH,177 ;END OF FILE?
JRST LIBCL2 ;NO.
PX NOTE! LIBCL2 CODE WON'T WORK BECAUSE THE CODE AT FOR2 LEAVES THE POINTERS IN THE MIDDLE OF THE LINE.
>;END IFGE VMAJOR-60
IFL VMAJOR-60,<
HOP .+1 ;OVER THE EOL.
CAIE CH,177 ;END OF FILE?
JRST LIBCL1 ;NO.
>;END IFL VMAJOR-60
POP PP,BUFH ;YES.
ADJSP PP,-1 ;ADJUST STACK FOR UNWANTED LINNUM
JRST RETRCE ;UNSTACK PNTR, LINNUM, & RETURN.
OPER.O: TLNN F0,(EXTGIV) ;SPECIFIC EXTENSION GIVEN?
MOVSI T4,(SIXBIT "LST") ;NO. USE "LST".
OPER.I: CAIG AC,LIBCHN ;CHANNEL SPECIFIED?
MOVEI AC,DOUCHN(T2) ;NO. USE DEFAULT.
IFN DOUCHN+1-DINCHN,PX BUG AT OPER.I+1
;HERE TO INIT OR RELEASE AN I/O CHANNEL.
;CALL - MOVE AA,[-1] IF RELEASE ONLY
; MOVE AA, OTHER VALUES TAKEN AS DEVCHR WORD.
AUTIO4:IFLE MONITOR-4.72,<
SKIPL BUFTAB(AC) ;IS THERE AN OUTPUT FILE?
JRST AUTIO5 ;RETURN IF NONE WAS ACTIVE.
MOVE PC,AC ;GET CHANNEL NUMBER.
IMULI PC,WPD ;MAKE INDEX FOR DIRECTORY BLOCK
IFLE MONITOR-3.27,<
MOVSI UA,(CLOSE) ;MAKE CLOSE OPERATION.
DPB AC,[POINT 4,UA,12] ;INSERT CHANNEL NUMBER.
XCT UA ;DO THE CLOSE.
>;END IFLE MONITOR-3.27
MOVSI UA,(RENAME) ;MAKE RENAME OPERATION.
DPB AC,[POINT 4,UA,12] ;INSERT CHANNEL NUMBER.
ADDI UA,FILTAB(PC) ;GET INDEX TO DIRECTORY DATA BLOCK.
XCT UA ;RENAME FOR THE <PRT>
SKIPA UA,FILTAB+1(PC) ;ERROR.
AUTIO5: SKIPA UA,AC ;CHANNEL NUMBER.
ERRORR RENERR(UA) ;PRINT MESSAGE.
IMULI UA,WPD ;INDEX TO FILTAB.
MOVEI PC,FILTAB(UA) ;ADDRESS OF DIRECTORY DATA BLOCK.
HRLI PC,T3 ;SOURCE TO MOVE.
BLT PC,FILTAB+3(UA) ;SAVE DIRECTORY DATA.
>;END IFLE MONITOR-4.72
MOVE UA,AC ;GET CHANNEL NUMBER.
LSH UA,27 ;MOVE TO ACCUMULATOR FIELD
TLO UA,(RELEASE) ;CREATE RELEASE OPERATION.
XCT UA ;RELEASE IN CASE NO CAN DO.
SETZM OUTCHN(T2) ;CLEAR CURRENT-I/O-CHANNEL
SETZM BUFTAB(AC) ;AND BUFFER-IN-USE FLAG.
MOVN PC,T2 ;LOOK AT I/O IN OPPOSITE DIRECTION.
CAMN AC,INCHN(PC) ;ACTIVE ON THIS CHANNEL?
SETZM INCHN(PC) ;YES. CLEAR IT.
TLC AA,(1B4+1B5+1B12+1B14) ;TEST FOR THIS JOB'S CONSOLE.
TLCN AA,(1B4+1B5+1B12+1B14) ;AND IF IT IS, THEN
POPJ PP, ;JUST RELEASE THE CHANNEL.
MOVEM AC,OUTCHN(T2) ;STORE CURRENT-I/O-CHANNEL.
IMULI AC,WPC ;GET INDEX TO BUFFER-HEADER TABLE.
MOVEI AA,HEDTAB(AC) ;POINT TO BUFFER HEADER.
SKIPN AC,T2 ;OUTPUT?
MOVSS AA ;YES. MOVE TO LEFT HALF.
TLC UA,(<OPEN>^!<RELEASE>) ;CREATE OPEN OPERATION; OPEN.XOR.RELEASE
HRRI UA,AC ;POINT TO OPEN DATA BLOCK
XCT UA ;OPEN I/O CHANNEL.
ERRORR INIERR ;CAN'T INIT.
IFE XPV*KA-10,MOVEI AA,4 ;LENGTH OF ENTER BLOCK
IFN XPV*KA-10,<
MOVEM AA,LUKENT+AA+.RBDEV+1 ;SAVE BUFFER HEADER POINTER
SKIPA AC,OUTCHN(T2) ;GET CURRENT CHANNEL.
AUTIOZ: HLLZ T4,LUKENT+T4 ;SET UP ORIGINAL EXTENSION.
AND T5,[-1B8] ;CLEAR CREATION DATE.
MOVEI AA,4+1B18 ;LENGTH OF ENTER BLOCK+NON-SUPERCEDE
SKIPN T2 ;ENTER?
CAIE AC,LIBCHN ;YES. IF THIS NOT IS LIBRA SAVE, THEN...
TRZ AA,1B18 ;DON'T MAKE IT A NON-SUPERCEDING ENTER
>;END IFN XPV*KA-10
MOVEI PC,LUKENT ;POINT TO LOOKUP/ENTER BLOCK.
BLT PC,LUKENT+T6 ;MOVE ARGUMENTS TO LOOKUP/ENTER BLOCK.
MOVNI PC,-077(T2) ;"ENTER" OR "LOOKUP" OP CODE
DPB PC,[POINT 9,UA,8] ;CREATE ENTER OR LOOKUP OPERATION
HRRI UA,LUKENT+AA ;POINT TO DIRECTORY DATA BLOCK.
MOVEM T6,LUKENT+T2 ;PUT PPN IN PLACE FOR EXTENDED ENTER.
XCT UA ;ENTER OR LOOKUP.
JSP PC,AUTIO9 ;FAILURE.
MOVE T5,OUTCHN(T2) ;GET CHANNEL NUMBER
TLC UA,(<OUTBUF>^!<ENTER>) ;CREATE OUTBUF OR INBUF OPERATION
IFN <OUTBUF>^!<ENTER>-<INBUF>^!<LOOKUP>,PX OUTBUF.XOR.ENTER .NE. LOOKUP.XOR.INBUF
MOVE T6,UA ;SAVE FOR LATER AS WELL.
PUSHJ PP,FIT ;USE @BUFH UPWARDS AS SCRATCH SPACE.
HRRI T6,1 ;OUTBUF OR INBUF 1 BUFFER.
XCT T6 ;DO OUTBUF/INBUF.
SUB AA,.JBFF## ;GET SIZE OF ONE BUFFER.
IMULI AA,-2 ;GET SIZE OF TWO BUFFERS IN RIGHT HALF.
HRRZ AC,BUFBOT ;INITIALLY LOOK AT BOTTOM OF BUFFER SPACE
AOSA T6 ;MAKE OUTBUF/INBUF 2.
AUTIO6: MOVE AC,MQ ;LOOP FOR ANOTHER TRY
MOVNI UA,17 ;LOOK AT ALL I/O CHANNELS.
HRRZS T3,AC ;ADDRESS OF PROSPECTIVE BUFFERS.
ADDI T3,(AA) ;ADDRESS ABOVE PROSPECTIVE BUFFERS.
AUTIO7: MOVM T4,BUFTAB+17(UA) ;GET BUFFER ADDRESS
CAIG T3,(T4) ;THIS CHANNEL CLEAR ABOVE?
JRST AUTIO8 ;YES. TRY NEXT CHANNEL.
HLRZ MQ,T4 ;SIZE OF THIS CHANNEL'S BUFFERS.
ADDI MQ,(T4) ;FIND FIRST ADDRESS ABOVE THIS CHANNEL.
CAIGE AC,(MQ) ;THIS CHANNEL CLEAR BELOW?
JRST AUTIO6 ;NO! CLASH. TRY HIGHER UP.
AUTIO8: AOJLE UA,AUTIO7 ;AOK SO FAR. CHECK ALL CHANNELS
HRL AC,AA ;MAKE BUFTAB WORD.
MOVEM AC,BUFTAB(T5) ;SAVE POINTER WORD.
SKIPN T2 ;OUTPUT?
MOVNS BUFTAB(T5) ;YES. FLAG IT IN TABLE.
HRROS T4,AC ;ENSURE FOR SQUEZ.
HRROI MQ,(T3) ;GET HIGHEST ADDRESS REQUIRED.
SUB MQ,INDEX ;SUBTRACT WHAT WE HAVE ALREADY.
SKIPLE MQ ;NEED SPACE?
PUSHJ PP,SQUEZ ;YES.
HRRZM T4,.JBFF## ;TELL MONITOR WHERE TO PUT BUFFERS.
XCT T6 ;SET TWO BUFFERS.
POPJ PP, ;RETURN.
AUTIO9: JUMPE T2,AUTIO1 ;GO HANDLE ENTER FAILURE.
HRRZS T4,LUKENT+T4 ;TRY NULL EXTENSION NEXT TIME.
TLON F0,(EXTGIV) ;SPECIFIC EXTENSION?
JRST -2(PC) ;NO. HAVE ANOTHER GO.
ERRORR LUKERR-F+F*XPV*KA/10(T4);YES, OR CAN'T EVEN FIND BLANK DEFAULT
IFN XPV*KA-10,<
SETOM AA ;PREPARE FOR RELEASE.
SOSE AC ;LIBRA CALL?
AOJA AC,AUTIO4 ;NO. OPERATE INPUT. RELEASE & RETURN.
AOS (PP) ;SKIP RETURN FROM LIBINI CALL,...
SOJA AC,CPOPJ ;WITH SIMULATED EOF.
>;END IFN XPV*KA-10
AUTIO1:
IFN XPV*KA-10,HRRZ T4,LUKENT+T4 ;GET ERROR CODE.
IFN XPV*KA-10,CAIN AC,LIBCHN ;LIBRA SAVE?
IFN XPV*KA-10,CAIE T4,4 ;YES. FILE ALREADY EXISTS?
AUTIO2: ERRORR ENTERR(T4) ;NO. CAN'T ENTER.
IFN XPV*KA-10,<
MOVEI AA,.RBDEV ;NUMBER OF LOOKUP ARGUMENTS.
MOVEM AA,LUKENT+AA ;STORE IN EXTENDED LOOKUP BLOCK.
LOOKUP LIBCHN,LUKENT+AA ;LOOKUP THE ORIGINAL FILE.
JRST AUTIO2 ;"CAN NEVER HAPPEN"!
HRLZI T4,'BAK' ;PREPARE TO RENAME IT TO BAK.
RENAME LIBCHN,T3 ;TRY TO CHANGE IT.
SKIPA AA,T4 ;CAN'T REMOVE .OLD
JRST AUTIOZ ;TRY AGAIN.
SETZM LUKENT+AA+.RBDEV-1 ;SET I/O MODE TO ASCII.
OPEN LIBCHN,LUKENT+AA+.RBDEV-1;OPEN THE EXACT STRUCTURE.
SKIPA AA,INIERR-ENTERR ;"CAN NEVER HAPPEN"!
LOOKUP LIBCHN,T3 ;LOOKUP .BAK FILE.
ERRORR ENTERR(AA) ;PREVIOUS RENAME MUST HAVE BEEN PROT FAIL.
RENAME LIBCHN,T2 ;DELETE IT.
ERRORR ENTERR(T2+1) ;NO. CAN'T ENTER.
JRST AUTIOZ ;TRY AGAIN.
>;END IFN XPV*KA-10
;MODIFY STATEMENT
MOD: PUSHJ PP,GETLN ;GET LINE NUMBER.
PUSHJ PP,FINDLN ;FIND THE LINE...
ERROR NOLINE ;...WHICH MUST BE EXACT.
MOVEM AA,T2 ;SAVE THE POINTER IN INDEX TABLE.
SETSTS TTYCHN,NOECHO ;SUPPRESS ECHOING.
SETZB UA,T6 ;CLEAR CUE AND SEARCH CHARACTER.
JSP PC,GETBUF ;INPUT THE NEW LINE.
MOD2: SETSTS TTYCHN,0 ;RESTORE ECHOING.
JSP PC,NEWTXT ;SET TO LOOK AT OUTPUT
XWD ZERO,AC ;FROM THE BUFFER.
MOVE AA,T2 ;RESTORE AA,
HLRZ AC,(T2) ;RESTORE AC,
HLLZ T4,(T2) ;SET UP T4 FOR NEWLIN,
HRR MQ,(T2) ;... AND ...
HRLI MQ,(POINT 7,,34) ;RESTORE MQ.
PUSHJ PP,NEWLI6 ;INSERT THE NEW DATA.
JSP PC,OLDTXT ;THEN RETURN TO THIS LINE,
TLFPPJ: OUTST CRLF ;AND RETURN THE BUFFER SPACE.
POPJ PP,
;FUNDAMENTAL KEYBOARD INPUT ROUTINE.
;THIS ROUTINE MAKES PROVISION FOR SPECIFIC CALLERS:
; QUIT+14, ASK2-1, & MOD2-1.
;THIS ROUTINE PLACES INPUT CHARACTERS ON TO THE STACK.
;WHEN INPUT IS COMPLETE, AN EOL IS PLACED ON THE STACK.
;THEN IN THE NEXT WORD PP IS PUSHED AS IT WAS ON ENTRY TO GETBUF.
;FINALLY WE PUSH THE ADDRESS OF A ROUTINE TO RESTORE THE STACK.
;FOR ALL EXCEPT MODIFY, CR IS IGNORED, AND DELIMITERS RECOGNIZED ARE:
; INPUT BUFFER: LINE-FEED AND ESCAPE
; ASK NUMBER: SPACE, COMMA, LINE-FEED, ESCAPE
; ASK STRING: LINE-FEED, ESCAPE
;CALL: MOVE T2,ASK-DATA-NAME (ASK ONLY)
; MOVEI T6,0 (MODIFY ONLY)
; MOVE MQ,PICK-UP POINTER (MODIFY ONLY)
; MOVEI UA,CUE CHARACTER
; JSP PC,GETBUF
; RETURN WITH AC/ INITIAL BYTE POINTER (READY FOR ILDB).
; MQ/ BYTE POINTER JUST BELOW THE FINAL NULL.
; T3/ CHARACTER COUNT.
; T4/ DELIMITER CHARACTER
;USED BUT NOT PRESERVED:
; T5 CALLER'S ADDRESS RELATIVE TO MOD2.
; T6 SEARCH CHAR FOR MODIFY: ZERO IF NONE, LH ZERO IF SEARCHING,
; LH -1 IF FOUND AND WAITING.
GETBUF: TLO F0,(CUETTY) ;FLAG THE COMMAND FOR OUTPUT GUIDANCE.
PUSH PP,PP ;SAVE INITIAL PP
PUSH PP,UA ;SAVE THE CUE CHARACTER.
PUSH PP,MQ ;SAVE MODIFY'S POINTER.
PUSH PP,ZERO ;PLACE NULLS UNDER THE STRING.
SUBI PC,MOD2 ;MAKE CALLER'S ADDRESS RELATIVE TO MOD2.
HRRZ T5,PC ;GET CALLER'S ADDRESS.
MOVEI AC,0(PP) ;FIND PLACE TO PUT FIRST CHARACTER.
TLOA AC,(POINT 7,,35) ;MAKE A POINTER.
GET0: OUTST CONUCR ;TYPE "^U",CR,LF
MOVE PP,-3(AC) ;RESTORE PP.
ADJSP PP,4 ;ADJUST.
SKIPN UA,INCHN ;TELETYPE INPUT?
SKPINC ;YES. AWAKEN ITS PRINTER IF ASLEEP.
SKIPN UA ;BEWARE! TWO RETURNS!!
OUTCHR -2(AC) ;YES. TYPE THE CUE
MOVE MQ,AC ;CREATE A BYTE POINT TO THE STACK.
TDZA T3,T3 ;CLEAR THE COUNT
GET1: IDPB T4,MQ ;STORE CHARACTER IN INPUT BUFFER.
TLNN MQ,760000 ;IS THE STRING AT END OF WORD?
PUSH PP,ZERO ;YES. PUSH 5 NULLS ON.
GET2: JUMPN T5,GET3 ;IS THIS A MODIFY COMMAND?
JUMPG T6,GETY ;YES. ARE WE SEARCHING?
JUMPN T6,GET3 ;AWAITING A SEARCH CHARACTER?
OUTCH 7 ;YES. MAKE A NOISE.
GET3: INCHR T4 ;NO. INPUT A CHARACTER.
IFL MONITOR-5.05,<
CAIE T4,176 ;OLD-STYLE ALT-MODE?
CAIN T4,175 ;ALT-MODE?
MOVEI T4,33 ;YES. CHANGE TO ESCAPE.
>;END IFL MONITOR-5.05
IFL <<ASK2-QUIT>!<MOD2-ASK2-200>>,PX PROBLEMS WITH BACKSPACE.
CAIN T4,10(T5) ;BACKSPACE DURING MODIFY?
SOJGE T3,GET7 ;YES.
CAIN T4,10 ;BACKSPACE?
SOJGE T3,GET8 ;YES.
CAIN T4,177 ;RUBOUT?
SOJGE T3,GETRUB ;YES.
TLZN F0,(MODRUB) ;WERE WE RUBBING OUT?
JRST GET4 ;NO.
OUTCH "\" ;YES.
JUMPE T5,GET4 ;IS IT A MODIFY COMMAND?
OUTCH 0(T4) ;NO. ECHO THE CHARACTER. ************
SETSTS TTYCHN,0 ;RESTORE ECHOING.
GET4: CAIN T4,"R"-100 ;CONTROL-R?
JRST GET9 ;YES.
CAIN T4,"P"-100 ;CTRL-P?
JRST QUIT ;YES.
JUMPN T5,GET5 ;MODIFY COMMAND?
SKIPN T6 ;YES. ARE WE AWAITING A SEARCH CHARACTER?
HRRZ T6,T4 ;YES.
CAIN T4,14 ;FORM FEED?
HRRZS T6 ;YES. SCAN FOR NEXT SEARCH CHAR.
CAIN T4,7 ;BELL?
SETZB T4,T6 ;FLAG TO AWAIT NEW SEARCH CHAR.
SKIPL T4 ;END OF FILE?
CAIN T4,12 ;OR LINE FEED?
HRRZ T6,T4 ;SCAN TO END OF LINE.
CAIN T4,15 ;CARRIAGE-RETURN?
INCHR AA ;YES. IGNORE LINE-FEED.
CAIN T4,15 ;CARRIAGE-RETURN?
JRST GETRET ;YES.
JUMPGE T6,GET2 ;NOW GO FIND IT!
OUTCH 0(T4) ;ECHO THE CHARACTER. ************
GET5: CAIN T4,15 ;CR?
JRST GET2 ;IGNORE CARRIAGE-RETURNS.
JUMPL T3,GET0 ;NEW LINE IF RUBBED IT ALL OUT.
CAIN T4,"U"-100 ;NO. COMPLETE LINE RE-START ON ^U?
JRST GET0 ;YES.
CAIE T4,12 ;LINE-FEED?
CAIN T4,33 ;NO. ESCAPE?
JRST GETRET ;YES. EXIT.
JUMPGE T2,GET6 ;IF ASK STRING DON'T LOOK FOR COMMA, SPACE.
LDB UA,MQ ;GET PREVIOUS CHARACTER.
CAILE UA," " ;WOULD A SPACE BE "LEADING"?
CAILE T4," " ;NO. IS THIS THEREFORE A DELIMITING SPACE?
CAIN T4,"," ;NO. COMMA?
CAIE T5,ASK2-MOD2 ;YES. IS THIS ASK DATA?
GET6: JUMPG T4,GETZ ;NO. CONTINUE TO FILL BUFFER.
GETRET: PUSH PP,-3(AC) ;PUT THE OLD POINTER ON THE NEW STACK
PUSHJ PP,MOD2(T5) ;RETURN.
MOVE PP,(PP) ;RESTORE STACK WHEN CONVENIENT.
POPJ PP,
GETRUB: SETOM T4 ;POINT TO CONTROLLING TTY.
GETLCH T4 ;GET LINE CHARACTERISTICS.
TLNN T4,(GL.LCP) ;LOCAL-COPY?
TLON F0,(MODRUB) ;NO. WERE WE RUBBING OUT?
OUTCH "\" ;NO. BUT WE ARE NOW.
TLNE T4,(GL.LCP) ;LOCAL-COPY?
JRST GET8 ;YES.
SETSTS TTYCHN,NOECHO ;PREVENT IMMEDIATE ECHO.
LDB T4,MQ ;GET PREVIOUS CHARACTER.
GET7: OUTCH 0(T4) ;ECHO THE RUBBED-OUT CHARACTER. ************
GET8: MOVSI UA,-4 ;CLEAR A CHARACTER.
DPB UA,MQ ;RUB OUT THE PREVIOUS CHARACTER.
TLNN MQ,760000 ;WAS IT LAST IN A WORD.
ADJSP PP,-1 ;YES.
IBP MQ ;INCREMENT.
AOBJN UA,.-1 ;CONTINUE FOUR INCREMENTS.
SOJA MQ,GET2 ;CONTINUE ACCEPTING CHARS.
GET9: OUTST CRLF ;NEW LINE.
OUTCH @-2(AC) ;TYPE THE CUE.
OUTST 1(AC) ;PRINT IT.
JRST GET2
GETY: ILDB T4,-1(AC) ;HERE TO PICK UP CHAR FOR MODIFY SEARCH.
OUTCH 0(T4) ;ECHO IT.
CAMN T4,T6 ;IS THIS WHAT WE ARE SEARCHING FOR?
HRROS T6 ;YES. FOUND IT!
JUMPLE T4,GETRET ;TERMINATE AT END OF LINE.
GETZ: AOJA T3,GET1 ;COUNT AND STORE.
;NOTE: ************ MEANS BE CAREFUL NOT TO ECHO ESCAPE HERE.
; WE MUST THINK MORE ABOUT THIS.
;WRITE STATEMENT.
WRITE: JSPPC PROT26 ;SAVE ACCUMULATORS (FOR LIBRA SAVE CODE).
TLNE CC,(N) ;WRITING ONLY PART OF TEXT?
JRST WRITE0 ;YES.
OUTST HEADER ;PRINT HEADER.
MSTIME AC, ;GET TIME OF DAY.
IDIVI AC,^D60000 ;IN MINUTES.
IDIVI AC,^D60 ;SEPARATE HOURS AND MINUTES.
IMULI AC,^D100 ;PRE-FORMAT TO COMBINE.
ADD AC,AC+1 ;COMBINED HOUR-MINUTE NUMBER.
HRLI AA,3 ;SET MINIMUM OF 4 DIGITS FOR TIME
PUSHJ PP,TYPIN0 ;OUTPUT THE TIME.
OUTCH " " ;OUTPUT A TAB.
DATE T2, ;GET DATE.
IDIVI T2,^D31 ;SEPARATE DAYS AND MONTHS.
AOS AC,T3 ;DAY OF MONTH TO AC.
PUSHJ PP,TYPINT ;OUTPUT DAY.
OUTCH "-" ;HYPHENATE.
IDIVI T2,^D12 ;SEPARATE MONTHS AND YEARS.
OUTST MONTHS(T3) ;GET NAME OF MONTH.
MOVE AC,T2 ;RELATIVE YEAR TO AC.
ADDI AC,^D64 ;MAKE ABSOLUTE.
PUSHJ PP,TYPINT ;OUTPUT YEAR.
OUTST CRLF
;END OF HEADER-WRITING SECTION.
WRITE0: JSPPC LIMSET ;DO NOT RETURN IF NOTHING TO WRITE.
MOVEM T2,PC ;SAVE PREVIOUS LINE NUMBER.
MOVEM AC,T2 ;SAVE THIS LINE NUMBER.
XOR PC,AC ;COMPARE THIS WITH PREVIOUS.
TRNE PC,7600 ;SAME GROUP?
;SUBROUTINE TO TYPE LINE NUMBER AND TEXT.
TYPLIN: OUTST CRLF ;NO. INSERT CRLF.
JUMPE AC,WRITE4 ;DON'T TYPE LINE NUMBER IF IT'S ZERO.
PUSHJ PP,TYPELN ;TYPE LINE NUMBER
OUTCH " " ;SEPARATE LINE NUMBER FROM TEXT.
WRITE4: OUTST 1(MQ) ;PRINT THE LINE.
JRST TLFPPJ ;TYPE CRLF AND RETURN.
HEADER: VERSTR (C-FOCAL v,VMAJOR,VMINOR,VEDIT,VWHO)
SUBTTL ARITHMETIC EVALUATION.
;(EXPRESSION TERMINATED BY EXCESS RP, COMMA,CR, SEMICOLON OR ILLEGALITY.)
DEFINE OPERATOR<
;;FIRST ARGUMENT IS THE OPERATOR ITSELF.
;;SECOND ARGUMENT IS ITS PRIORITY FOR HIERARCHICAL EVALUATION.
;;THIRD ARGUMENT IS FLAGS - IFCMD IF OPERATOR PRODUCES LOGICAL RESULT.
;; NUMBER, STRING, LOGICL IF THEY ARE LEGAL OPERANDS.
;;FOURTH ARGUMENT IS ADDRESS OF EVALUATION ROUTINE.
;;SEQUENCE MUST BE LONGER OPERATORS FIRST AND IN COLLATING-SEQUENCE ORDER.
X #,1,IFCMD!NUMBER!STRING,<COMP.+<CAMN>-<CAM>>
X **,6,NUMBER,EXP.
X *,4,NUMBER,MUL.
X +,3,NUMBER,ADD.
X +,3,STRING,ADD.S
X -,3,NUMBER,SUB.
X .EQ.,1,IFCMD!NUMBER!STRING,<COMP.+<CAME>-<CAM>>
X .GE.,1,IFCMD!NUMBER!STRING,<COMP.+<CAMGE>-<CAM>>
X .GT.,1,IFCMD!NUMBER!STRING,<COMP.+<CAMG>-<CAM>>
X .LE.,1,IFCMD!NUMBER!STRING,<COMP.+<CAMLE>-<CAM>>
X .LT.,1,IFCMD!NUMBER!STRING,<COMP.+<CAML>-<CAM>>
X .NE.,1,IFCMD!NUMBER!STRING,<COMP.+<CAMN>-<CAM>>
X /,5,NUMBER,DIV.
X =,1,IFCMD!NUMBER!STRING,<COMP.+<CAME>-<CAM>>
X ^,6,NUMBER,EXP.
>;END DEFINE OPERATOR
;HIERARCHICAL ASSIGNMENTS.
HIER:
DEFINE X (A,B,C,D) <EXP D+<C!<B_^D30>>>
OPERATOR
NOPS=.-HIER
EVALN: TLO F0,(NUMBER) ;FORCE NUMERIC-ONLY EVALUATION.
EVAL: JSPPC PROT23 ;PROTECT T2,T3
EVAL00: HRRZS T3,(PP) ;SIMULATE NULL OPERATOR.
JRST EVAL02 ;GO SCAN.
;HERE WITH HIERARCHY WORD IN T3 ;READY FOR LETTER, NUMBER, OR SUB-EXPRESSION.
EVAL01: HLLZ T2,(PP) ;ENSURE WE IGNORE ADDRESS FIELD.
HLLZ AA,T3 ;GET CURRENT HIERARCHY.
TLZ AA,707777 ;CLEAR ALL BUT HIERARCHY.
CAMG AA,T2 ;LOOK AT OPERATOR'S HIERARCHY
POPJ PP, ;LAST WAS HIGHER: COMBINE
IFN PDP-6,<PUSH PP,EVAL08> ;SET RETURN-ADDRESS ON STACK.
IFE PDP-6,<PUSH PP,@EVAL08> ;ALLOW FOR GLIDE MACRO.
DPUSH PP,AC ;SAVE THE VALUE.
TLNE F0,(STRING) ;STRING VALUE?
MOVEM MQ,BUFH ;YES. PROTECT THE STRING.
IFE XPV,<TLNE F0,(STRING)> ;STRING VALUE?
IFE XPV,<PUSH PP,MQ> ;MUST SAVE END OF STRING REGARDLESS.
PUSH PP,T3 ;PUSH OPR.H
EVAL02: PUSHJ PP,EVALEX ;GO GET NUMBER,VALUE, OR EXPRESSION.
MOVE T2,[XWD -NOPS,HIER]
MOVE T3,[POINT 7,OPS] ;POINT TO TABLE OF OPERATORS.
MOVEM T3,TEMP4 ;SAVE IT FOR INCREMENTING.
EVAL04: MOVE T3,PNTR ;SAVE INTERPRETATION SPOT.
EVAL05: ILDB AA,TEMP4 ;GET FIRST CHARACTER OF NEXT OPERATOR.
JUMPE AA,EVAL07 ;NO MORE. WE HAVE A MATCH.
EVAL5B: ILDB UA,T3 ;GET NEXT CHARACTER OF INPUT STRING.
CAIN UA,"?" ;DEBUG?
JRST EVAL5B ;YES. JUST IGNORE IT FOR NOW.
SUB UA,AA ;COMPARE INTERP CHAR WITH OPERATOR CHAR.
JUMPE UA,EVAL05 ;EQUIVALENT SO FAR.
IFGE SIZE,CAIE AA,"*" ;SPECIAL CASE FOR * AND **.
IFGE SIZE,JUMPL UA,EVAL6B ;NO OPERATOR WILL EVER MATCH!
EVAL06: ILDB AA,TEMP4 ;SKIP REST OF THIS OPERATOR.
EVAL6A: JUMPN AA,EVAL06 ;SKIP REST OF THIS OPERATOR.
AOBJN T2,EVAL04 ;TRY THE NEXT OPERATOR.
EVAL6B: SETZM T3 ;DID NOT FIND AN OPERATOR.
JRST EVAL01 ;SET UP T2 AND RETURN.
;HERE HAVING FOUND AN OPERATOR. NOW TEST ITS LEGALITY.
EVAL07: MOVE PC,F0 ;GET TYPE OF OPERAND.
TLC PC,(IFCMD) ;COMPLEMENT THE IF COMMAND FLAG.
AND PC,(T2) ;COMPARE LEGAL OPERANDS WITH OPERAND STATUS.
TLNN PC,(IFCMD) ;LOGICAL OPERATOR ILLEGAL EXCEPT IN IF.
TLNN PC,(STRING!NUMBER!LOGICL);THERE MUST BE AT LEAST ONE AGREEMENT.
JRST EVAL6A ;OTHERWISE THE OPERATOR IS INVALID.
CAME T3,PNTR ;HAS FOCAL CAUGHT UP YET?
HOP .-1 ;WAIT FOR THE DEBUG TO PRINT OUT.
MOVE T3,(T2) ;PICK UP HIERARCHY WORD.
EVAL08: STEP EVAL01 ;EXIT.
EVALEX: CAIN CH,"-" ;UNARY -?
PUSH PP,JNEG ;YES. NEGATE AFTER GETTING ANSWER.
CAIE CH,"-" ;UNARY -?
CAIN CH,"+" ;UNARY +?
HPSTPP SETNUM ;YES. SKIP IT.
TLNE CC,(A) ;NEXT CHARACTER ALPHABETIC?
JRST GETVAL ;YES. EVALUATE
CAIN CH,42 ;DOUBLE-QUOTE?
JRST GETSTR ;YES.
TLNE CC,(LP) ;IS THE NEXT ITEM PARENTHETIC?
JRST EVALX1 ;YES.
TLNN CC,(N) ;NUMERIC OR STARTS WITH "."?
TLNN T3,-1 ;A BLANK EXPRESSION?
JRST GETNM ;NO. COPE WITH ABSENCE OF ARGUMENT.
ERROR SYNTAX ;OTHERWISE TRAP BAD CONDITION.
EVALX1: HPSTPP EVAL00 ;EVALUATE SUB-EXPRESSION.
EVALY: TLNN CC,(RP) ;CHECK END OF SUBEXPRESSION.
ERROR MISMATCH ;BAD
HPSTP CPOPJ ;GOOD.
;BYTE TABLE OF OPERATORS.
DEFINE X (A,B,C,D) <
.ADSTR (A)
.ADCHR 0
>;END DEFINE X (A,B,C,D)
OPS:
.STRG==0
.SHFT==^D29
OPERATOR
IFN .SHFT-^D29,EXP .STRG
;HERE WHEN LOGICAL OPERATOR FOUND.
COMP.: TLZ T2,770777 ;T2 IS SET UP AT EVAL01.
TLO T2,(CAM AA,) ;MAKE A COMPARE INSTRUCTION.
HRRI T2,PC ;PREPARE TO COMPARE AA,PC.
TLZE F0,(STRING) ;COMPARING STRINGS?
JRST COMP.S ;YES.
IFG XPV,<
CAME AC,-XPV(PP) ;NUMERIC COMPARE - CHECK HIGH ORDERS.
SKIPA PC,AC ;HIGH ORDERS DIFFERENT.
SKIPA PC,MQ ;HIGH ORDERS SAME.
SKIPA AA,-XPV(PP) ;HIGH ORDERS DIFFERENT.
>;END IFG XPV
IFE XPV,<MOVE PC,AC> ;SINGLE PRECISION IS SIMPLE.
MOVE AA,0(PP) ;HIGH ORDERS SAME.
JRST DOCOMP ;INEQUALITY AT LAST!
COMP.S: MOVE UA,-1(PP) ;GET POINTERS INTO UA,PC.
MOVEM UA,BUFH ;RESTORE BUFH.
EQU.S: CAMN UA,(PP) ;AT END OF PUSHED STRING?
TDZA AA,AA ;YES. FLAG IT SO.
ILDB AA,UA ;GET CHARACTER FROM ONE STRING.
CAMN AC,MQ ;AT END OF OTHER STRING?
TDZA PC,PC ;YES.
ILDB PC,AC ;GET CHARACTER FROM OTHER STRING.
CAMN AA,PC ;EQUAL SO FAR?
JUMPN AA,EQU.S ;CONTINUE TO SCAN STRINGS.
IFE XPV,<ADJSP PP,-1> ;EXTRA INSTRUCTION NEEDED HERE.
DOCOMP: XCT T2 ;DO THE COMPARE.
TDZA AC,AC ;SET FALSE.
SETOB AC,MQ ;SET TRUE.
TLO F0,(LOGICL) ;FLAG RESULT.
TLZ F0,(NUMBER!STRING) ;FLAG RESULT.
JRST OPRXIT
;EVALUATION SUBROUTINES.
;WE COME HERE WITH TWO VALUES, THE FIRST IS IN -XPV(PP), AND SECOND IS IN AC.
;WE MUST PERFORM THE COMBINING OPERATION, N1.OPR.N2 OR -XPV(PP).OPR.AC
;AND PUT THE RESULT IN AC, THEN GO TO OPRXIT.
SUB.: NEGATE ACCUM ;SUBTRACT IS JUST NEGATIVE ADD
ADD.: DFAD AC,-XPV(PP) ;RESULT TO TOP OF STACK
JRST OPRXIT ;RETURN.
DIV.: DEXCH AC,-XPV(PP) ;ARGUMENT IS DIVIDEND
DFDV AC,-XPV(PP) ;RESULT TO TOP OF STACK
OPRXIT: ADJSP PP,-WPV ;REDUCE STACK.
POPJ PP,
ADD.S: MOVE AC,-1(PP) ;RESTORE BEGINNING OF STRING.
MOVEM AC,BUFH ;RESTORE BUFH.
IFE XPV,<ADJSP PP,-1> ;RESTORE STACK
JRST OPRXIT ;RESTORE STACK.
ANTILI: PUSHJ PP,DFLOAT ;ENTER HERE WITH INTEGER FOR 10**(INTEGER)
ANTILG: JSPPC PROT23 ;SAVE T2 AND T3.
DPUSH PP,TEN ;ENTER HERE TO FIND 10**AC
EXP.: PUSHJ PP,FIXOAT ;SEPARATE INTEGER & FRACTION OF THE POWER
MOVE T2,AA ;SAVE INTEGER PART IN T2.
DMOVEM AC,TEMPE ;SAVE FRACTION PART IN TEMPE.
DMOVE AC,-XPV(PP) ;GET BASE.
JUMPE AC,OPRXIT ;GIVE ANY POWER OF ZERO IS ZERO.
PUSHJ PP,LOG ;GET LOG(BASE).
DFMP AC,TEMPE ;GET POWER*(LOG(BASE)).
PUSHJ PP,EXP ;GET EXP(POWER*(LOG(BASE))).
EXP.1: JUMPGE T2,EXP3C ;ALLOW FOR NEGATIVE POWER.
MOVMS T2 ;TREAT IT AS A POSITIVE POWER
DEXCH AC,-XPV(PP) ;WITH THE BASE BEING
PUSHJ PP,RECIPROCAL ;INVERTED.
DEXCH AC,-XPV(PP) ;RESTORE BASE TO THE STACK.
EXP3C: TRZE T2,1 ;NO. MULTIPLY NEXT POWER?
DFMP AC,-XPV(PP) ;YES.
JUMPE T2,OPRXIT ;DONE INTEGER POWER?
DEXCH AC,-XPV(PP) ;GET BASE.
DFMP AC,AC ;GET BASE*BASE.
DEXCH AC,-XPV(PP) ;RESTORE TO TEMPORARY STORE.
LSH T2,-1 ;LOOP.
JRST EXP3C ;UNTIL DONE.
SUBTTL SUBROUTINES
;ROUTINES TO PROTECT ACCUMULATORS T2-TN.
;CALL: JSPPC PROT2N
; ROUTINE
; POPJ PP,
PROT23: EXCH T2,(PP) ;SAVE T2 AND GET ROUTINE ADDRESS
PUSH PP,T3 ;SAVE T3.
PUSHJ PP,(T2) ;GO TO ROUTINE.
POP PP,T3 ;RESTORE T3.
POP PP,T2 ;RESTORE T2.
POPJ PP, ;RETURN TO ROUTINE'S CALLER.
PROT26: EXCH T2,(PP) ;SAVE T2, GET ROUTINE ADDRESS.
MOVNI PC,4 ;SET COUNTER.
PUSH PP,T6+1(PC) ;SAVE T2 - T6.
AOJL PC,.-1 ;
PUSHJ PP,(T2) ;GO TO ROUTINE.
MOVEI PC,5 ;SET COUNTER.
POP PP,T2-1(PC) ;RESTORE T6 - T2.
SOJG PC,.-1 ;
POPJ PP, ;RETURN TO ROUTINE'S CALLER.
;ROUTINE TO READ IN A COMMAND STRING OF THE FORM -
; DEV:FILE.EXT[PRJ,PRG]<PRT>/CHN
;ABSENT FIELDS ALWAYS YIELD DEFAULT ANSWERS; ANSWERS ARE RETURNED THUS:
; F0 EXTGIV BIT ALWAYS SET OR CLEARED. ; T3 FILE IN SIXBIT
; AC CHANNEL NUMBER (NEGATIVE IF NONE). ; T4 EXT IN SIXBIT (R.H. ZERO)
; MQ DEV IN SIXBIT ; T5 FILE PROTECTION IN BITS 0-8
; AA DEVICE CHARACTERISTICS WORD ; T6 PRJ,PRG
RCM: MOVSI MQ,(SIXBIT "DSK") ;DEFAULT DEVICE NAME.
MOVSI T4,(SIXBIT "FCL") ;DEFAULT FILE EXTENSION.
TLZ F0,(EXTGIV) ;MARK EXTENSION AS ONLY BE DEFAULT.
SETZB T5,T6 ;CLEAR PROT,PROJ,PROG.
PUSH PP,.-1 ;CLEAR CHANNEL NUMBER.
PUSHJ PP,SYMB ;COLLECT CONTENT OF FIRST FIELD.
CAIN CH,":" ;WAS IT A DEVICE NAME?
HOPP SYMB0 ;YES. SAVE & GET NEXT FIELD.
SKIPN T3,AC ;FILE NAME GIVEN?
MOVE T3,[SIXBIT "FOCAL"] ;NO. SUPPLY DEFAULT FILE NAME.
CAIE CH,"." ;SPECIFIC FILE EXTENSION?
JRST RCM1 ;NO.
TLO F0,(EXTGIV) ;YES.
HOPP SYMB ;IF YES, COLLECT EXTENSION.
HLLZM AC,T4 ;AND SAVE THE ANSWER.
RCM1: CAIE CH,"[" ;PROJECT,PROGRAMMER PAIR?
JRST RCM2 ;NO. CHECK FOR PROTECTION
HPSTPP GETOCT ;YES. GET PROJECT NUMBER
CAIE CH,"," ;AND CHECK CORRECT SYNTAX
ERROR SYNTAX ;MUST ALWAYS BE A PAIR.
HRLZM AC,T6 ;STORE PROJECT NUMBER
HPSTPP GETOCT ;GET PROGRAMMER NUMBER.
CAIE CH,"]" ;CHECK CLOSING BRACKETS.
ERROR MISMATCH ;BAD STRING.
HRRM AC,T6 ;SAVE PROGRAMMER NUMBER.
HPSTP RCM2 ;HURDLE THE "]".
RCM2: CAIE CH,"<" ;PROTECTION SPECIFIED?
JRST RCM3 ;NO. CHECK FOR CHANNEL SPEC.
HPSTPP GETOCT ;READ IN THE PROTECTION BITS.
LSH AC,^D35-8 ;MOVE TO CORRECT FIELD, BITS 0-8.
MOVEM AC,T5 ;SAVE THE ANSWER.
CAIE CH,">" ;CHECK SYNTAX.
ERROR MISMATCH
HPSTP RCM1 ;GO CHECK IF ANY MORE DESCRIPTORS.
RCM3: SKIPE AA,MQ ;DEVICE NAME INTO AA.
DEVCHR AA, ;DEVICE CHARACTERISTICS WORD.
CAIE CH,"/" ;CHANNEL SPECIFIER?
JRST TPOPJ ;NO. THAT'S ALL FOLKS.
PUSH PP,MQ ;YES. SAVE DEVICE NAME.
HPSTPP GETLN ;GET CHANNEL NUMBER.
POP PP,MQ ;RESTORE DEVICE NAME.
LSH AC,-7 ;AS AN INTEGER.
HRRZM AC,(PP) ;SAVE IT.
CAIG AC,17 ;CHECK VALIDITY.
SOJG AC,RCM1 ;O.K. IF 2 OR MORE.
ERROR BADLIN ;OTHERWISE ERROR.
;SUBROUTINE TO CLEAR VARIABLES DATA AREA AND PRESET SYMBOL TABLE POINTERS.
CLRVAR: MOVEI AC,@BUFH ;ADDRESS OF BOTTOM OF UNUSED CORE
CLRVA1: HRLOI UA,(POINT 7,(RL),34) ;CREATE AN INDEX FIELD ALONE, TO
MOVEM UA,SYMTBL ;INDICATE EMPTY VARIABLES AREA.
MOVEM UA,SYMTBC ;EMPTY VARIABLE AREA AND EMPTY STRING AREA.
;ROUTINE TO SET THE LOW SEGMENT SIZE.
;COME HERE WITH AC(RIGHT) CONTAINING THE AMOUNT TO BE COVERED
SETCOR: HRRZI RL,2(AC) ;GET MAXIMUM LOCATION DESIRED.
CORE RL, ;ASK FOR LOW SEGMENT CORE.
ERROR NOCOR ;CORE NOT AVAILABLE.
IFL MONITOR-5.03,<
SETZM RL ;UPDATE .JBREL
SLEEP RL, ;BY FORCING A RE-SCHEDULE.
>;END IFL MONITOR-5.03
HRRZ RL,.JBREL## ;GET NEW LOW SEGMENT SIZE.
MOVEM RL,SYMTBH ;INITIALIZE SYMTBH.
AOS RL ;POINT TO THE WORD ABOVE THE TOP.
HRLM RL,.JBCOR## ;ENSURE THE SAVE COMMAND SAVES A LOW SEGMENT
HRLM RL,.JBSA## ;ENSURE THE SAVE COMMAND SAVES ALL CORE
POPJ PP,
;SUBROUTINE TO CONVERT ASCII TO OCTAL.
;ALWAYS RETURN WITH AC CONTAINING THE ANSWER.
GETOCT: SETZM AC ;INITIAL VALUE ZERO
GETINT: CAIGE CH,"8" ;CHECK LEGALITY
CAIGE CH,"0" ;AND CHECK IT'S NUMERIC.
POPJ PP, ;RETURN WHEN ILLEGAL CHARACTER.
IMULI AC,8 ;UP PREVIOUS ANSWER.
ADDI AC,-"0"(CH) ;ACCUMULATE.
HOP GETINT ;CONTINUE.
NEWLIN: TLO F0,(NO.INT) ;DISABLE DEBUG.
PUSHJ PP,GETLN ;GET LINE NUMBER FOR INSERTION.
CAILE AC,200 ;GROUP NUMBER GIVEN?
TRNN AC,177 ;YES. LINE NUMBER?
ERROR BADLIN ;NO. INVALID LINE #
CAIL AC,^D100_7 ;CHECK VALIDITY
ERROR BADLIN ;CANNOT ALLOW ILLEGAL LINES HERE
HRLZ T4,AC ;SAVE LINE NUMBER.
STEPP FINDLN ;FIND POINTER TO THIS LINE IN TEXT.
JRST NEWLI0 ;CAN'T FIND - JUST INSERT.
NEWLI6: PUSH PP,AA ;FOUND THE LINE. - SAVE THE INDEX SLOT.
PUSHJ PP,DELINE ;DELETE THE LINE.
POP PP,AA ;RESTORE THE INDEX SLOT.
NEWLI0: JUMPE CH,CPOPJ ;NO INSERTIONS TO DO.
SKIPN -1(AA) ;PREVIOUS INDEX SLOT NULL?
SOJA AA,.-1 ;YES. GET LOWEST SLOT.
HRRO AC,AA ;POINT TO SPACE IF SQUEEZ NEEDED.
SKIPE (AA) ;NEED SPACE?
PUSHJ PP,SQUEEZ ;YES.
;NOW INDEX DATA BLOCK HAS AN EMPTY SLOT WITH AC POINTING TO IT.
MOVE T5,AC ;SAVE THE SLOT POINTER IN T5.
MOVE AC,TEXTL ;SET UP TO SCAN FOR SOME FREE CORE
HLL AC,BUFL ;EQUATE LEFT HALVES & MAKE IT A POINTER.
TDZA T3,T3 ;FLAG THAT INITIAL WORD IS O.K.
NEWLI1: MOVE T3,(AC) ;PICK UP THE DATA WORD JUST BELOW.
CAML AC,BUFL ;ARE WE STILL WITHIN LIMITS?
JRST NEWLI2 ;NO. PLACE THE NEXT TEXT AT THE TOP.
TRZN T3,376 ;IS THERE STILL AN EOL TERMINATING?
SKIPE 1(AC) ;IS THE NEXT WORD FREE?
AOJA AC,NEWLI1 ;NO. LOOK MORE.
NEWLI2: HRRM AC,T4 ;CREATE THE WORD FOR THE INDEX TABLE
NEWLI3: PUSHJ PP,SQUEAZ ;GET ONE FREE BYTE.
DPB CH,AC ;STORE TEXT.
MOVEM T4,(T5) ;STORE THE WORD IN THE INDEX TABLE.
JUMPE CH,CPOPJ ;STORED EOL YET?
HOP NEWLI3 ;NO.
DELINE: PUSHJ PP,KNOCK ;DELETE ACTIVE REFERENCES
SETZB UA,(AA) ;DELETE INDEX ENTRY.
DELIN0: ILDB AC,MQ ;MOVE ALONG TEXT.
DPB UA,MQ ;CLEARING IT OUT.
JUMPN AC,DELIN0 ;UNTIL WE REACH END-OF-LINE.
GLIDE CPOPJ ;IN CASE WE ERASED WHAT PNTR WAS POINTING TO
;SUBROUTINE TO DELETE REFERENCES TO ACTIVE LINES,
;TO COVER FOR CASES OF ERASING OR MODIFYING ACTIVE LINES.
;(ALLOW ERASING/MODIFYING, BUT USER CANNOT COMMIT SUICIDE.)
;CHECK CONTENTS OF AC AGAINST LINNUM CHAIN.
KNOCK: ANDI AC,777777 ;COMPARE ONLY THE VALID PART.
MOVE UA,LINNUM ;BEGINNING OF CHAIN.
;NOW WE DON'T NEED TO CHECK THE FIRST ITEM OF THE CHAIN, NAMELY LINNUM,
;BECAUSE IN THE CASE OF
; MODIFY LINNUM CONTAINS CURRENT EXECUTING LINE
; WHICH WAS DUPLICATED AT EXECL..
; ERASE LINNUM CONTAINS THE OBJECT LINE,
; WHICH WE DON'T WANT TO CHECK.
; NEWLIN LINNUM CONTAINS CURRENT EXECUTING LINE
; WHICH WAS DUPLICATED AT EXECL..
KNOCK1: HLRE PC,UA ;GET NEXT LINK OF CHAIN.
JUMPGE PC,CPOPJ ;NO MORE LINKS - EXIT.
MOVE UA,PDLEND-2(PC) ;PICK UP XWD LINK,LINE #.
CAIN AC,(UA) ;IS THIS LINE BEING EXECUTED?
SETZM PDLEND-1(PC) ;YES.
JRST KNOCK1 ;LOOP.
;SUBROUTINE TO SET EXECUTION LIMITS INTO LUPARG.
;PRESENT SETTINGS OF LINNUM,PNTR,LUPARG ARE SAVED.
;ALSO SET RIGHT HALF OF LINNUM TO FIRST LINE IN RANGE.
;CALL - JSPPC LIMSET ;THIS IS A DISGUISED PUSHJ PP,.
;DO NOT RETURN IF NO LINE FOUND.
;AC,MQ,AA SET UP AS FROM FINDLN
LIMSET: TLNE CC,(N) ;PNTR IS POINTING TO THE ARGUMENT.
JRST LIMSE1 ;PICK UP THAT ARGUMENT IF IT'S NUMERIC.
CAIE CH,"A" ;IS THE ARGUMENT "ALL"?
CAIN CH,"a" ;(LOWER OR UPPER CASE)
PUSHJ PP,SYMB ;YES. READ IN THE ARGUMENT.
TDZA AC,AC ;ENTER HERE TO DUMMY UP ZERO ARGUMENT
LIMSE1: PUSHJ PP,GETLN ;READ IN NUMERIC ARGUMENT.
LIMSE2: POP PP,UA ;GET ADDRESS OF CALL INTO PC.
JSP PC,DUPLIC ;SAVE LINNUM,PNTR, SET LINNUM CHAIN.
PUSH PP,LUPARG ;SAVE LUPARG.
PUSH PP,UA ;MAKE SO WE CAN POPJ BACK IF NECESSARY
HRRM AC,LINNUM ;STORE AS FIRST LINE TO GET.
HRRZM AC,LUPARG ;SAVE THE LOOP ARGUMENT.
LIMNX1: SKIPA LIMNXT ;GET LINE NUMBER INTO AC.
;ROUTINE TO ADVANCE RIGHT HALF OF LINNUM TO THE NEXT EXISTING
;LINE NUMBER, AND TEST WHETHER IT IS WITHIN THE LUPARG RANGE.
;CALL - PUSHJ PP,LIMNXT
; RETURN INSIDE RANGE. AC,MQ,AA SET UP AS FROM FINDLN.
; DO NOT RETURN IF OUTSIDE RANGE.
LIMNXT: AOS AC,LINNUM ;SET UP AC FOR FINDING A LINE.
PUSHJ PP,FINDLN ;ENTER HERE FROM LIMSET ROUTINE.
HRRM AC,LINNUM ;MODIFY LINNUM IF CAN'T FIND EXACT MATCH.
PUSH PP,LIMNX1 ;PLACE A RETURN ADDRESS ON THE STACK.
MOVE PC,AC ;GET THE LATEST LINE NUMBER.
SKIPN UA,LUPARG ;IS IT A WHOLE-PROGRAM LOOP?
SETZM PC ;YES.
TRNN UA,177 ;IS IT A GROUP-ONLY LOOP?
TRZ PC,177 ;YES.
CAMN PC,UA ;SHOULD BE EXACT MATCH TO CONTINUE.
JUMPG MQ,@-1(PP) ;INSIDE RANGE - CONTINUE PROGRAM.
ADJSP PP,-2 ;REMOVE RETURN ADDRESS.
POP PP,LUPARG
RETRCE: JSP PC,RETRACE ;REMOVE PNTR,LINNUM.
POPJ PP, ;DO NOT RETURN TO CALLING PROG.
;ROUTINES TO NEST AND UN-NEST TEXT POINTER/LINE-NUMBER PAIRS.
; ROUTINE TO SAVE CURRENT POINTERS AND SET UP NEW ONES.
; CALL - JSP PC,NEWTXT
; XWD NEWLIN,NEWTEXT
; WHERE NEWLIN IS AN ADDRESS CONTAINING THE NEW LINE NUMBER
; AND NEWTEXT IS AN ADDRESS CONTAINING A NEW BYTE POINTER.
NEWTXT: TLO F0,(NO.INT) ;START ANALYSING DATA.
PUSH PP,LINNUM ;SAVE CURRENT LINE NUMBER.
PUSH PP,PNTR ;SAVE CURRENT BYTE POINTER.
HLLM PP,LINNUM ;CHAIN.
PUSH PP,PC ;SAVE PC FOR RETURN.
MOVE PC,(PC) ;GET XWD ARGUMENT.
PUSH PP,(PC) ;GET NEW BYTE POINTER.
POP PP,PNTR ;SAVE IT.
HLRZ PC,PC ;GET LINE NUMBER ADDRESS.
MOVE PC,(PC) ;GET LINE NUMBER.
HRRM PC,LINNUM ;SAVE IT.
AOS (PP) ;SKIP OVER ARGUMENT.
GLIDE CPOPJ ;SET UP CH AND CC.
;ROUTINE TO DUPLICATE POINTERS.
;CALL ... JSP PC,DUPLICATE
DUPLIC: PUSH PP,LINNUM ;SAVE LINNUM
PUSH PP,PNTR ;AND PNTR ACCORDING TO CONVENTIONS.
HLLM PP,LINNUM ;CHAIN.
JRST (PC) ;RETURN.
;ROUTINE TO RESTORE LINNUM AND PNTR FROM THE STACK.
;THEN IGNORE SPACES.
; CALL - JSP PC,RETRACE OR OLDTXT
OLDTXT: TLZ F0,(NO.INT) ;FINISHED ANALYSING DATA.
RETRAC: POP PP,PNTR ;RESTORE PNTR
POP PP,LINNUM ;RESTORE LINE NUMBER.
STEP @PC ;RESTORE CC AND CH.
;SUBROUTINE TO INCREMENT BYTE POINTER IN AC AND
;INSERT A NULL WORD THERE IF THE NEW BYTE IS NOT NULL.
;(MQ IS DESTROYED BY THIS SUBROUTINE).
;NOTE: THIS SUBROUTINE IS INTENDED ONLY FOR INSERTIONS INTO THE TEXT AREA TEXTL-BUFL
SQUEAZ: MOVE AA,AC ;GET POINTER PRIOR TO INCREMENT.
ILDB MQ,AC ;INCREMENT AC BYTE POINTER.
TLNN AA,760000 ;WAS PREVIOUS POINTER LAST IN A WORD?
MOVE MQ,(AC) ;YES. IN THAT CASE, ENSURE WHOLE WORD ZERO.
HRRZI PC,@BUFH ;GET ADDRESS OF TOP OF USED-CORE
CAIL PC,(AC) ;ENSURE THE INSERTION IS IN BOUNDS.
JUMPE MQ,CPOPJ ;EXIT IF THIS NEXT BYTE IS NULL.
;FALL INTO SQUEEZ IF IT'S NOT.
;SUBROUTINE TO INTERPOSE A GROUP OF NULL WORDS IN THE DATA STORAGE AREA.
;CALL - HRRI AC,ADDRESS OF FIRST NULL WORD
; MOVEI MQ,# OF NULL WORDS TO BE INSERTED.
; PUSHJ PP,SQUEEZ
; RETURN WITH AA RIGHT HALF POINTING TO LAST NULL WORD
; AC PRESERVED.
;ROUTINE WILL INSERT NULLS JUST ABOVE WHERE AC POINTS.
;ROUTINE WILL ADJUST ALL BYTE POINTERS GREATER OR EQUAL TO AC.
IFNDEF SPEED,<SPEED==20> ;INCREASE THIS NUMBER FOR FASTER LIBRA CALL
;TIME OF LIBRA CALL GOES AS 1 + 11.41/SPEED + SPEED/752
;WHERE MIDDLE TERM IS DUE TO REDUCED BLT TIMES,
;AND LAST TERM IS DUE TO INCREASED FINDLN TIME.
SQUEEZ: MOVEI MQ,SPEED ;ENTER HERE TO GET AN OPTIMUM CHUNK
SQUEZ: JSPPC PROT23 ;PROTECT T2,T3.
HRROI T3,@BUFH ;MAKE TRANSFER PUSH-DOWN POINTER.
ADDM MQ,BUFH ;ADJUST BUFH.
PUSHJ PP,FIT ;MAKE SPACE.
MOVNI T2,-1(AC) ;MAKE COUNT: -BOTTOM.
ADDI T2,(T3) ;MAKE COUNT: +TOP
HRR PC,MQ ;SET UP THE ...
HRLI PC,T3 ;...DESTINATION POINTER.
POP T3,@PC ;MOVE A WORD AS BACKWARDS BLT.
SOJG T2,.-1 ;CONTINUE UNTIL DONE.
HRRZ AA,AC ;POINT TO POSITION OF FIRST NULL
SQUEZ0: SETZM @PC ;CLEAR NEW CORE
CAIGE AA,@PC ;UNTIL WE REACH THE BOTTOM.
SOJA PC,SQUEZ0 ;CONTINUE.
;ADJUST BYTE POINTERS AFTER TEXT BLOCK TRANSFER.
MOVEI T2,DBP ;POINT TO DATA POINTERS
SQUEZ1: PUSHJ PP,SQUEZ5 ;ADJUST POINTERS
CAIGE T2,DBPEND-1 ;END OF DATA POINTERS?
AOJA T2,SQUEZ1 ;NO
HLRE T3,LINNUM ;PRESET FOR CHAINED POINTERS
HRRZ T2,INDEX ;LOOK AT TEXT POINTERS
AOS T2 ;SKIP FIRST WORD (CONTAINS -1)
SQUEZ2: SKIPGE PC,(T2) ;END OF TEXT POINTERS?
JRST SQUEZ4 ;YES.
PUSHJ PP,SQUEZ6 ;NO. FIX UP THIS POINTER.
AOJA T2,SQUEZ2 ;...AND CONTINUE.
SQUEZ3: MOVEI T2,PDLEND-1(T3) ;POINT TO CHAINED POINTER.
PUSHJ PP,SQUEZ5 ;CHECK IT.
HLRE T3,PDLEND-2(T3) ;NEXT LINK IN CHAIN.
SQUEZ4: JUMPL T3,SQUEZ3
POPJ PP,
;SUBROUTINE TO ADJUST ONE BYTE POINTER IF NECESSARY.
;T2 CONTAINS THE ADDRESS OF THE POINTER.
;AA IS THE BASE FOR COMPARISON.
;MQ IS THE OFFSET TO BE APPLIED IF NECESSARY.
SQUEZ5: MOVE PC,(T2) ;GET POINTER.
TLNN PC,767077 ;BYTE POINTER JUST BELOW FIRST CHAR?
SQUEZ6: CAILE AA,1(PC) ;SEE IF RIGHT HALF JUST BELOW TOO.
CAIG AA,(PC) ;COMPARE NULL POSITION WITH BYTE POINTER
ADDM MQ,(T2) ;ABOVE. - ADJUST POINTER.
POPJ PP,
;SUBROUTINE TO SEE IF CORE NEEDS TO EXPAND.
;CALL: PUSHJ PP,FIT - FIRST SET C(.JBFF) JUST ABOVE @BUFH.
;CORE WILL NOT BE DECREASED.
;AA IS SET TO C(.JBFF) ON RETURN.
FIT: MOVEI AA,@BUFH ;ENTER HERE TO USE @BUFH.
AOS AA ;SET AA JUST ABOVE @BUFH.
MOVEM AA,.JBFF## ;STORE .JBFF IF CHANGED.
PUSH PP,AC ;SAVE AC
MOVEI AC,WPV*2+1(AA) ;GET TOP OF CONTIGUOUS LOW SEGMENT,
SUBI AC,@SYMTBL ;ADD SIZE OF SYMBOL TABLE
JUMPLE AC,TPOPJ ;DON'T NEED MORE CORE.
ADD AC,SYMTBH ;GET HOW MUCH CORE WE WANT.
PUSH PP,SYMTBH ;SAVE OLD TOP OF SYMBOLS.
PUSHJ PP,SETCOR ;NO. GET MORE CORE.
POP PP,AC ;RESTORE OLD TOP OF SYMBOLS
MOVN UA,SYMTBL ;GET # OF WORDS TO MOVE.
HRLI AC,377776(UA) ;SET COUNTER IN LH(AC)
MOVNI UA,(AC) ;CONSTRUCT DISTANCE TO MOVE,
ADD UA,SYMTBH ;IN UA.
HRLI UA,(POP AC,(AC)) ;CREATE AN INSTRUCTION
XCT UA ;EXECUTE IT TO MOVE A WORD.
JUMPL AC,.-1 ;REPEAT TILL ALL SYMBOLS MOVED.
TPOPJ: POP PP,AC ;THEN RESTORE AC AND RETURN.
POPJ PP,
;SUBROUTINE TO DECODE NEXT STRING AS A LINE NUMBER.
;RETURN WITH AC/ LINE NO.=LINE # + GROUP NO.*128.
;ALWAYS RETURN WITH C(AC) ZERO OR POSITIVE
;ABSENCE OF A LINE NUMBER IS INDICATED BY ZERO RETURNED IN AC.
;THIS VERSION TRUNCATES DECIMAL PLACES BEYOND TWO.
;THIS VERSION TRUNCATES HIGH ORDER INTEGER PART ABOVE ABOUT A MILLION.
GETLN: SETZB AC,MQ ;CLEAR ANSWER AND PLACE-COUNTER.
PUSHJ PP,GETLNS ;GET A DIGIT
SKIPA ;WAS NOT A DIGIT
JUMPL CC,.-2 ;GET NEXT DIGIT
CAIN CH,"." ;DECIMAL POINT?
HOPP GETLNS ;YES. GET NEXT DIGIT.
JRST GETLNZ ;NONE. DONE.
PUSHJ PP,GETLNS ;GET SECOND DIGIT
IMULI AC,^D10 ;NONE
IDIVI AC,^D100 ;SEPARATE INTEGER AND FRACTION.
ASH MQ,34 ;PLACE FRACTION BITS NEXT TO AC
GETLNZ: ASHC AC,7 ;COMBINE INTO ONE NUMBER.
POPJ PP, ;RETURN.
GETLNS: CAIL CH,"0" ;DIGIT ABOVE OR EQUAL ZERO?
CAILE CH,"9" ;YES. BELOW OR EQUAL NINE?
POPJ PP, ;NO. STRAIGHT RETURN.
AOS (PP) ;OTHERWISE SKIP-RETURN.
IMULI AC,^D10 ;MULTIPLY NUMBER SO FAR.
ADDI AC,-"0"(CH) ;ADD IN NEW DIGIT.
HOP CPOPJ ;SKIP OVER THE DIGIT ON THE WAY BACK.
;SUBROUTINE TO READ A SYMBOL INTO AC AS SIXBIT LEFT-JUSTIFIED.
;SKIP OVER LETTERS PAST THE SIXTH.
SYMB0: MOVEM AC,MQ ;SAVE AC FIRST.
SYMB: PUSHJ PP,SYMB1 ;COLLECT A SYMBOLIC NAME.
STEP CPOPJ ;IGNORE TRAILING SPACES.
SYMB1: PUSH PP,ZERO ;CLEAR THE RETURN ARGUMENT.
MOVSI AC,(POINT 6,(PP),) ;MAKE POINTER.
SYMB2: TLNN CC,(AN!E) ;RETURN WHEN NEITHER ALPHANUMERIC NOR "E".
JRST TPOPJ ;RETURN.
CAIGE CH,140 ;ALLOW FOR LOWER CASE.
SUBI CH,40 ;MAKE SIXBIT.
TLNE AC,770000 ;PAST SIXTH DON'T ASSEMBLE
IDPB CH,AC ;BUILD ANSWER.
HOP SYMB2 ;CONTINUE
SYMB$: PUSHJ PP,SYMB1 ;COLLECT A SYMBOL INTO AC.
CAIE CH,"$" ;IS IT DELIMITED BY A DOLLAR SIGN?
STEP SETNUM ;NO. IT IS A NUMERIC NAME.
TLZ AC,(1B0) ;YES. IT IS A STRING NAME.
HPSTP SETSTR ;SKIP THE "$" AND TRAILING SPACES.
;SUBROUTINE TO READ A VARIABLE NAME AND ITS SUBSCRIPT INTO AC AND T2.
;F0 FLAGS STRING AND NUMBER ARE SET/CLEARED.
SYMBOL: TLNN CC,(A) ;ENSURE A SYMBOL FOLLOWS.
ERROR SETERR ;UH!
PUSHJ PP,SYMB$ ;GET LABEL INTO AC; SET FLAGS IN F0.
MOVEI AA,NFUNCS-1 ;COUNT FUNCTION TABLE.
SYMBL0: CAMN AC,FNCLST(AA) ;FOUND EXACT MATCH?
ERROR SETERR ;YES. CAN'T HAVE FSIN(X)=XXX
SOJGE AA,SYMBL0 ;CONTINUE TO END OF TABLE.
SYMBL1: HLLZS T2,AC ;TRUNCATE TO 3 CHARS IN CASE NO SUBSCRIPT.
TLNN CC,(LP) ;IS IT DIMENSIONED?
POPJ PP, ;NO.
HPSTPP SYMBL2 ;GET THE COMBINED SUBSCRIPT.
HLL AC,T2 ;COMBINE LABEL & INDEX.
SKIPL T2,AC ;STRING?
TLC F0,(STRING!NUMBER) ;YES.
JEVALY: JRST EVALY ;CHECK CLOSING PARENTHESIS.
SYMBL2: TLZ F0,(STRING) ;FORGET IF WE ARE EVALUATING A STRING.
AOS T2 ;COUNT A SUBSCRIPT.
PUSHJ PP,EVALN ;EVALUATE A NUMERIC SUBSCRIPT.
PUSHJ PP,RFIX ;GET SUBSCRIPT IN FIXED POINT IN MQ
HRLM MQ,(PP) ;SAVE THAT SUBSCRIPT.
CAIN CH,"," ;ANY MORE SUBSCRIPTS?
HPSTPP SYMBL2 ;YES.
;RIGHT HALF OF T2 NOW CONTAINS THE NUMBER OF SUBSCRIPTS.
MOVEI UA,22 ;FIELD WIDTH FOR ALL SUBSCRIPTS IS 18 BITS
IDIVI UA,(T2) ;DIVIDE 18 BITS FAIRLY FOR ALL SUBSCRIPTS
MOVN PC,UA ;GET NEGATIVE BIT SHARE.
HLR MQ,(PP) ;GET THE MOST RECENT SUBSCRIPT.
ROT MQ,(PC) ;PUT ALLOWABLE BITS NEXT TO AC.
LSHC AC,(UA) ;SHIFT THEM INTO AC.
POPJ PP, ;RETURN FOR MORE SUBSCRIPTS.
IFN UA-PC+1,PX PC=UA+1 IS REQUIRED BY IDIVI IN SYMBOL:
;SUBROUTINE TO COLLECT EITHER SYMBOL VALUE OR FUNCTION VALUE.
GETVAL: PUSHJ PP,SYMB$ ;GET LABEL.
MOVEI AA,NFUNCS-1 ;COUNT FUNCTION TABLE.
GETVL0: CAME AC,FNCLST(AA) ;EXACT MATCH?
SOJGE AA,GETVL0 ;NO. CONTINUE TO END OF LIST.
JUMPL AA,GETVL1 ;NOT FOUND MUST BE VARIABLE.
LSHC AC,-107 ;SET MQ=0 IF STRING, MQ=+1 IF NUMBER.
ROT AA,-1 ;TWO ENTRIES PER WORD
SKIPGE AA ;WHICH HALF?
SKIPA AC,FNCTAB(AA) ;RIGHT
HLRZ AC,FNCTAB(AA) ;LEFT
MOVEI MQ,SETSTR(MQ) ;GET ADDRESS OF EITHER SETNUM OR SETSTR
PUSH PP,MQ ;SO WE WILL SET FLAGS AFTER FUNCTION EXIT.
TLNE CC,(LP) ;IS THERE AN ARGUMENT?
PUSH PP,JEVALY ;YES. HANDLE RIGHT-PARENTHESIS.
SKIPE (AC) ;NEVER EXECUTE A NON-EXISTENT FNEW.
PUSH PP,AC ;GO TO FUNCTION AFTER GETTING ARGUMENT.
TLZ F0,(NUMBER!STRING) ;ALLOW EITHER KIND OF ARGUMENT.
TLNE CC,(LP) ;IS THERE AN ARGUMENT IN PARENS?
HPSTP EVAL ;YES. GO GET IT.
JRST ZERANS ;NO. GO TO FUNCTION WITH ZERO ARGUMENT.
GETVL1: PUSHJ PP,SYMBL1 ;INSERT INDEX INTO T2 IF ANY.
JSP PC,FINDSYMBOL ;SCAN THE SYMBOL TABLE.
MOVEI T3,ZERO ;DID NOT FIND A MATCH.
DMOVE AC,@T3 ;COLLECT THE ANSWER.
GETVL2: JUMPL T2,CPOPJ ;STRING VALUE?
SKIPA MQ,BUFH ;YES.
GETVL3: IDPB AA,BUFH ;PLACE NEXT CHARACTER ON THE STRING.
PUSHJ PP,FIT ;ENSURE MORE SPACE AVAILABLE.
ILDB AA,AC ;GET NEXT CHARACTER.
JUMPN AA,GETVL3 ;STORE IF NOT THE END.
JRST GETST3 ;RESTORE BUFH; POINT MQ AT STRING.
;SUBROUTINE TO READ A STRING CONSTANT ON TO THE BUFH AREA.
GETSTR: MOVE MQ,BUFH ;PRESERVE BUFH.
JRST GETST2 ;LEAP OVER THE INITIAL DOUBLE-QUOTE.
GETST1: PUSHJ PP,FIT ;SEE IF IT WILL FIT AN EXTRA CHARACTER.
TLZ F0,(NO.INT) ;TURN ON FLAG IN CASE OF EXIT.
JUMPE CH,GETST3 ;DONE IF EOL.
CAIN CH,42 ;ALSO DONE IF CLOSING DOUBLE-QUOTE.
HPSTP GETST3 ;DONE.
IDPB CH,BUFH ;STORE THE NEXT CHARACTER.
GETST2: TLO F0,(NO.INT) ;TURN OFF FLAG IN CASE "?" IN TEXT.
HOP GETST1 ;GET NEXT CHARACTER.
GETST3: EXCH MQ,BUFH ;POINT TO THE LAST CHARACTER.
MOVE AC,BUFH ;POINT TO FIRST CHARACTER.
SETSTR: TLOA F0,(STRING) ;FLAG THIS AS A STRING.
SETNUM: TLO F0,(NUMBER) ;FLAG IT AS A NUMBER.
TLC F0,(NUMBER!STRING) ;CHANGE BOTH BITS,
TLCN F0,(NUMBER!STRING) ;AND BACK TO ENSURE WE HAVE ONLY ONE ON.
ERROR SYNTAX
POPJ PP,
IF2,<IFN SETSTR+1-SETNUM,PX ERROR AT GETVAL PAGE.>
;ROUTINE TO FIND A LINE.
;CALL: MOVEI AC, LINE REQUIRED.
; PUSHJ PP,FINDLN
; RETURN. NOT FOUND.
; RETURN FOUND.
; WITH AC CONTAINING LINE NUMBER FOUND (LEFT-HALF ZERO).
; (NEXT-HIGHEST IF CAN'T FIND EXACT)
; (777777 IF NO NEXT-HIGHEST)
; AND LINNUM UNCHANGED
; AND MQ POINTING TO THE TEXT OF THE LINE, EXCEPT -1 IF NO LINE FOUND AT ALL.
; AND AA POINTING TO THE INDEX ENTRY.
FINDLN: HRRZ MQ,AC ;RESTRICT TO 18 BITS.
HRRZ AA,INDEX ;MAKE AA POINT TO INDEX TABLE.
FINDL1: HLRZ AC,1(AA) ;PICK OUT LINE NUMBER FROM INDEX TABLE.
CAML AC,MQ ;FOUND THE PLACE YET OR ARE WE PAST IT?
SKIPN 1(AA) ;YES, BUT IGNORE ZERO WORDS IN INDEX...
AOJA AA,FINDL1 ;WHICH REPRESENT DELETED LINES.
CAMN AC,MQ
AOS (PP) ;FOUND. GIVE SKIP RETURN.
SKIPL MQ,1(AA) ;GET POINTER WORD. (WAS IT -1?)
HRLI MQ,(POINT 7,,34) ;SET UP MQ AS A POINTER-WORD.
AOJA AA,CPOPJ
;ROUTINE TO FIND A SYMBOL IN THE SYMBOL TABLE.
;CALL: MOVE T2,[XWD 'NAM',SUBSCRIPT]
; JSP PC,FINDSYMBOL
; ERROR RETURN -- COULD NOT FIND THE SYMBOL. T3 POINTS WHERE NAME SHOULD BE.
; O.K. RETURN -- T3 POINTS TO THE DATA OF THE MATCHING ENTRY.
FINDSY: SETZM @SYMTBL ;PREVENT FALSE FIND IF NULL S.T.
MOVE AA,SYMTBC ;POINT TO TOP OF NAME TABLE.
MOVE UA,SYMTBL ;POINT TO BOTTOM OF NAME TABLE.
SKIPA T3,SYMTBC ;BEGIN LOOKING AT TOP.
FINDS0: ADD T3,UA ;POINT TO NEW PLACE TO TRY.
CAMN T2,@T3 ;MATCH FOUND?
AOJA PC,FINDS9 ;YES.
CAML T2,@T3 ;HAVE WE PASSED THE ENTRY?
SKIPA UA,T3 ;NO.
SKIPA AA,T3 ;YES.
MOVE T3,AA ;PREPARE TO MAKE T3 = AA - UA.
SUB T3,UA ;GET DIFFERENCE.
ASH T3,-1 ;HALVE THE DIFFERENCE.
TRZ T3,WPV*2-1 ;ROUND TO MULTIPLE OF 2 OR 4.
JUMPN T3,FINDS0 ;NO. TRY AGAIN.
SKIPA T3,UA ;SYMBOL NOT FOUND. POINT TO EXPECTED SLOT.
FINDS9: SUBI T3,WPV ;POINT TO THE DATA ENTRY.
JRST 0(PC) ;YES.
;SUBROUTINE TO CONVERT ASCII TO FLOATING POINT.
GETNM: JSPPC PROT26 ;SAVE T2-T6
GETNM0: CAIN CH,"-" ;NEGATIVE SIGN?
PUSH PP,JNEG ;YES. NEGATE IT AFTER WE'VE GOT IT.
CAIE CH,"-" ;ANY SIGN?
CAIN CH,"+" ;ANY SIGN?
HPSTP .+1 ;YES. SKIP IT.
SETZB T2,T3 ;CLEAR LOW ORDER OF RADIX.
SETZB AC,MQ ;CLEAR ANSWER
SOJA T2,GETNM4 ;FLAG "NO DECIMAL POINT SEEN YET"
GETNM1: DMOVEM AC,T4 ;SAVE NUMBER SO FAR
TRZ CH,"a"-"A" ;TRANSLATE LOWER TO UPPER CASE FIRST.
TLNE CC,(N) ;DID WE CLEAR A BIT OF A NUMBER?
ADDI CH,"A"-21 ;YES. FIX AND ADJUST LETTER=NUMBER EQUIV.
MOVEI AC,1-"A"(CH) ;GET NEW DIGIT
HOPP DFLOAT ;MAKE FLOATING POINT
JUMPL T2,GETNM2 ;JUMP IF NO DECIMAL POINT SEEN YET.
IFE <KI+KL-10>*XPV,<DFDV T2,TEN> ;COUNT THE DECIMAL PLACES.
IFN <KI+KL-10>*XPV,<
DEXCH AC,T2 ;GET DECIMAL-PLACE COUNTER,
DFDV AC,TEN ;COUNT IT,
DEXCH AC,T2 ;AND RESTORE IT TO ITS PLACE.
>;END IFN <KI+KL-10>*XPV
DFMP AC,T2 ;GIVE SIGNIFICANCE TO THE NEW DIGIT.
JRST GETNM3 ;GO TO COMBINE THE NEW DIGIT WITH THE NUMBER
GETNM2:
IFE <KI+KL-10>*XPV,<DFMP T4,TEN> ;MULTIPLY THE NUMBER-SO-FAR BY TEN.
IFN <KI+KL-10>*XPV,<
DEXCH AC,T4 ;RESTORE NUMBER SO FAR.
DFMP AC,TEN ;ADJUST THE NUMBER SO FAR.
>;END IFE <KI+KL-10>*XPV
GETNM3: DFAD AC,T4 ;COMBINE.
GETNM4: JUMPL CC,GETNM1 ;CONTINUE IF NEXT CHAR IS ALPHANUMERIC.
CAIN CH,"." ;DECIMAL POINT?
JUMPL T2,[ MOVSI T2,(1.0);SET DECIMAL-POINT-INDICATOR
HOP GETNM4
] ;YES. SET THE "FLAG" IN T2.
TLNN CC,(E) ;EXPONENT INDICATOR?
STEP SETNUM ;NO. MUST BE END OF THE NUMBER.
DPUSH PP,AC ;SAVE THE NUMBER SO FAR.
HOPP GETNM0 ;COLLECT EXPONENT.
PUSHJ PP,ANTILG ;GET 10**EXPONENT.
MUL.: DFMP AC,-XPV(PP) ;RESULT TO TOP OF STACK
JRST OPRXIT ;RETURN.
;SUBROUTINE TO CONVERT FLOATING POINT TO FIXED POINT.
;CALL: PUSHJ PP,FIX WITH ARGUMENT IN AC.
; ANSWER IS RETURNED RIGHT-JUSTIFIED IN AC,MQ.
RFIX:
IFG XPV,< DFAD AC,HALF> ;ROUND UP.
IFLE XPV,< FAD AC,HALF> ;ADD .5 WITHOUT ROUNDING.
FIX: IFE XPV,<MOVM AA,AC> ;GET EXPONENT ...
IFG XPV,<
HLLE AA,AC ;GET EXPONENT ...
TLC AA,(AA) ;...IN POSITIVE FORM...
>;END IFG XPV
ASH AA,-33 ;... INTO AA BITS 28-35
IFG XPV,<IFE KA-10,<ASH MQ,8>> ;REMOVE LOW ORDER EXPONENT.
ASHC AC,8 ;REMOVE HIGH ORDER EXPONENT.
ASHC AC,-306(AA) ;SHIFT TO FIX.
POPJ PP, ;RETURN.
;FUNCTION TO GIVE THE STRING VALUE OF A NUMERIC ARGUMENT.
FCHR$: PUSHJ PP,RFIX ;GET AN INTEGER.
PUSHJ PP,FIT ;ENSURE SPACE FOR THE RESULT.
MOVE AC,BUFH ;GET POINTER TO THE DATA AREA.
EXCH AC,MQ ;PUT POINTER IN MQ.
IDPB AC,MQ ;STORE IT IN DATA AREA.
TLZ F0,(STRING!NUMBER) ;CLEAR FLAGS.
POPJ PP, ;FUNCTION DISPATCHER WILL FIX IT UP FREE.
;FUNCTION TO INPUT OR OUTPUT A SINGLE CHARACTER.
FCHR: JUMPL AC,FCHR1 ;NEGATIVE ARGUMENT MEANS INPUT.
PUSHJ PP,RFIX ;GET ARGUMENT INTO MQ.
OUTCH 0(MQ) ;PRINT A CHARACTER.
JRST PFLOAT ;RETURN WITH AC,MQ UNCHANGED.
FCHR1: INCHR AC ;OTHERWISE INPUT.
;SUBROUTINE TO CONVERT A FIXED POINT NUMBER TO FLOATING POINT.
DFLOAT: ASHC AC,-43 ;MOVE TO STANDARD INTEGER FORMAT.
JRST PFLOAT ;FLOAT A STANDARD WORD.
;SUBROUTINE TO SEPARATE INTEGER INTO AA AND FRACTION INTO AC,MQ.
;DO NOT SEPARATE IF MAGNITUDE IS GREATER THAN 2**35.
;FRACTION IS ALWAYS ZERO OR POSITIVE LESS THAN +1.
FIXOAT: PUSH PP,ZERO ;CLEAR INTEGER RESULT IN CASE SMALL NUMBER.
IFE XPV,<MOVM PC,AC> ;GET MAGNITUDE OF EXPONENT.
IFG XPV,<HLLE PC,AC> ;IN CASE OF DOUBLE-PRECISION,
IFG XPV,<TLC PC,(PC)> ;WE MUST ALLOW FOR -0.500000000000001
ASH PC,-33 ;GET AN EXPONENT FOR RIGHT SHIFTING.
CAIG PC,243 ;WILL THE INTEGER PART FIT 1 WORD?
CAIG PC,200 ;YES. WOULD SMALL # ACCURACY REMAIN?
JRST APOPJ ;NO. DON'T DO THE SEPARATION.
DMOVEM AC,TEMP4 ;SAVE ORIGINAL ARGUMENT.
PUSHJ PP,FIX ;GET INTEGER PART.
MOVEM MQ,(PP) ;SAVE INTEGER PART.
PUSHJ PP,PFLOAT ;PUT INTEGER PART IN FLOATING-POINT FORMAT.
DFSB AC,TEMP4 ;OBTAIN FRACTION PART
NEGATE ACCUM ; IN POSITIVE FORM.
APOPJ: POP PP,AA ;RESTORE AA.
POPJ PP,
;SUBROUTINE TO TYPE LINE NUMBER AS MM.NN
;CALL: MOVE AC,LN
; PUSHJ PP,TYPELN
TYPELN: PUSH PP,AC ;SAVE AC - LINE NUMBER.
LSH AC,-7 ;GET HIGH ORDER PART.
PUSHJ PP,TWOFIG ;TYPE AS TWO FIGURES.
OUTCH "." ;TYPE ".".
POP PP,AC ;RESTORE FOR LOW ORDER PART.
;FALL INTO TWOFIG TO TYPE TWO FIGURES AND RETURN.
;SUBROUTINE TO TYPE C(AC) AS TWO-DIGIT NUMBER.
TWOFIG: ANDI AC,177 ;LIMIT TO TWO DIGITS.
HRLI AA,1 ;SPECIFY TWO DIGITS.
JRST TYPIN0 ;TYPE IN DECIMAL.
SUBTTL FUNCTIONS
DEFINE X(A,B) <
SIXBIT "A"
>;END DEFINE X(A,B)
FNCLST: FNCLIST
;GENERATE HALF WORD DISPATCH TABLE.
XXX=0
DEFINE X (A,B) <
IF2 <IFNDEF B,<EXTERNAL B>>
IFE XXX&1,<DEFINE XX (XXX) < XWD B,XXX>>
IFN XXX&1,<XX B>
XXX=XXX+1
>;END DEFINE X (A,B)
FNCTAB: FNCLIST
IFN XXX&1,<XX 0> ;GENERATE LAST ADDRESS IF ODD NUMBER.
NFUNCS=XXX
SUBTTL FUNCTIONS SINE AND COSINE
COMMENT \
IF THE ARGUMENT IS IN DEGREES, THE PROPER ENTRY POINTS ARE
SIND AND COSD, WHILE IF THE ARGUMENT IS IN RADIANS, THE
PROPER ENTRY POINTS ARE SIN AND COS.
COSD CALLS SIND TO CALCULATE SIND(PI/2+X)
COS CALLS SIN TO CALCULATE SIN (PI/2+X)
SIND CALLS SIN AFTER A CONVERSION FROM DEGREES TO RADIANS.
SINGLE PRECISION SINE AND COSINE
THIS ROUTINE CALCULATES SINES AFTER REDUCING THE ARGUMENT TO
THE FIRST QUADRANT AND CHECKING THE OVERFLOW BITS TO DETERMINE
THE QUADRANT OF THE ORIGINAL ARGUMENT.
000 - 1ST QUADRANT
001 - 2ND QUADRANT
010 - 3RD QUADRANT
011 - 4TH QUADRANT
THE ALGORITHM USES A MODIFIED TAYLOR SERIES TO CALCULATE
THE SINE OF THE NORMALIZED ARGUMENT.
DOUBLE PRECISION SINE AND COSINE
REDUCTION FORMULAE:
1. SIN(X+2N*PI) =SIN(X)
2. SIN(X+PI) =-SIN(X)
3. SIN(PI/2-X) =SIN(PI/2+X)
4. SIN(PI-X) =SIN(X)
\
COSD: DFAD AC,NINETY ;ADD 90 DEGREES.
SIND: DFDV AC,FORTYFIVE ;CONVERT TO OCTANTS.
JRST SIN0 ;ENTER SINE ROUTINE.
COS: DFAD AC,PIOT ;ADD PI/2.
SIN: DFDV AC,PION4 ;COMPUTE X/(PI/4)
SIN0: JSP PC,ODDFNC ;SINE IS AN ODD FUNCTION.
SETOM FOVSUP ;SUPPRESS FLOATING-POINT TRAP MESSAGES.
IFE XPV,<
FSC AC,-1 ;CONVERT TO QUADRANTS.
CAMG AC,ONE ;IS X/(PI/2) .LT. 1.0 ?
JRST SIN2 ;YES,ARG IN 1ST QUADRANT ALREADY.
MULI AC,400 ;NO,SEPARATE FRACTION AND EXP.
ASH MQ,-202(AC) ;GET X MODULO 2PI.
MOVEI AC,200 ;PREPARE FLOATING FRACTION.
ROT MQ,3 ;MOVE QUADRANT BITS FROM 1,2 TO 34,35
LSHC AC,33 ;ARGUMENT NOW IN THE RANGE (-1,1).
DFAD AC,ZERO ;NORMALIZE THE ARGUMENT.
TLCE MQ,5000 ;SUBTRACT 1.0 FROM ARG IF BITS ARE
FSB AC,ONE ;001 OR 011.
TLCE MQ,3000 ;CHECK FOR SECOND QUADRANT, 001.
TLNN MQ,3000 ;CHECK FOR THIRD QUADRANT, 010.
MOVNS AC ;001,010.
SIN2: PUSH PP,AC ;STORE REDUCED ARG.
FMPR AC,AC ;CALCULATE X^2
MOVE MQ,[164475536722] ;GET 1ST CONSTANT.
FMP MQ,AC ;MULTIPLY BY X^2
FAD MQ,[606315546346] ;ADD IN NEXT CONSTANT.
FMP MQ,AC ;MULTIPLY BY X^2.
FAD MQ,[175506321276] ;ADD IN NEXT CONSTANT.
FMP MQ,AC ;MULTIPLY BY X^2.
FADR MQ,[577265210372] ;ADD IN NEXT CONSTANT.
FMPR AC,MQ ;MULTIPLY BY X^2.
FADR AC,PIOT ;ADD IN LAST CONSTANT, PI/2
FMPR AC,0(PP) ;MULTIPLY BY X.
SETZM FOVSUP ;ALLOW ERROR MESSAGES AGAIN.
JRST OPRXIT ;RETURN WITH ANSWER IN AC.
>;END IFE XPV
IFG XPV,<
JSPPC PROT26 ;PROTECT T2-T6
;HERE WITH ARGUMENT POSITIVE IN UNITS OF PI/4.
SIN1: CAMGE AC,[8.0] ;LESS THAN 2*PI?
JRST SIN2 ;YES.
TLZ AC,400 ;NO.SUBTRACT A MULTIPLE OF 2*PI.
DFAD AC,ZERO ;NORMALIZE
JRST SIN1 ;THEN CHECK AGAIN.
;HERE WITH ARGUMENT REDUCED TO RANGE 0 TO 2*PI IN UNITS OF PI/4.
SIN2: PUSHJ PP,FIXOAT ;SEPARATE INTEGER AND FRACTION
HRRZM AA,T2 ;SAVE NUMBER OF OCTANTS IN T2 BITS 33,34,35,
TRZE T2,4 ;QUADRANTS 3 OR 4?
TLC T2,(T2B0) ;YES. USE SIN(X+PI)=-SIN(X)
TRZN T2,1 ;ODD OCTANT?
JRST SIN3 ;NO.
TRC T2,2 ;YES. CHANGE 1 TO 2 AND 3 TO 0
NEGATE ACCUM ;THEN USE THE FORMULA ...
DFAD AC,ONE ;... SIN(PI/2+X)=SIN(PI/2-X)
SIN3: DFMP AC,PION4 ;CHANGE TO MAKE MODULO PI/2
SETZB T5,T6 ;CLEAR THE TERM-COUNTER FOR COSINE-SERIES
TRNN T2,2 ;IS IT A SINE-SERIES?
MOVSI T5,(1.0) ;YES. START TERM-COUNTER AT ONE.
DMOVEM AC,T3 ;FIRST TERM IS X, FOR SINE-SERIES.
DFMP AC,AC ;MAKE X*X
DMOVEM AC,TEMP3 ;STORE X*X
TRNE T2,2 ;IS IT A COSINE SERIES?
IFE XPV*<KI+KL-10>,DMOVE T3,ONE ;YES.
IFN XPV*<KI+KL-10>,<
TDZA T4,T4 ;YES.
SKIPA ;ARE YOU SURE?
MOVSI T3,(1.0) ;YES.
>;END IFN XPV*<KI+KL-10>
DMOVE AC,T3 ;INITIAL TERM EQUALS INITIAL SUM.
SIN4:
IFN XPV*<KI+KL-10>,DEXCH AC,T3 ;RESTORE TERM TO AC,MQ ; SUM TO T3,T4
DFMP AC,TEMP3 ;MULTIPLY LAST TERM BY X*X
FADRI T5,201400 ;INCREMENT TERM-COUNTER.
DFDV AC,T5 ;MAKE TERM WITH FACTORIAL DENOMINATOR.
FADRI T5,201400 ;INCREMENT TERM-COUNTER.
DFDV AC,T5 ;A REAL FACTORIAL.
NEGATE ACCUM ;SUCCESSIVE TERMS HAVE DIFFERENT SIGN.
IFE XPV*<KI+KL-10>,DFAD T3,AC ;ADD TERM TO SUM.
IFE XPV*<KI+KL-10>,MOVM UA,AC ;GET SIZE OF LAST TERM.
IFN XPV*<KI+KL-10>,<
DEXCH AC,T3 ;IF UUO, IT CAN ONLY USE AC,MQ.
DFAD AC,T3 ;ADD TERM TO SUM.
MOVM UA,T3 ;GET SIZE OF LAST TERM.
>;END IFN XPV*<KI+KL-10>
CAML UA,SIN5 ;ENOUGH ITERATIONS?
JRST SIN4 ;NO, LOOP BACK FOR MORE OF SERIES
IFE XPV*<KI+KL-10>,DMOVE AC,T3 ;YES. GET THE SUM.
SETZM FOVSUP ;ALLOW ERROR MESSAGES AGAIN.
JRST ATAN6 ;ADJUST IF NEGATIVE ARGUMENT.
SIN5: ;SIZE OF THE LAST TERM THAT NEED BE ADDED.
IFE XPV,<EXP 186.7 -33B8> ;MAXIMUM 10 TERMS.
IFN XPV,<
IFN KA-10,<EXP 537.4 -76B8> ;MAXIMUM 18 TERMS.
IFE KA-10,<EXP 432.7 -66B8> ;MAXIMUM 16 TERMS.
>;END IFN XPV
>;END IFG XPV
SUBTTL MINOR FUNCTIONS
FHIBER: PUSHJ PP,RFIX ;OBTAIN "SIGNED 36-BIT INTEGER".
CALLI MQ,72 ;HIBERNATE.
CALLI MQ,31 ;SLEEP IF HIBERNATE FAILS.
DMOVE AC,ONE ;SET VALUE FOR NON-EMPTY TTY BUFFER
MOVEI UA,1 ;TRMOP. FUNCTION CODE 0001: SKIP ON BUFFER
MOVE AA,[XWD 2,UA] ;POINT TO ARGUMENT BLOCK.
IFN UA+1-PC,PX INVALID ACCUMULATOR ASSIGNMENTS AT FHIBER:
CALLI PC,30 ;GET JOB NUMBER OF THIS JOB.
CALLI PC,115 ;GET UNIVERSAL I/O INDEX OF THIS JOB'S TTY.
AOSA .JBERR## ;HERE IF JOB IS DETACHED OR TRMNO. NOT LEGAL
CALLI AA,116 ;TRMOP. UUO.: SKIP IF BUFFER NON-EMPTY.
ZERANS: SETZB AC,MQ ;CLEAR BOTH PARTS OF ACCUMULATOR.
ABS: JUMPL AC,NEGANS ;GET MAGNITUDE;THIS OP-CODE USED BY FXUANS.
POPJ PP, ;RETURN
GETAB: PUSHJ PP,RFIX ;GET TABLE NUMBER IN AC,MQ.
PUSH PP,MQ ;SAVE TABLE NUMBER.
PUSHJ PP,SECARG ;GET SECOND ARGUMENT IF ANY.
PUSHJ PP,RFIX ;2ND ARG AS INTEGER.
HRLM MQ,(PP) ;MAKE ARGUMENT FOR GETTAB UUO.
POP PP,AC ;SET ACCUM FOR UUO.
GETTAB AC, ;CALL MONITOR.
AOS .JBERR## ;IGNORE ERROR RETURN.
JRST DFLOAT ;RETURN.
;SUBROUTINE TO READ A SECOND NUMERIC ARGUMENT IF ANY.
SECARG: CAIE CH,"," ;IS THERE A SECOND ARGUMENT?
JRST ZERANS ;NO. RETURN ZERO.
HPSTP EVALN ;YES. GO GET IT & RETURN.
FOCALF: CAMGE AC,CON.23 ;IS ARGUMENT GREATER OR EQUAL 23.?
JRST FOCAL1 ;NO.
PUSHJ PP,RFIX ;YES. CONVERT TO FIXED POINT.
CAMG MQ,.JBREL## ;MEMORY SIZE CHECK.
MOVE AC,(MQ) ;COLLECT A WORD FROM MEMORY.
JRST DFLOAT ;RETURN TO USER.
FOCAL1: DFSB AC,ONE ;MAKE ZERO ARGUMENT GIVE BIT 35.
PUSHJ PP,ANTIL2 ;GET 2**X.
PUSHJ PP,RFIX ;GET A BIT MASK.
PUSH PP,MQ ;SAVE IT.
PUSHJ PP,SECARG ;SECOND ARGUMENT.
POP PP,MQ ;RESTORE BIT MASK.
HRLZI AA,(TRZN F0,(MQ));CREATE AN INSTRUCTION.
SKIPLE AC ;WILL WE SET OR CLEAR THE BIT?
HRLZI AA,(TRON F0,(MQ));SET IT.
MOVEI AC,1 ;ASSUME IT WAS SET ALREADY.
XCT AA ;TEST WITH TRZN OR TRON.
MOVNI AC,1 ;IT WAS PREVIOUSLY CLEAR.
;FALL INTO A RETURN SUBROUTINE.
; SUBTTL FUNCTION SIGN
;OBTAINS +1 IF ARGUMENT IS POSITIVE OR ZERO, -1 IF ARGUMENT IS NEGATIVE
SIGN: JSP PC,ODDFNC ;SIGN IS AN ODD FUNCTION.
DMOVE AC,ONE ;WITH VALUE UNITY.
POPJ PP,
;ROUTINE TO CALL PRIOR TO EVALUATING AN ODD FUNCTION.
;THIS ROUTINE MAKES THE ARGUMENT POSITIVE, AND
;IF IT WAS NEGATIVE IT PUTS A CALL TO NEGANS ON THE STACK FOR LATER.
;COME HERE WITH JSP PC,ODDFNC.
ODDFNC: JUMPGE AC,(PC) ;DO NOTHING IF ARGUMENT WAS POSITIVE.
PUSH PP,JNEG ;MAKE FUNCTION RETURN VIA NEGANS.
PUSH PP,PC ;NEGATE THE ARGUMENT BEFORE RETURNING.
NEGANS:
IFE XPV*<KI+KL-10>,NEGATE ACCUM
IFN XPV*KA,<DFN AC,MQ> ;KA-10 NEGATE.
IFN XPV*KA,<FADL AC,MQ> ;ENSURE NORMALIZED.[EG 576400..,146100..]
IFE XPV*<PDP-10>,<POPJ PP,> ;AND RETURN.
IFN XPV*<PDP-10>,<
SETCMM AC ;NEGATE HIGH ORDER PART
MOVNS MQ ;NEGATE LOW ORDER PART
TLZ MQ,400000 ;CLEAR LOW ORDER BIT 0.
JUMPN MQ,CPOPJ ;IF LOW ORDER WAS ZERO,
AOJA AC,CPOPJ ;THEN MAKE HIGH ORDER TWO'S-COMPLEMENT.
>;END IFN XPV*<PDP-10>
FITR: JSP PC,ODDFNC ;FITR IS AN ODD FUNCTION.
CAML AC,[1.0+<33B8*WPV-<<<KA-10>*XPV>_^D27>>] ;OUT OF RANGE?
POPJ PP, ;YES. 'TIS INTEGER ALREADY.
PUSHJ PP,FIX ;MAKE INTEGER
PFLOAT: ;HERE TO FLOAT AN INTEGER IN AC,MQ
IFE <KA-10>*XPV,<
ASHC AC,8
ASH MQ,-8
FSC MQ,233
IFE PDP-6,<
TDNN MQ,[EXP 777777777] ;I'M NOT SURE IF HARDWARE ALWAYS DOES THIS.
SETZM MQ ;SO BEST TO PLAY SAFE.
>;END IFE PDP-6
SKIPGE MQ ;WAS THE NUMBER NEGATIVE?
AOSE AC ;YES. ADJUST FOR ONES COMPLEMENT IN AC.
>;END IFE <KA-10>*XPV
TLC AC,(<<266-<<KA-10>*XPV>>_^D27>);SIMULATE DOUBLE-PRECISION FSC
IFE XPV,<FADR AC,MQ> ;NORMALIZE THE RESULT
IFN XPV,<DFAD AC,ZERO> ;NORMALIZE THE RESULT.
POPJ PP,
;SUBROUTINE TO GET RECIPROCAL OF A NUMBER.
RECIPR: DMOVEM AC,TEMPR ;SAVE ARGUMENT.
DMOVE AC,ONE ;GET UNITY.
DFDV AC,TEMPR ;CREATE RECIPROCAL.
POPJ PP, ;RETURN.
SUBTTL FUNCTION FRAN
;GENERATES A RANDOM NUMBER BETWEEN 0.5 AND 1.
;THE ARGUMENT IS USED TO DETERMINE THE TYPE OF RANDOM NUMBER...
; NEGATIVE - TRUE RANDOM.
; POSITIVE - INITIALIZE THE PSEUDO-RANDOM GENERATOR.
; ZERO - NEXT PSEUDO-RANDOM NUMBER.
FRAN: JUMPG AC,FRAN2 ;POSITIVE - INIT PSEUDO-#.
JUMPE AC,FRAN1 ;ZERO - NEXT #.
;HERE FOR TRUE RANDOMNESS!
MSTIME AC, ;TIME-OF-DAY RANDOMIZER.
TSC AC,AC ;EXPAND TO BOTH HALVES.
ROT AC,(AC) ;STIR WELL.
IFN XPV*KA,<
TLZ MQ,777000 ;FIX EXPONENT
TLO MQ,145000 ;TO MAKE DOUBLE PRECISION NORMALIZED
>;END IFN XPV*KA
TLZ AC,577000 ;FIX EXPONENT
TLO AC,200400 ;TO BE IN RANGE 0.5 TO 1.0.
FRAN1: DFAD AC,OLDRAN ;ADD REST OF INGREDIENTS.
SKIPN AC ;SKIP EXCEPT FIRST TIME.
FRAN2: DMOVE AC,FSTRAN ;INIT PSEUDO-#.
DFMP AC,FACTOR ;MOVE ALONG THE SERIES.
PUSHJ PP,FIXOAT
CAMGE AC,HALF ;CHECK TO ENSURE
DFAD AC,HALF ;ANSWER IS IN RANGE 0.5 TO 1.0
DMOVEM AC,OLDRAN ;LEAVE TRAIL FOR NEXT #.
POPJ PP,
FACTOR:
CON.23: DATA 23.0,0
SUBTTL FUNCTION ATAN
COMMENT \
THE REDUCTION FORMULAE ARE:
FOR X LESS THAN ZERO, WE USE THE IDENTITY
ATAN(X) = -ATAN(-X)
FOR X GREATER THAN 1.0, WE USE THE IDENTITY
ATAN(X) = PI/2 - ATAN(1/X)
FOR X BETWEEN (2-(3^.5)) AND 1.0, WE USE THE IDENTITY
ATAN(X) = PI/6 + ATAN((X*(3^.5)-1)/(X+(3^.5)))
FOR X LESS THAN SQRT(3)*2**-27, ATAN(X)=X IS USED
THE POWER SERIES IS:
Z=X*X/(1+X*X)
ATAN(X)=Z/X * (1+(2/3)*Z * (1+(4/5)*Z * (1+(6/7)*Z * (.....))))
WHERE THE INNERMOST FACTOR IS 1+N/(N+1)*X, AND
N IS ROUGHLY 3+B/2, WHERE
B IS THE NUMBER OF BITS IN THE MANTISSA OF A NUMBER.
\
ATAN: JSPPC PROT26 ;PROTECT T2-T6
T2B0==1B0 ;BIT 0 OF ACCUMULATOR T2.
T2B1==1B1 ;BIT 1 OF ACCUMULATOR T2.
T2B2==1B2 ;BIT 2 OF ACCUMULATOR T2.
JSP PC,ODDFNC ;ATAN IS AN ODD FUNCTION.
HRLI T2,(T2B0!T2B1) ;SET TWO FLAG BITS IN CASE ARG.GE.1.
CAMGE AC,ONE ;ARGUMENT LESS THAN UNITY?
TLZA T2,(T2B0!T2B1) ;NO. CLEAR THE FLAGS.
PUSHJ PP,RECIPROCAL ;YES. LEAVE THE FLAGS AND INVERT ARGUMENT
DMOVEM AC,TEMP1 ;SAVE THE REDUCED ARGUMENT.
CAMGE AC,[0.2679491924311] ;IS ARG .GE. (2-(3^.5))?
JRST ATAN2 ;NO, PROCEED WITH ALGORITHM
TLO T2,(T2B2) ;SET FLAG TO LATER ADD ATAN(1/(3^.5))
DFAD AC,ROOT3 ;COMPUTE X+(3^.5)
IFN <XPV-1>!<KI+KL-10>,DEXCH AC,TEMP1 ;GET X, SAVE X+(3^.5)
IFE <XPV-1>!<KI+KL-10>,EXCH AC,TEMP1 ;GET X, SAVE X+(3^.5)
IFE <XPV-1>!<KI+KL-10>,EXCH MQ,TEMP1+1 ;GET X, SAVE X+(3^.5)
DFMP AC,ROOT3 ;COMPUTE (3^.5)*X
DFSB AC,ONE ;COMPUTE (3^.5)X-1
DFDV AC,TEMP1 ;COMPUTE ((3^.5)X-1)/(X+(3^.5))
DMOVEM AC,TEMP1 ;AND SAVE.
ATAN2: MOVM AA,AC ;ALLOW NEGATIVE ARGUMENT AT THIS STAGE
CAMGE AA,SMALL ;CAN ATAN(X)=X?
JRST ATAN5 ;YES
DFMP AC,AC ;COMPUTE X*X
DMOVEM AC,T3 ;SAVE X*X IN T3
DFAD AC,ONE ;COMPUTE 1+X*X
IFN XPV*<KI+KL-10>,<
DEXCH AC,T3 ;GET X*X
DFDV AC,T3 ;GET X*X/(1+X*X)
DMOVEM AC,T3 ;SAVE X*X/(1+X*X) IN T3
>;END IFN XPV*<KI+KL-10>
IFE XPV*<KI+KL-10>,<
DFDV T3,AC ;GET X*X/(1+X*X) IN T3
DMOVE AC,T3 ;GET X*X/(1+X*X)
>;END IFE XPV*<KI+KL-10>
GETT5 DATANCOUNT
IFG XPV,<SETZM T6> ;CREATE DOUBLE PRECISION #.
ATAN4: FSBRI T5,201400 ;DECREMENT NUMERATOR.
DFDV AC,T5 ;CREATE FACTOR...
FSBRI T5,201400 ;DECREMENT NUMERATOR.
JUMPLE T5,ATAN4A ;EXIT IF DONE.
DFMP AC,T5 ;...
DFAD AC,ONE ;TO MAKE 1+N/(N+1)*(...)
DFMP AC,T3 ;... Z*(1+N/(N+1)*(...)
JRST ATAN4 ;LOOP UNTIL DONE.
ATAN4A: DFDV AC,TEMP1 ;FINALLY DIVIDE BY X.
ATAN5: TLNE T2,(T2B2) ;ADD ATAN(1/(3^.5))?
DFAD AC,PION6 ;YES.
TLNE T2,(T2B1) ;ADD -PI/2?
DFSB AC,PIOT ;YES.
ATAN6: JUMPGE T2,CPOPJ ;NEGATE RESULT?
JNEG: JRST NEGANS ;YES.
SUBTTL FUNCTION SQRT
COMMENT \
THE SQUARE-ROOT FUNCTION IS COMPUTED AS THE ANTILOG OF HALF
THE LOGARITHM OF THE ARGUMENT. IF THE ARGUMENT IS ZERO, HOWEVER,
IT MUST BE TREATED AS A SPECIAL CASE BECAUSE IT IS ILLEGAL TO TAKE
THE LOGARITHM OF ZERO.
\
SQRT: SKIPGE AC ;NEGATIVE ARGUMENT?
ERROR ILSQRT ;YES. ERROR.
JUMPE AC,CPOPJ ;STRAIGHT RETURN ON ZERO ARGUMENT
PUSHJ PP,LOG ;GET LOG(X)
HALVE ACCUM ;GET 0.5*LOG(X)
; JRST EXP ;GET EXP(0.5*LOG(X)) AND RETURN.
IF2 < IFN EXP-.,PX ERROR IN SQRT EXIT>
SUBTTL FUNCTION EXP
COMMENT \
THE REDUCTION FORMULAE ARE:
IF X IS LESS THAN -89.415...,THE PROGRAM RETURNS ZERO AS THE ANSWER
IF X IS GREATER THAN 88.029...,THE PROGRAM RETURNS 377777777777 AS THE ANSWER
THENCE:
EXP(X) = 2**(X*LOG2(E))
= 2**(M+F) WHERE M IS AN INTEGER AND F LIES BETWEEN 0 AND 1.
= 2**M * EXP(F*LOGE(2))
2**M IS CALCULATED EASILY WITH THE FLOATING SCALE INSTRUCTION.
FINALLY, EXP(F*LOG(2)) IS CALCULATED BY A CONTINUED FRACTION
Z=F*LOGE(2)
EXP(Z)=1+Z/((1-Z/2)+Z*Z/4/3/(1+(Z*Z/4/15/(1+Z*Z/4/35/(1+.....Z*Z/4/(4*N*N-1)/(1+.....))))))
\
EXP: DFMP AC,DLOG2E ;ENTER HERE TO FIND E**AC.
;HERE TO CHECK ARGUMENT RANGE ;ENTER HERE TO FIND 2**AC.
ANTIL2: CAMGE AC,[-129.0] ;CHECK LIMITS.
JRST FXUANS ;VERY SMALL - SAY ZERO
CAML AC,[127.0] ;CHECK.
JRST FOVANS ;VERY LARGE - SAY INFINITY.
;HERE TO SEPARATE INTEGER PART FROM FRACTION PART.
PUSHJ PP,FIXOAT ;SEPARATE INTEGER FROM FRACTION
HRRZM AA,TEMP3 ;STORE INTEGER PART
;HERE WITH F IN AC
SETOM FOVSUP ;SUPPRESS FLOATING-POINT TRAP.
DFDV AC,DLOG2E ;MULTIPLY BY LOGE(2) TO GET Z.
DMOVEM AC,TEMP1 ;SAVE Z IN TEMP1
HALVE ACCUM ;MAKE Z/2
DMOVEM AC,TEMP2 ;SAVE Z/2
DFMP AC,AC ;MAKE Z^2/4.
DMOVEM AC,TEMPE ;SAVE Z^2/4.
JSPPC PROT26 ;PROTECT T2 THRU T6.
IFG XPV,<SETZB T3,T6> ;CLEAR HIGH ORDER PARTS.
MOVEI T4,3+XPV*<4-KA/10> ;GET ITERATION COUNTER, N.
MOVSI T2,(1.0) ;GET ONE INTO T2,T3.
EXP1: MOVE T5,T4 ;GET N INTO T5.
ADD T5,T5 ;GET N*2.
IMUL T5,T5 ;GET 4*N*N.
SOS T5 ;GET 4*N*N-1
FSC T5,233 ;GET IT IN FLOATING-POINT IN T5,T6.
DMOVE AC,TEMPE ;GET Z^2/4.
DFDV AC,T5 ;GET Z^2/4/(4*N*N-1).
DFDV AC,T2 ;GET Z^2/4/(4*N*N-1)/(1+...)
DFAD AC,ONE ;GET (1+Z^2/4/(4*N*N-1)/(1+...))
DMOVEM AC,T2 ;SAVE FOR NEXT ITERATION.
SOJG T4,EXP1 ;CONTINUE UNTIL DONE.
IFE XPV*<KI+KL-10>,DFSB T2,TEMP2 ;SUBTRACT Z/2.
IFN XPV*<KI+KL-10>,<
DFSB AC,TEMP2 ;SUBTRACT Z/2.
DMOVEM AC,T2 ;SAVE IN TEMPORARY STORAGE.
>;END IFN XPV*<KI+KL-10>
DMOVE AC,TEMP1 ;GET Z.
DFDV AC,T2 ;GET Z/(1-Z/2+Z^2/4/3...)
DFAD AC,ONE ;GET EXP(Z).
FSC AC,@TEMP3 ;SCALE RESULTS
IFN KA*XPV,<FSC MQ,@TEMP3> ;SCALE LOW ORDER.
IFN KA*XPV,<FADL AC,MQ> ;ENSURE THE ANSWER IS NORMALIZED.
SETZM FOVSUP ;ALLOW FLOATING POINT TRAP.
POPJ PP,
SUBTTL FUNCTIONS LOG,LOG10
COMMENT \
LOG IS THE ENTRY POINT FOR LOGE(X),AND
LOG10 IS THE ENTRY POINT FOR LOG10(X).
LOG10(X) IS COMPUTED BY MULTIPLYING LOGE(X) BY LOG(10) TO BASE E.
NEGATIVE ARGUMENTS ARE (TO HELP THE USERS) TREATED AS POSITIVE.
A ZERO ARGUMENT GIVES A FLOATING-OVERFLOW ERROR MESSAGE.
METHOD.
LOGE(X) IS TREATED BY FIRST COMPUTING LOG2(X) THEN MULTIPLYING BY LOG(2) TO BASE E.
LOG2(X) IS COMPUTED IN THE FOLLOWING STEPS:
1. EXTRACT THE EXPONENT OF X. IT WILL BE THE INTEGER PART OF THE RESULT.
2. OBTAIN SUCCESSIVE BITS OF THE FRACTION-PART OF THE RESULT BY
SUCCESSIVELY MULTIPLYING X BY X AND EXTRACTING THE EXPONENT.
3. COMBINE THE INTEGER AND FRACTION BITS OF THE RESULT.
\
LOG10: PUSHJ PP,LOG ;FIND LOG TO BASE E.
DFMP AC,LOG10E ;CONVERT TO BASE 10.
POPJ PP, ;RETURN
LOG: JUMPE AC,FOVANS ;LOG OF ZERO IS INFINITY.
PUSHJ PP,ABS ;AS A SOP TO THE USERS: MAKE IT POSITIVE.
JSPPC PROT23 ;PRESERVE T2,T3.
LDB <T2+XPV>,[POINT 8,AC,8] ;PICK UP EXPONENT FROM HIGH ORDER
IFG XPV,<SETZM T2> ;CLEAR THE RESULT POSITION HIGH PART.
TRO <T2+XPV>,400_<KA*XPV> ;SET A FLAG BIT TO STOP THE ITERATION.
TLZ AC,576000 ;CLEAR EXPONENT TO 201.
IFN XPV*KA,<TLO MQ,146000> ;SET EXPONENT LOW ORDER TO 146.
DLOG2:
IFN XPV*KA,<TLZ MQ,631000> ;CLEAR EXPONENT LOW ORDER TO 146.
TLO AC,201000 ;SET EXPONENT TO 201.
DFMP AC,AC ;MULTIPLY X BY X.
DLSH T2,1 ;MAKE SPACE FOR ONE BIT IN RESULT.
TLZE AC,002000 ;IS X*X GREATER THAN 2.0?
TRO <T2+XPV>,1 ;YES. ADD A BIT TO THE RESULT.
JUMPGE T2,DLOG2 ;LOOP TO COMPLETE THE RESULT.
DLSH T2,1+<KA*XPV> ;CLEAR ITERATION FLAG.
TLC T2,(1B0) ;EFFECTIVELY SUBTRACT 200 FROM EXPONENT.
IFG XPV,<LSH T3,-1> ;CLEAR BIT ZERO OF LOW ORDER WORD.
DMOVE AC,T2 ;GET INTEGER FORM OF RESULT IN AC,MQ.
SKIPGE T2 ;PREPARE FOR JFFO.
SETCMM T2 ;IN CASE OF NEGATIVE RESULT, COUNT LEADING 1'S
IFE PDP-10,<JFFO T2,DLOG3> ;COUNT LEADING ZEROES.
IFN PDP-10,<
SETZM T3 ;PDP-6 DOESN'T HAVE JFFO.
JUMPN T2,[ AOS T3 ;COUNT THE LEADING ZEROES SLOWLY
LSH T2,1 ;AND CAREFULLY.
JUMPG T2,@. ;UNTIL NONE LEFT.
JRST DLOG3] ;THEN CONTINUE.
>;END IFN PDP-10
MOVEI T3,44 ;ASSUME AT LEAST 36 DECIMAL LEADING ZEROES.
DLOG3: DASH AC,-9(T3) ;BRING MOST SIGNIFICANT BIT TO BIT 9 POSN.
IMULI T3,777000 ;NEGATE AND SHIFT THE #-ZEROES ADJUSTMENT.
TLC AC,210000(T3) ;DO FSC WITHOUT NORMALIZE.
IFN XPV*KA,<LSH MQ,-8> ;CLEAR LOW ORDER EXPONENT.
IFN XPV*KA,<TLZ MQ,777000> ;CLEAR LOW ORDER EXPONENT.
IFN XPV*KA,<TLO MQ,155000(T3)> ;DO SAME ON LOW ORDER FOR KA-10.
IFN XPV*KA,<FADL AC,MQ> ;NORMALIZE.
DFSB AC,ONE ;COMPLETE THE SUBTRACTION OF EXPONENT 201
DFDV AC,DLOG2E ;COMPUTE N*LOGE(2)
POPJ PP,
SUBTTL DATA AREA
MONTHS: ASCIZ "Jan-"
ASCIZ "Feb-"
ASCIZ "Mar-"
ASCIZ "Apr-"
ASCIZ "May-"
ASCIZ "Jun-"
ASCIZ "Jul-"
ASCIZ "Aug-"
ASCIZ "Sep-"
ASCIZ "Oct-"
ASCIZ "Nov-"
ASCIZ "Dec-"
CRLF: IFG MONITOR-3.27,<
ASCIZ "
"
>;END IFG MONITOR-3.27
IFLE MONITOR-3.27,<
ASCIZ "
"
>;END IFLE MONITOR-3.27 ;OLD MONITORS DO NOT PROVIDE FILLERS FOR CR.
CONUCR:IFG MONITOR-3.27,<
ASCIZ "^U
"
>;END CONUCR:IFG MONITOR-3.27
IFLE MONITOR-3.27,<
ASCIZ "^U
"
>;END IFLE MONITOR-3.27
FSTRAN: ;FIRST RANDOM NUMBER.
LOG10E: DATA 177674557305,111562416145 ;LOG E, BASE 10 =.43429448190325182765
DLOG2E: DATA 201561250731,112701376057 ;LOG E, BASE 2 = 1.44269 50408 88963 40740
PIOT: DATA 201622077325,021026430215 ;PI/2 = 1.57079 63267 94896 61923
PION4: DATA 200622077325,021026430215 ;PI/4
SMALL: EXP 1.73205080756887-33B8+<KA-10>_^D27 ;SO THAT Z^2/3 IS INSIGNIFICANT.
PION6: DATA 200414052216,013271545411 ;PI/6
NINETY: DATA 90.0,0
FORTYF: DATA 45.0,0.0 ;FORTY-FIVE DEGREES = ONE OCTANT.
ROOT3: DATA 201673317272,026046252347 ;SQRT(3)=1.73205 08075 68877 2935
TEN: DATA 10.0,0
ONE: DATA 1.0,0
HALF: 0.5
ZERO: DATA 0,0
CODEND:
END ONCE