3648 lines
67 KiB
Plaintext
3648 lines
67 KiB
Plaintext
/**** FOCAL 5/69 ****
|
||
/E.A.TAFT - REVISION OF FOCALW 8/68 /EAT/ 25-JUL-72
|
||
|
||
|
||
|
||
|
||
|
||
/ASSEMBLY INSTRUCTIONS FOR DECUS VERSION:
|
||
|
||
/INPUT FILES:
|
||
/ FOCAL.569 FOCAL LANGUAGE PROCESSOR
|
||
/ FLOAT.569 FLOATING POINT PACKAGE
|
||
/ EXTEND.569 EXTENDED FUNCTION PACKAGE
|
||
/ 2USER.569 2-USER OVERLAY
|
||
|
||
/ASSEMBLY USING PAL10 V.141
|
||
/ .R PAL10
|
||
/ *FOCAL.BIN_FOCAL.569,FLOAT.569
|
||
/ *EXTEND.BIN_EXTEND.569
|
||
/ *2USER.BIN_2USER.569
|
||
/ *^C
|
||
/ .R PIP
|
||
/ *FOCAL.BIN/B_FOCCAL.BIN,EXTEND.BIN,2USER.BIN
|
||
/ *PTP:/I_FOCAL.BIN
|
||
|
||
/WHEN READ-IN ON A PDP-8, THE LOADER WILL STOP 3 TIMES. THE FIRST
|
||
/ SECTION CONTAINS THE BASIC PROCESSOR AND FLOATING POINT PACKAGE.
|
||
/ THE SECOND SECTION CONTAINS THE EXTENDED FUNCTIONS. THE LAST
|
||
/ SECTION CONTAINS THE 2-USER OVERLAY (REQUIRES 2 TERMINALS AND 8K).
|
||
|
||
/PROCESSOR INSTRUCTIONS
|
||
FIXMRI AND=0000
|
||
FIXMRI TAD=1000
|
||
FIXMRI ISZ=2000
|
||
FIXMRI DCA=3000
|
||
FIXMRI JMS=4000
|
||
FIXMRI JMP=5000
|
||
/FLOATING POINT INSTRUCTIONS
|
||
FIXMRI FPW=0000
|
||
FIXMRI FAD=1000
|
||
FIXMRI FSB=2000
|
||
FIXMRI FMY=3000
|
||
FIXMRI FDV=4000
|
||
FIXMRI FGT=5000
|
||
FIXMRI FPT=6000
|
||
|
||
FNR=7000
|
||
FEXT=0
|
||
FENT=JMS I 7
|
||
NOP=7000
|
||
CLA=7200
|
||
CLL=7100
|
||
CMA=7040
|
||
RAL=7004
|
||
CML=7020
|
||
RAR=7010
|
||
RTR=7012
|
||
RTL=7006
|
||
IAC=7001
|
||
SMA=7500
|
||
SZA=7440
|
||
SPA=7510
|
||
SNA=7450
|
||
SNL=7420
|
||
SZL=7430
|
||
SKP=7410
|
||
CIA=7041
|
||
ION=6001
|
||
IOF=6002
|
||
KSF=6031
|
||
KRB=6036
|
||
TSF=6041
|
||
TCF=6042
|
||
TPC=6044
|
||
TLS=6046
|
||
RSF=6011
|
||
RRB=6012
|
||
RFC=6014
|
||
|
||
/ * FOCAL * - BY RICK MERRILL - FOR THE FAMILY OF 8.
|
||
/REVISED BY EDWARD TAFT 5/69
|
||
|
||
/MISCELLANEOUS ITEMS
|
||
*1
|
||
JMP I .+1 /INTERRUPT PROCESSOR ENTRY
|
||
INTRPT
|
||
MINUSA, -301 /CONSTANT
|
||
FNEGSW, 0 /USED FOR CALCULATING SIGNS
|
||
P13, 13 /CONSTANT
|
||
C100, 100 /CONSTANT
|
||
FPNT /ADDRESS OF FLOATING POINT INTERPRETER.
|
||
|
||
/AUTO-INDEX REGISTERS
|
||
|
||
AXIN, 0 /STORAGE INDEX
|
||
XRT, 0 /EXTRA XR
|
||
XRT2, 0 /EXTRA XR
|
||
PDLXR, 0 /PUSHDOWN LIST INDEX REGISTER.
|
||
FLTXR, IOBUF-1 /XR15 FOR FLOATING POINT
|
||
C200, 200 /CONSTANT
|
||
XRT3, 0 /USED BY PUSHDOWN LIST CONTROLS
|
||
|
||
|
||
TEXTP=. /TEXT POINTERS
|
||
AXOUT, FRSTX /OUTPUT INDEX
|
||
XCT, 0 /UNPACK SWITCH
|
||
GTEM, 0 /UNPACK STORAGE
|
||
|
||
/NUMBERS
|
||
|
||
PER, 256 /PERIOD
|
||
M77, -77 /RIGHT MASK
|
||
P7600, 7600 /GROUP MASK
|
||
M20, -20 /CONSTANT
|
||
P177, 177 /STEP MASK
|
||
BOTTOM, DBCONV-1/END OF TEXT BUFFER
|
||
FLOAT= JMS I . /FLOAT C(AC) SUBROUTINE
|
||
XFLOAT
|
||
P17, 17 /BCD MASK
|
||
P277, 277 /"?"
|
||
C240, 240 /SPACE
|
||
M2, -2 /CONSTANT
|
||
P2, 2 /CONSTANT
|
||
C260, 260 /ASCII FOR ZERO
|
||
HINBUF, 0 /HIGH SPEED INPUT BUFFER
|
||
|
||
FLOP=. /FLOATING OPERAND STORAGE
|
||
FLOP0, 0
|
||
FLOP1, 0
|
||
FLOP2, 0
|
||
FLOP3, 0
|
||
FLAC=. /FLOATING POINT ACCUMULATOR
|
||
FLAC0, 0
|
||
FLAC1, 0
|
||
FLAC2, 0
|
||
FLAC3, 0
|
||
NEGATE= JMS I . /NEGATE FLAC ROUTINE
|
||
NEGAC
|
||
TOTDIG, 10 /TOTAL DIGITS IN OUTPUT FIELD
|
||
FIX= JMS I . /FIX FLAC ROUTINE
|
||
XFIX
|
||
TABCTR, 0 /CARRIAGE INDEX
|
||
|
||
/CONSTANTS
|
||
|
||
|
||
LIST6=. /INPUT LIST FOR "SFOUND".
|
||
P337, 337 /LEFT ARR
|
||
214 /F.F.
|
||
207 /BELL
|
||
CLF, 212 /L.F.
|
||
LIST3=. /EXCRETION LIST
|
||
CCR, 215 /LIST BRANCHER.
|
||
0 /SEARCH CHARACTER (VARIABLE)
|
||
|
||
M100=.
|
||
P7700, 7700 /LEFT MASK
|
||
M240, -240 /SPACE TEST
|
||
MPER, -256 /PERIOD TEST
|
||
MCR, -215 /C.R. TEST
|
||
MFLT=. /3-WORD FLOATING POINT
|
||
M3, -3
|
||
M5, -5 /PAREN TEST
|
||
M11, -11 /PAREN TEST
|
||
P77, 77 /RIGHT MASK
|
||
|
||
FOUTPUT,BDCONV /FLOATING OUTPUT
|
||
FINPUT, DBCONV /FLOATING INPUT
|
||
COMBUF, COMEIN /COMMAND BUFFER`START
|
||
CFRS, FRST /ADDRESS OF DUMMY LINE.
|
||
END, BUFBEG /FIRST LOCATION USED.
|
||
ENDT, BUFBEG /START OF STORAGE AREA **
|
||
RETURN= JMP I . /FUNCTION RETURN
|
||
EFUN3I, EFUN3
|
||
|
||
/NEW INSTRUCTIONS:
|
||
|
||
PUSHJ=JMS I . /RECURSIVE SUBROUTINE CALL
|
||
XPUSHJ
|
||
POPA=TAD I PDLXR/RESTORE AC
|
||
POPJ=JMP I . /SUBROUTINE RETURN
|
||
XPOPJ
|
||
PUSHA=JMS I . /SAVE AC
|
||
XPUSHA
|
||
PUSHF=JMS I . /SAVE GROUP OF DATA
|
||
PD2
|
||
POPF=JMS I . /RESTORE GROUP
|
||
PD3
|
||
GETC=JMS I . /UNPACK A CHARACTER
|
||
UTRA
|
||
PACKC=JMS I . /PACK A CHARACTER
|
||
PACBUF
|
||
SORTJ=JMS I . /SORT AND BRANCH ON AC OR CHAR
|
||
SORTB
|
||
SORTC=JMS I . /SORT CHAR
|
||
XSORTC
|
||
PRINTC=JMS I . /PRINT AC OR CHAR
|
||
OUT
|
||
READC=JMS I . /READ ASR-33 INTO CHAR AND PRINT IT
|
||
CHIN
|
||
PRNTLN=JMS I . /PRINT C(LINENO)
|
||
XPRNTL
|
||
GETLN=JMS I . /UNPACK AND FORM A LINENUMBER
|
||
XGETLN
|
||
FINDLN=JMS I . /SEARCH FOR A GIVEN LINE
|
||
XFIND
|
||
ENDLN=JMS I . /INSERT LINE POINTERS
|
||
XENDLN
|
||
RTL6=JMS I . /ROTATE LEFT SIX
|
||
XRTL6
|
||
SPNOR=JMS I . /IGNORE SPACES AND LEADING ZEROS
|
||
XSPNOR
|
||
TESTN=JMS I . /PERIOD; OTHER; NUMBER
|
||
XTESTN
|
||
TSTLPR=JMS I . /SKIP IF 5<SORTCN<= 11 (I.E. AN L-PAR)
|
||
LPRTST
|
||
TSTGRP=JMS I . /SKIP IF G(AC) = G(LINENO)
|
||
GRPTST
|
||
TESTC=JMS I . /TERM; NUMBER; FUNCTION; LETTER
|
||
XTESTC
|
||
ERROR=JMS I . /GENERAL ERROR ROUTINE
|
||
ERR2
|
||
|
||
|
||
SORTCN, 0 /NUMBER IN TABLE`FROM SORTC
|
||
LASTOP, 0 /LAST OPERATION FOR EVAL
|
||
EFOP=. /FUNCTION CODE.
|
||
ATSW, 0 /ASK-TYPE SWITCH
|
||
CNTR, -20 /DELETE AND ERROR COUNTER(USED BY F.P. ALSO)
|
||
|
||
DECP, 4 /NUMBER OF DECIMAL POINTS
|
||
|
||
STARTV=. /=END FOR 8K
|
||
|
||
BUFR, BUFBEG /NEXT LOCATION IN BUFFER = LAST LOCATION OF TEXT.
|
||
|
||
ADD, 0 /CHAR BUF INPUT
|
||
XCTIN, 0 /PACK SWITCH
|
||
OUTDEV, XOUTL /OUTPUT SUBROUTINE
|
||
INDEV, XI33 /INPUT SUBROUTINE
|
||
|
||
NAGSW, 0001 /NOT ALL AND/OR GROUP SWITCH (4000=ONE;1=ALL;0=GROUP)
|
||
CHAR, 215 /THE MOST IMPORTANT REGISTER
|
||
LINENO, 0000 /LINE NUMBER READ BY GETLN
|
||
GINC, 5 /WORDS TO STORE 1 VARIABLE
|
||
|
||
PC, FLTZER /PROGRAM COUNTER
|
||
THISLN, 0 /LINE POINTER FROM 'FINDLN'
|
||
THISOP, 0 /CURRENT 'EVAL' OPERATION
|
||
LASTLN, 0 /BACK POINTER FROM 'FINDLN'
|
||
DEBGSW, 1 /DEBUG SWITCH ; NON-ZERO FOR LITERAL.
|
||
DMPSW, 1 /=0 FOR TRACE ON.
|
||
PACKST, 0 /RUBOUT PROTECTION
|
||
PT1, 0 /VARIABLE POINTER
|
||
LASTV, BUFBEG /ADDRESS OF LAST VARIABLE
|
||
T1, 0 /TEMPORARY REGISTER - MAIN
|
||
T2, 0 /TEMP REGISTER - FOR NEW INST. ROUTINES.
|
||
FLARGP, FLARG /DATA ADDRESS
|
||
PTCH, CHIN /GENERAL CHARACTER INPUT ROUTINE.
|
||
/USED BY NEW FLOATING PT. PACKAGE
|
||
TEMP1, 0
|
||
TEMP2, 0
|
||
TEMP3, 0
|
||
TSTERM= JMS I . /TEST FOR ,;CR
|
||
XTSTER /RETURNS: OTHER, ; OR CR, COMMA
|
||
DIGITS=6 /SIGNIFICANT DIGITS
|
||
/FOCAL'S COMMAND/INPUT DRIVER
|
||
|
||
*176
|
||
BEGIN /(RECOVR+1 AFTER INITIALIZATION)
|
||
START, SKP CLA /PROGRAM START FROM SELF
|
||
JMP I .-2 /CONSOLE START: SW=200.
|
||
TAD CFRSX /(PC) => 0
|
||
DCA PC /FOR COMMAND MODE
|
||
DCA DEBGSW /ENABLE TRACE FOR INPUT OF (?).
|
||
TAD COMBOT /PROTECT COMMAND BUFFER.
|
||
DCA PDLXR /NO PATCH TEST.
|
||
ISZ DMPSW /INIT UNPACK AND TRACE SWITCH.
|
||
DCA LIST3+1 /CLEAR SEARCH CHARACTER FOR INPUT.
|
||
TAD P337 /ANNOUNCE PRESENCE
|
||
PRINTC /BY TYPING THE LEAD-IN CHARACTER
|
||
IBAR, TAD COMBUF /INITIALIZE COMMAND BUFFER
|
||
DCA AXIN /FOR UNPACKING.
|
||
DCA XCTIN
|
||
TAD COMBUF /RUBOUT PROTECTION
|
||
DCA PACKST
|
||
IGNOR, READC /READ COMMAND STRING
|
||
SORTJ
|
||
LIST6-1
|
||
INLIST-LIST6
|
||
PACKC /SAVE STRING CHARACTER.
|
||
JMP IGNOR
|
||
/////
|
||
P4000, 4000 /LINE NUMBER TEST
|
||
COMBOT, COMOUT+12 /END OF COMMAND BUFFER,LESS PROTECTION COUNT.
|
||
CFRSX, FLTZER /POINTER FOR PC=COMMAND OR INPUT
|
||
/////
|
||
/COMMAND/INPUT PROCESSOR
|
||
|
||
IRETN, PACKC /START TO PACK C.R.
|
||
PACKC /FINISH C.R.
|
||
TAD COMBUF /INITIALIZE "TEXTP"
|
||
GONE, DCA AXOUT /SETUP CURRENT LINE
|
||
DCA XCT
|
||
GETC /READ FIRST CHARACTER.
|
||
TAD BOTTOM /INIT PUSH-DOWN-LIST
|
||
DCA PDLXR
|
||
SPNOR /IGNORE LEADING BLANKS
|
||
TESTN /DOES THE LINE BEGIN WITH 1-9?
|
||
ERROR4 /ILLEGAL GROUP ZERO USAGE
|
||
JMP INPUTX /NO
|
||
IOF /YES,STOP INPUT MOMENTARILY.
|
||
ISZ DEBGSW /DISABLE TRACE FOR REPACKING
|
||
GETLN /READ THIS LINE NUMBER
|
||
TAD NAGSW
|
||
TAD P4000 /TEST FOR SINGLE LINE
|
||
SZA CLA
|
||
ERROR3 /ILLEGAL LINE NUMBER ON INPUT
|
||
TAD BUFR /SET POINTERS
|
||
DCA AXIN
|
||
DCA XCTIN
|
||
TAD LINENO /SAVE LINE #
|
||
DCA I AXIN /(X-MEM)
|
||
SPNOR /IGNORE SPACES AFTER LINE NUMBER
|
||
SKP
|
||
GETC /READ 1ST AFTER LINENO TERMINATOR.
|
||
PACKC /SAVE TEXT AND RESTORE DATA FIELD
|
||
TAD CHAR /TEST FOR END OF INPUT STRING
|
||
TAD MCR
|
||
SZA CLA
|
||
JMP .-5
|
||
PUSHJ /REMOVE OLD LINE, IF ANY.
|
||
DELETE
|
||
ENDLN /INSERT NEW LINE
|
||
JMP START
|
||
/////
|
||
INPUTX, PUSHJ /PROCESS IMMEDIATE COMMAND.
|
||
PROC
|
||
TAD I PC /CHECK NEXT LINE (X-MEM)
|
||
SNA /END OF PROGRAM?
|
||
JMP START /YES
|
||
DCA PC /SAVE NEW LINE NO.
|
||
TAD PC /START NEW LINE
|
||
IAC
|
||
JMP GONE /PROCESS OTHER COMMANDS
|
||
/TEXT LINE BUFFER FORMAT*
|
||
/#1 : POINTER OR ZERO IN LAST
|
||
/#2 : LINENO
|
||
/#3 - #N+1 : TEXT
|
||
/#N : C.R.
|
||
|
||
XRTL6, 0 /ROTATE AC LEFT 6
|
||
CLL RTL
|
||
RTL
|
||
RTL
|
||
JMP I XRTL6
|
||
/
|
||
/PROCESS A LINE NUMBER - "GETLN"
|
||
XGETLN, 0
|
||
SPNOR
|
||
TAD P4000 /INITIALIZE TO SINGLE LINE
|
||
DCA NAGSW
|
||
SORTC /TEST FOR A SIGN
|
||
SNLIST-1
|
||
JMP EVLN /EVALUATE IN FLOATING POINT
|
||
JMS I INPINT /FIXED POINT: GET GROUP
|
||
TESTN
|
||
GETC /GO PAST . IF THERE
|
||
JMS GEG /GET 1ST STEP DIGIT
|
||
CLL RTL /MULTIPLY BY TEN
|
||
TAD SORTCN
|
||
RAL
|
||
JMS GEG /GET 2ND STEP DIGIT
|
||
TAD LINENO /COMBINE
|
||
GEXIT, SNA
|
||
DCA NAGSW /MUST BE GROUP
|
||
DCA LINENO /SAVE STEP NUMBER
|
||
TAD DECNUM /GROUP
|
||
SNA
|
||
JMP GTESTA /GROUP 0: MUST BE "ALL"
|
||
RTL6 /CONSTRUCT LINE NUMBER
|
||
RAL
|
||
TAD LINENO
|
||
DCA LINENO
|
||
TAD DECNUM /TEST FOR LEGAL GROUP
|
||
AND C7760
|
||
JMP .+3
|
||
GTESTA, ISZ NAGSW /SET TO "ALL"
|
||
TAD LINENO /MAKE SURE LINE # IS ZERO
|
||
SNA CLA
|
||
TESTN /OK, TEST FOR EXTRA DIGITS
|
||
JMP LNERR /DOUBLE ., ILLEGAL G. 0, OR G.>15
|
||
JMP I XGETLN /OK
|
||
JMP LNERR /TOO MANY DIGITS
|
||
|
||
GEG, 0 /GET A STEP DIGIT
|
||
DCA LINENO
|
||
TESTN
|
||
LNERR, ERROR /DOUBLE PERIODS
|
||
JMP GEXIT-1 /NO DIGIT
|
||
GETC /DIGIT, PASS IT
|
||
TAD SORTCN /EXIT WITH VALUE
|
||
JMP I GEG
|
||
/////
|
||
INPINT, DECINT
|
||
C7760, 7760
|
||
/////
|
||
/EVALUATE A LINE NUMBER IN FLOATING POINT
|
||
EVLN, PUSHJ /GET VALUE
|
||
EVAL
|
||
FIX /GET GROUP #
|
||
PUSHA
|
||
TAD FLAC1
|
||
SZA CLA
|
||
JMP LNERR /TOO BIG
|
||
FENT /GET STEP #
|
||
FNR
|
||
FSB I FLARGP /THIS GIVES -(FRACTIONAL PART)
|
||
FMY I F10P
|
||
FMY I F10P
|
||
FSB I FP10P /KILL ANY ROUNDOFF ERROR
|
||
FEXT
|
||
NEGATE
|
||
POPA /RESTORE GROUP
|
||
DCA DECNUM
|
||
FIX
|
||
JMP I .+1
|
||
GEXIT
|
||
/////
|
||
F10P, FLTEN
|
||
FP10P, FLPTEN
|
||
|
||
/RANGE OF ACCEPTIBLE LINE NUMBERS = 1.01 TO 15.99
|
||
|
||
/NAGSW:
|
||
/GROUP=0000
|
||
/LINE=4000
|
||
/ALL=0001
|
||
/RECURSIVE OPERATE, EXECUTE, OR CALL
|
||
|
||
DO, GETLN /EXECUTE ONE LINE, A GROUP,OR ALL
|
||
TAD PC /SAVE ADDRESS
|
||
PUSHA /OF CURRENT LINE
|
||
PUSHF /SAVE REST OF THIS LINE
|
||
TEXTP /ADDRESS OF TEXT POINTERS
|
||
DGRP, PUSHF /SAVE NAGSW; CHAR; AND LINENO.
|
||
NAGSW
|
||
TAD NAGSW /CHECK DATA FROM GETLN.
|
||
SPA CLA /SKIP IF GROUP OR ALL
|
||
JMP DOONE /DO ONE LINE
|
||
FINDLN /INIT FOR GROUP AND SET THISLN
|
||
JMP TGRP2
|
||
DGRP1, PUSHJ /EXECUTE OBJECT LINE AND SET PC.
|
||
PROCESS-2
|
||
POPF /RESTORE THE DATA
|
||
NAGSW
|
||
TAD I PC /CHECK FOR END OF TEXT (X-MEM)
|
||
SNA
|
||
JMP DCONT /ALL DONE
|
||
IAC
|
||
DCA PT1 /SAVE POINTER TO LINENO
|
||
TAD NAGSW /CHECK FOR GROUP
|
||
SMA SZA CLA
|
||
JMP .+4 /DO ALL
|
||
TAD I PT1 /TEST GROUP (X-MEM)
|
||
TSTGRP
|
||
JMP DCONT /NOT IN GROUP
|
||
TAD I PT1 /READ NEXT LINE NO. (X-MEM)
|
||
DCA LINENO
|
||
JMP DGRP /CONTINUE THE SUBROUTINE
|
||
/////
|
||
DOONE, FINDLN /FIND THE LINE
|
||
ERROR2 /NO SUCH LINE NUMBER
|
||
PUSHJ /EXECUTE IT
|
||
PROCESS
|
||
POPF /RESTORE CHAR
|
||
NAGSW
|
||
DCONT, POPF /RESTORE TEXT POINTERS
|
||
TEXTP
|
||
POPA /RESTORE ADDRESS OF CURRENT LINE.
|
||
DCA PC
|
||
TSTERM /GO TO TERMINATOR
|
||
JMP .-1
|
||
JMP I .+2 /END OF DO, CONTINUE PROCESSING
|
||
JMP DO /COMMA, DO ANOTHER
|
||
PROC
|
||
|
||
TGRP2, TAD THISLN /TEST FOR GOOD GROUP NUMBER.
|
||
DCA XRT
|
||
TAD I XRT
|
||
TSTGRP
|
||
ERROR2 /NO SUCH GROUP NUMBER
|
||
JMP DGRP1
|
||
/PUSHDOWN LIST CONTROLS
|
||
/
|
||
XPUSHA, 0 /PUSHDOWN THE AC - "PUSHA"
|
||
DCA PD2 /SAVE AC
|
||
CMA /BACK UP POINTER
|
||
JMS PCHK /CHECK CORE USAGE
|
||
TAD PD2
|
||
DCA I XRT3 /SAVE
|
||
JMP I XPUSHA
|
||
/////
|
||
PCHK, 0
|
||
TAD PDLXR /INC IN AC
|
||
DCA PDLXR
|
||
TAD PDLXR
|
||
DCA XRT3 /DUPLICATE POINTER
|
||
TAD PDLXR
|
||
CLL CIA
|
||
TAD LASTV
|
||
SZL CLA
|
||
ERROR /STORAGE FILLED BY PUSHDOWN LIST
|
||
JMP I PCHK
|
||
/////
|
||
XPUSHJ, 0 /RECURSIVE SUBROUTINE CALL - "PUSHJ"
|
||
CLA IAC
|
||
TAD XPUSHJ /SAVE RETURN
|
||
JMS XPUSHA /(PUSHA)
|
||
TAD I XPUSHJ /TO NEW ROUTINE
|
||
DCA XPUSHJ
|
||
JMP I XPUSHJ
|
||
/////
|
||
PD2, 0 /SAVE A FLOATING PT NUMBER - "PUSHF"
|
||
CLA CMA /COMPUTE ADDRESS
|
||
TAD I PD2
|
||
DCA XRT
|
||
ISZ PD2
|
||
TAD M3 /BACKUP THREE
|
||
JMS PCHK
|
||
TAD I XRT /SAVE 3 WORDS
|
||
DCA I XRT3
|
||
TAD I XRT
|
||
DCA I XRT3
|
||
TAD I XRT
|
||
DCA I XRT3
|
||
JMP I PD2
|
||
|
||
PD3, 0 /RESTORE A FLOATING PT # - "POPF"
|
||
CLA CMA
|
||
TAD I PD3
|
||
ISZ PD3
|
||
DCA XRT
|
||
TAD I PDLXR
|
||
DCA I XRT
|
||
TAD I PDLXR
|
||
DCA I XRT
|
||
TAD I PDLXR
|
||
DCA I XRT
|
||
JMP I PD3
|
||
/
|
||
/INPUT CONTROL CHARACTERS
|
||
INLIST, IBAR /B.A.=RESTART
|
||
IGNOR+4 /F.F.
|
||
IGNOR+4 /BELL
|
||
IGNOR /L.F.=IGNORED
|
||
IRETN /C.R.=TERMINATE INPUT
|
||
/
|
||
/LIST OF FUNCTION ADDRESSES
|
||
FNTABF, XABS /ABSOLUTE VALUE
|
||
FSGN /SIGN PART
|
||
XINT /INTEGER PART
|
||
XDYS /FDIS- DISPLAY Y AND INTENSIFY
|
||
FRAN /RANDOM NUMBER
|
||
XDXS /SET X-COORDINATE FOR DISPLAY
|
||
XADC /READ ANALOG-DIGITAL CONVERTER
|
||
ERROR5 /ATN THESE ROUTINES NOT IN PACKAGE
|
||
ERROR5 /EXP
|
||
ERROR5 /LOG
|
||
ERROR5 /SIN
|
||
ERROR5 /COS
|
||
FSQT /SQUARE ROOT
|
||
ERROR5 /NEW- USER-DEFINED FUNCTION
|
||
/
|
||
MF, -306 /USED BY TESTC
|
||
/PRIMARY CONTROL AND TRANSFER
|
||
|
||
GOTO, GETLN /READ THE LINE NUMBER REQUESTED
|
||
FINDLN /LOCATE IT AND RESET TEXTP
|
||
ERROR2 /NOT THERE OR A TIGHT LOOP.
|
||
TAD THISLN /SET PC
|
||
DCA PC
|
||
PROCESS,GETC /TEST FOR END OF LINE
|
||
PROC, SORTC /FIRST CHARACTER READY = USE PROC
|
||
CCR-1
|
||
PC1, POPJ /EXIT "PROCESS"
|
||
SORTC /IGNORE SPACE ; ,
|
||
GLIST-1
|
||
JMP PROCESS
|
||
TAD CHAR /SAVE COMMAND CHARACTER
|
||
PUSHA
|
||
GETC /GO TO TERMINATOR
|
||
SORTC
|
||
TERMS-4
|
||
SKP
|
||
JMP .-4
|
||
SPNOR
|
||
POPA
|
||
SORTJ /GO DO COMMAND
|
||
COMLST-1
|
||
COMGO-COMLST
|
||
ERROR2 /ILLEGAL COMMAND
|
||
/////
|
||
|
||
COMMENTS=PC1 /ALSO IS CONTINUE
|
||
|
||
/OUTPUT COMMAND TEXT
|
||
|
||
WRITE, JMS I WTXS /SAVE CHAR AND TEXT POINTERS
|
||
GETLN /SET LINENO
|
||
ISZ DEBGSW /DISABLE TRACE
|
||
FINDLN /SEARCH FOR LINE NUMBER
|
||
JMP WTESTG /NOT THERE OR GROUP
|
||
TAD LINENO
|
||
SZA CLA
|
||
PRNTLN /PRINT LINE NUMBER AND A SPACE.
|
||
GETC
|
||
PRINTC /PRINT TEXT OF A LINE.
|
||
TAD CHAR
|
||
TAD MCR
|
||
SZA CLA /SKIP IF END OF LINE
|
||
JMP .-5
|
||
TAD I THISLN /TEST FOR END OF TEXT (X-MEM)
|
||
WTEST2, SNA
|
||
JMP WEXIT /WRITE FINISHED
|
||
IAC
|
||
DCA PT1 /SAVE POINTER TO LINENO OF`NEXT (X-MEM)
|
||
TAD NAGSW
|
||
SMA CLA
|
||
TAD I PT1 /(X-MEM)
|
||
TSTGRP /TRY NEXT LINENO FOR GROUP.
|
||
JMP WX
|
||
WALL, TAD I PT1 /SET LINENO (X-MEM)
|
||
DCA LINENO
|
||
JMP WRITE+3
|
||
///
|
||
WTESTG, TAD THISLN /INIT GROUP PRINTOUT
|
||
JMP WTEST2
|
||
/////
|
||
WX, TAD NAGSW
|
||
SPA SNA CLA /SKIP IF ALL
|
||
JMP WEXIT
|
||
PRINTC /PRINT C.R. AGAIN
|
||
JMP WALL
|
||
/////
|
||
WEXIT, JMS I WTXR /RESTORE CURRENT LINE
|
||
DCA DEBGSW /RESTORE TRACE
|
||
TSTERM
|
||
JMP .-1
|
||
JMP PROC /END OF WRITE
|
||
JMP WRITE /COMMA, MORE TO WRITE
|
||
/////
|
||
WTXS, TXTSAV
|
||
WTXR, TXTRES
|
||
|
||
XTESTC, 0 /TEST THE NATURE OF THE NEXT ALPHANUMERIC - "TESTC"
|
||
SPNOR /IGNORE SPACES
|
||
SORTC /TEST THE VARIABLE TERMINATORS
|
||
TERMS-1
|
||
JMP I XTESTC /YES - SORTCN IS SET
|
||
ISZ XTESTC
|
||
TESTN
|
||
JMP I XTESTC /. (PART OF NUMBER)
|
||
SKP /OTHER
|
||
JMP I XTESTC /NUMBER
|
||
TAD CHAR /TEST FOR "F"
|
||
TAD MF
|
||
SZA CLA
|
||
ISZ XTESTC /NO
|
||
ISZ XTESTC /RETURNS:
|
||
JMP I XTESTC /TERMINATOR;NUMBER;FUNCTION;OTHER
|
||
/////
|
||
XSORTC, 0 /SORT CHAR AGAINST TABLE - "SORTC"
|
||
TAD I XSORTC
|
||
DCA XRT2 /1ST ARG IS LIST-1
|
||
TAD I XRT2
|
||
SPA /LIST IS ENDED BY A NEGATIVE NUMBER
|
||
JMP SEXC /2AND EXIT = NOT IN LIST
|
||
CIA
|
||
TAD CHAR
|
||
SZA CLA /COMPARE
|
||
JMP .-6
|
||
TAD I XSORTC /COMPUTE INCREMENT : 0 - N
|
||
CMA
|
||
TAD XRT2
|
||
DCA SORTCN
|
||
SKP /1ST EXIT = YES
|
||
SEXC, ISZ XSORTC
|
||
ISZ XSORTC
|
||
CLA CLL
|
||
JMP I XSORTC
|
||
|
||
/COMMAND DECODING LIST
|
||
COMLST, 323 /SET
|
||
306 /FOR
|
||
311 /IF
|
||
304 /DO
|
||
307 /GOTO
|
||
303 /COMMENT OR CONTINUE
|
||
301 /ASK
|
||
324 /TYPE
|
||
314 /LIBRARY
|
||
305 /ERASE
|
||
327 /WRITE
|
||
315 /MODIFY
|
||
321 /QUIT
|
||
322 /RETURN
|
||
317 /OPTION
|
||
310 /HELLO
|
||
/CONDITIONAL TRANSFER PROCESS
|
||
/ IF (EXP) A,B,C
|
||
IF, SORTC /LOOK FOR L-PAR
|
||
PLPR-1
|
||
SKP
|
||
ERROR /NO ( AFTER IF
|
||
PUSHJ /EVALUATE EXPRESSION
|
||
EVAL-1
|
||
GETC /PASS )
|
||
TAD FLAC1 /TEST FOR -,0,+
|
||
SPA CLA
|
||
JMP I PGOTO /NEGATIVE, USE 1ST REF
|
||
TSTERM /0 OR POS, GET TO NEXT
|
||
JMP .-1
|
||
JMP I PRCP /; OR CR, CONTINUE SAME LINE
|
||
TAD FLAC1 /COMMA, SEE IF 0 OR POS
|
||
SNA CLA
|
||
JMP I PGOTO /ZERO, USE 2ND REF
|
||
TSTERM /POSITIVE, GET TO NEXT
|
||
JMP .-1
|
||
JMP I PRCP /; OR CR
|
||
JMP I PGOTO /COMMA, USE 3RD REF
|
||
PGOTO, GOTO
|
||
PLPR, 250
|
||
/ASSIGNMENT AND LOOP CONTROL
|
||
SET=.
|
||
FOR, PUSHJ /GET POINTER TO VAR.
|
||
GETARG
|
||
SPNOR
|
||
SORTC /SEARCH FOR =
|
||
TERMS+17-1
|
||
SKP
|
||
ERROR /LEFT OF = IN ERROR: "FOR" OR "SET"
|
||
TAD PT1 /SAVE VARIABLE POINTER
|
||
DCA PT2
|
||
PUSHJ /EVALUATE INITIAL EXPRESSION
|
||
EVAL-1
|
||
FENT /SAVE INITIAL VALUE
|
||
FPT I PT2
|
||
FEXT
|
||
TSTERM /CHECK TERMINATOR
|
||
ERROR /PROBABLY EXCESS R-PAR
|
||
JMP I PRCP /; OR CR: THIS IS A SET; CONTINUE
|
||
TAD PT2 /COMMA, SAVE LOOP VAR POINTER
|
||
PUSHA
|
||
PUSHJ /EVALUATE SECOND EXPRESSION
|
||
EVAL
|
||
TSTERM /CHECK TERMINATOR
|
||
ERROR /EXCESS R-PAR OR BAD TERMINATOR
|
||
JMP ONEINC /; OR CR, THAT'S ALL (INC=1)
|
||
PUSHF /COMMA, SAVE INCREMENT
|
||
FLARG
|
||
PUSHJ /EVALUATE FINAL EXPRESSION
|
||
EVAL
|
||
SFINAL, PUSHF /SAVE FINAL VALUE
|
||
FLARG
|
||
JMS I FTXS /SAVE CHAR AND TEXT POINTERS
|
||
FLOAT /FLOAT A ZERO TO START
|
||
FCONT, FENT /COMPARE LOOP VAR TO FINAL
|
||
FAD I PT2 /LOOP VAR
|
||
FPT I PT2
|
||
FSB I FLARGP /FINAL
|
||
FEXT
|
||
TAD PDLXR /CHECK SIGN OF INCREMENT
|
||
TAD PINC
|
||
DCA PT2
|
||
TAD I PT2
|
||
SPA CLA
|
||
NEGATE /BACKWARD COUNTING
|
||
TAD FLAC1
|
||
SMA SZA CLA
|
||
JMP FEND /LIMIT REACHED OR EXCEEDED
|
||
|
||
PUSHJ /NOT YET, DO OBJECT STATEMENTS
|
||
PRCP, PROC
|
||
JMS I FTXR /RESET TO BEGINNING OF OBJ. STMT.
|
||
POPF /RESTORE LIMIT
|
||
FLARG
|
||
POPF /RESTORE INC
|
||
FLAC
|
||
POPA /RESTORE LOOP VAR POINTER
|
||
DCA PT2
|
||
TAD M13 /PUSH DOWN ALL OF ABOVE
|
||
TAD PDLXR
|
||
DCA PDLXR
|
||
JMP FCONT
|
||
/////
|
||
ONEINC, PUSHF /NO INCREMENT GIVEN, SET TO 1
|
||
FLTONE
|
||
JMP SFINAL
|
||
/////
|
||
PINC, 11
|
||
M13, -13
|
||
FTXS, TXTSAV
|
||
FTXR, TXTRES
|
||
FEND, TAD P13 /END OF LOOP
|
||
TAD PDLXR /REMOVE VALUES!FROM PUSHDOWN LIST
|
||
DCA PDLXR
|
||
POPJ
|
||
PT2, 0
|
||
/////
|
||
/ASK/TYPE SPECIAL CHARACTERS
|
||
ALIST, 246 /&
|
||
245 /%
|
||
242 /"
|
||
241 /!
|
||
243 /#
|
||
244 /$
|
||
GLIST, 240 /SPACE
|
||
TLIST, 254 /,
|
||
273 /;
|
||
215 /C.R.
|
||
/SET Y AND INTENSIFY THE POINT
|
||
XDYS, FIX
|
||
6063 /DYL
|
||
CLA
|
||
TAD X0
|
||
6053 /DXL DIX
|
||
SKP
|
||
/
|
||
/SET X
|
||
XDXS, FIX
|
||
DCA X0 /(DXL)
|
||
RETURN
|
||
/
|
||
/TAKE THE INTEGER PART
|
||
XINT, FIX
|
||
CLA
|
||
RETURN
|
||
X0, 0
|
||
/////
|
||
TLIST3, TASK4 /"
|
||
TASK /C.R. - AUTOMATIC QUOTE MATCH
|
||
/COMMAND POINTERS
|
||
COMGO, SET
|
||
FOR
|
||
IF
|
||
DO
|
||
GOTO
|
||
COMMENTS
|
||
ASK
|
||
TYPE
|
||
LIBRARY
|
||
ERASE
|
||
WRITE
|
||
MODIFY
|
||
START
|
||
RETRN
|
||
OPTION
|
||
HELLO
|
||
/////
|
||
PACLS2, PQUES
|
||
RUB1
|
||
/INPUT-OUTPUT STATEMENTS
|
||
|
||
ASK, CLA CMA /REMEMBER WHICH CALL.
|
||
TYPE, DCA ATSW
|
||
TASK, DCA DEBGSW /RE-ENABLE THE TRACE
|
||
SORTJ /SPECIAL CHARACTER?
|
||
ALIST-1
|
||
ATLIST-ALIST
|
||
ISZ ATSW /TEST QUOTE SWITCH
|
||
JMP TYPE2
|
||
PUSHJ /DO ASK; SETUP PT1
|
||
GETARG
|
||
JMS I TTXTS /PROTECT TEXT
|
||
TAD COL /TYPE COLON
|
||
TASKCL, PRINTC /(CLA) TO SUPPRESS ":"
|
||
JMS I INTERP /CALL INPUT CONVERSION ROUTINE
|
||
JMS I TTXTR /RESTORE TEXT
|
||
JMP ASK /CONTINUE PROCESSING
|
||
INTERP, INTASK
|
||
////
|
||
TYPE2, PUSHJ /DO TYPE
|
||
EVAL
|
||
TSTERM
|
||
ERROR /BAD TERMINATOR IN "TYPE"
|
||
COL, 272
|
||
JMS I OUTS /PRINT
|
||
JMP TYPE
|
||
/////
|
||
TTXTS, TXTSAV
|
||
TTXTR, TXTRES
|
||
OUTS, OUTPT
|
||
|
||
TQUOT, ISZ DEBGSW /DISABLE TRACE
|
||
GETC /TYPE LITERALS
|
||
SORTJ
|
||
TLIST2-1
|
||
TLIST3-TLIST2
|
||
PRINTC
|
||
JMP TQUOT+1
|
||
//////
|
||
TCRLF, TAD CCR /SLASH=CR,LF.
|
||
PRINTC
|
||
TASK4, GETC /MOVE TO NEXT CHARACTER
|
||
JMP TASK
|
||
////
|
||
TCRLF2, TAD CCR /SPLAT=CR
|
||
JMS I OUTDEV
|
||
TAD C200 /DELAY FOR C.R.
|
||
JMP TCRLF+1
|
||
|
||
/IF DEBGSW=0 : ENABLE FLIP-FLOP "DMPSW"
|
||
/ #0: DISABLE AND RETURN ALL"?" ' S.
|
||
/IF DMPSW = 0: TRACE ON, IF ENABLED
|
||
/ #0: TRACE OFF
|
||
/IF BOTH = 0 : PRINT TRACE.
|
||
|
||
|
||
TINTR, GETC /PASS PERCENT SIGN
|
||
JMS I INTG /READ FORMAT CONTROL: "%7.3"
|
||
TAD DECNUM /INTEGER PART (TOTAL DIGITS)
|
||
DCA TOTDIG
|
||
TESTN /GET PAST . IF ANY
|
||
GETC
|
||
JMS I INTG /RIGHT-HAND PART (DECIMAL PLACES)
|
||
TAD DECNUM
|
||
DCA DECP
|
||
JMP TASK
|
||
INTG, DECINT
|
||
/SEARCH ROUTINES
|
||
|
||
MODIFY, GETLN /READ LINE NO.
|
||
FINDLN /LOOK IT UP NOW.
|
||
ERROR2 /NOT THERE = BAD COMMAND UNLESS ZERO.
|
||
TAD BUFR /SET POINTERS
|
||
DCA AXIN /FOR INPUT
|
||
DCA XCTIN
|
||
TAD LINENO /COPY THE SAME LINE NUMBER.
|
||
SNA /CHECK FOR ALL
|
||
JMP MODIFY+2 /ERROR IN ARG
|
||
DCA I AXIN /(X-MEM)
|
||
TAD AXIN /SAVE START OF NEW LINE
|
||
DCA PACKST
|
||
SCONT, JMS I INDEV /READ THE TELETYPE INPUT SILENTLY.
|
||
DCA LIST3+1 /SAVE SEARCH CHARACTER
|
||
ISZ DEBGSW /NO BREAKS.
|
||
SCHAR, GETC /TYPE+TEST-F.F.
|
||
PRINTC
|
||
SORTJ /LOOK FOR MATCH
|
||
LIST3-1
|
||
LISTGO-LIST3
|
||
PACKC /SAVE NEW LINE.
|
||
JMP SCHAR
|
||
/////
|
||
SBAR, TAD BUFR /RESTART-B.A.
|
||
IAC
|
||
DCA AXIN /SET POINTERS
|
||
DCA XCTIN
|
||
SFOUND, READC /READ FROM KEYBOARD
|
||
SORTJ /TEST
|
||
LIST6-1
|
||
SRNLST-LIST6
|
||
SGOT, PACKC /PACK CHAR.
|
||
JMP SFOUND /MORE
|
||
|
||
SORTB, 0 /SORT AND BRANCH ROUTINE. - "SORTJ"
|
||
SNA
|
||
TAD CHAR /ASSUME CHAR IF AC=0
|
||
CIA
|
||
DCA T2 /SAVE SORT ITEM
|
||
TAD I SORTB /FIRST ARG IS LIST LESS ONE
|
||
ISZ SORTB /2AND IS INTRA-LIST LENGTH
|
||
DCA XRT2
|
||
TAD I XRT2
|
||
SPA /**LISTS ENDED BY NEGATIVE NUMBERS**
|
||
JMP SEX /READ EXIT
|
||
TAD T2 /FIND ADDRESS
|
||
SZA CLA
|
||
JMP .-5
|
||
TAD XRT2 /MATCH FOUND.
|
||
TAD I SORTB
|
||
DCA SORTB /SETUP RETURN
|
||
TAD I SORTB
|
||
DCA SORTB
|
||
SKP
|
||
SEX, ISZ SORTB /MATCH NOT FOUND.
|
||
CLA CLL
|
||
JMP I SORTB /RETURN TO CALLING SEQUENCE.
|
||
|
||
TAB, PUSHJ /TABULATE TO A PARTICULAR COLUMN
|
||
EVAL-1
|
||
FIX /GET COLUMN NUMBER
|
||
CLL CIA
|
||
IAC
|
||
TAD TABCTR
|
||
SZL CLA
|
||
JMP TASK /ALREADY THERE OR PAST IT
|
||
TAD C240
|
||
PRINTC
|
||
TAD FLAC2 /TEST AGAIN
|
||
JMP TAB+3
|
||
SRNLST=. /'MODIFY' CONTROL CHARACTER TABLE
|
||
SBAR /B.A. = RESTART
|
||
SCHAR /F.F. = CONTINUE
|
||
SCONT /BELL = CHANGE SEARCH CHARACTER
|
||
SCONT+1 /L.F. = FINISH THE LINE AS BEFORE.
|
||
/////
|
||
LISTGO, INPUTX-11 /C.R. - END THE MODIFIED LINE HERE
|
||
SGOT /FOUND SEARCH CHARACTER
|
||
/FIND OR ENTER A VARIABLE IN THE LIST.
|
||
|
||
GETARG, TESTC /FIRST LETTER OF ARG
|
||
TLIST2, 0242 /"
|
||
0215 /C.R. - FUNCTION OR NUMBER IS NOT AN ARG.
|
||
ERROR4 /BAD ARGUEMENT IN 'FOR' 'SET', OR 'ASK'
|
||
CLA CMA /"GETARG" CAN CREATE NEW VAR.
|
||
GETVAR, PUSHA /"GETVAR" WILL NOT
|
||
DCA XCTIN /PACK INTO ADD.
|
||
PACKC
|
||
GETC /SECOND LETTER
|
||
SORTC /TERMINATOR?
|
||
TERMS-1
|
||
JMP .+3 /YES
|
||
TAD CHAR /NO
|
||
AND P77 /SAVE 2AND LETTER OF NAME
|
||
TAD ADD
|
||
PUSHA
|
||
SORTC /IGNORE THE REST
|
||
TERMS-1
|
||
JMP .+3
|
||
GETC
|
||
JMP .-4
|
||
TSTLPR /LOOK FOR SUBSCRIPT VIA SORTCN
|
||
JMP GS1 /NOT SUBSCRIPTED BY L-PAR.
|
||
TAD LASTOP /SAVE LAST OPERATION
|
||
PUSHA
|
||
PUSHJ /MOVE PAST L-PAR AND
|
||
EVAL-1 /EVALUATE THE SUBSCRIPT.
|
||
GETC /MOVE PAST R-PAR
|
||
POPA
|
||
DCA LASTOP /RECALL LAST OPERATION
|
||
FIX
|
||
GS1, DCA SUBS /SAVE SUBSCRIPT
|
||
POPA
|
||
DCA ADD /RESTORE NAME
|
||
TAD STARTV /SEARCH FOR VARIABLE
|
||
GS3, DCA PT1
|
||
TAD PT1
|
||
DCA XRT
|
||
TAD PT1
|
||
CIA
|
||
TAD LASTV /TEST FOR END OF LIST
|
||
SPA SNA CLA
|
||
JMP GS2 /END SEARCH
|
||
TAD I PT1 /GET TABLE ENTRY
|
||
CIA
|
||
TAD ADD
|
||
SNA CLA
|
||
JMP GFND1 /FOUND XX
|
||
|
||
GS4, TAD PT1 /TRY NEXT ONE
|
||
TAD GINC
|
||
JMP GS3
|
||
GS2, ISZ I PDLXR /VAR. NOT FOUND, CAN I MAKE ONE?
|
||
ERROR /UNDEFINED VAR. USED IN EXPRESSION
|
||
TAD LASTV /OK, ADD THE VARIABLE
|
||
TAD P13 /TEST STORAGE LIMITS
|
||
CIA CLL
|
||
TAD PDLXR
|
||
SNL CLA
|
||
ERROR3
|
||
TAD LASTV /UPDATE THE LIST.
|
||
TAD GINC
|
||
DCA LASTV
|
||
TAD ADD /SAVE NAME
|
||
DCA I PT1
|
||
TAD SUBS /SAVE SUBSCRIPT
|
||
DCA I XRT
|
||
DCA I XRT /INITIALIZE VAR. TO ZERO
|
||
DCA I XRT
|
||
DCA I XRT
|
||
JMP GS5 /EXIT
|
||
/////
|
||
GFND1, TAD I XRT /FOUND NAME, TEST SUBSCRIPT
|
||
CIA
|
||
TAD SUBS
|
||
SZA CLA
|
||
JMP GS4 /WRONG SUBSCRIPT
|
||
ISZ PDLXR
|
||
GS5, ISZ PT1 /SET POINTER TO DATA
|
||
ISZ PT1
|
||
POPJ
|
||
////
|
||
P0, FLTZER
|
||
|
||
/IGNORE LEADING SPACES - "SPNOR"
|
||
|
||
SUBS=.
|
||
XSPNOR, 0
|
||
TAD CHAR
|
||
TAD M240
|
||
SZA CLA
|
||
JMP I XSPNOR
|
||
GETC
|
||
JMP XSPNOR+1
|
||
/////
|
||
/SEE IF NEXT CHARACTER IS A NUMBER
|
||
XTESTN, 0 /RETURNS: .; OTHER; NUMBER - "TESTN"
|
||
TAD CHAR
|
||
TAD MPER /TEST FOR .
|
||
SZA
|
||
ISZ XTESTN /NOT A .
|
||
TAD NTST1 /COMPARE TO "9"
|
||
SMA
|
||
JMP NTEXIT /TOO LARGE
|
||
TAD NTST2 /COMPARE TO "0"
|
||
SPA
|
||
JMP NTEXIT /TOO SMALL
|
||
DCA SORTCN /FOUND DIGIT, SAVE IT
|
||
ISZ XTESTN
|
||
NTEXIT, CLA CLL
|
||
JMP I XTESTN
|
||
/////
|
||
NTST1, 256-272
|
||
NTST2, 272-260
|
||
/EXIT FROM A "DO" SUBROUTINE
|
||
|
||
|
||
RETRN, TAD P0 /(PC) => 0
|
||
DCA PC
|
||
XPOPJ, TAD I PDLXR /RECURSIVE EXIT - "POPJ"
|
||
DCA T2
|
||
JMP I T2
|
||
|
||
|
||
/ASK-TYPE CONTROL CHARACTER TABLE
|
||
ATLIST, TAB /& - TABULATION DELIMITER
|
||
TINTR /% - FORMAT DELIMITER
|
||
TQUOT /" - LITERAL DELIMITER
|
||
TCRLF /! - CARRIAGE RETURN AND LINE FEED
|
||
TCRLF2 /# - CARRIAGE RETURN ONLY
|
||
TDUMP /$/- DUMP THE SYMBOL TABLE CONTENTS
|
||
TASK4 /SP- TERMINATOR FOR NAMES
|
||
TASK4 /, - TERMINATOR FOR EXPRESSIONS
|
||
PROCESS /; - TERMINATOR FOR COMMANDS
|
||
PC1 /C.R. - TERMINATOR FOR STRINGS
|
||
/////
|
||
FLTONE, 0001
|
||
2000
|
||
FLTZER, 0000
|
||
0000
|
||
0000
|
||
/EVALUATE AN EXPRESSION WHICH
|
||
/TERMINATES WITH AN R-PAR,; OR C.R. AND
|
||
/LEAVE THE RESULT IN FLAC AND IN FLARG.
|
||
|
||
|
||
|
||
|
||
GETC /MOVE PAST EXTRA CHARACTER
|
||
EVAL, DCA LASTOP /EVAUATION CONTROLLER (CHECKPOINT ?)
|
||
TESTC /TEST CHARACTER AND IGNORE SPACES
|
||
JMP ETERM1 /TERMIOATION
|
||
JMP ENUM /NUMBER
|
||
JMP EFUN /FUNCTION
|
||
PUSHJ /LETTER OF VARIABLE
|
||
GETVAR /FIND OR CREATE VARIABLE;ALSO SET PT1.
|
||
OPNEXT, TESTC /PT1=>ARG
|
||
JMP ETERMN /T
|
||
ECHOLST,0212 /N-ERROR IN FORMAT
|
||
0377 /F
|
||
ERROR4 /L - MISSING OPERATOR
|
||
/////
|
||
ETERM1, PUSHF /INITIALIZE RESULT TO ZERO.
|
||
FLTZER
|
||
POPF
|
||
FLARG
|
||
TAD FLARGP /SET PT1.
|
||
DCA PT1
|
||
TAD M2 /TEST FOR UNARY OPERATIONS
|
||
TAD SORTCN
|
||
SNA
|
||
JMP ETERM /CREATE DUMMY FOR UNARY MINUS
|
||
IAC
|
||
SNA CLA
|
||
JMP ARGNXT /IGNORE UNARY PLUS
|
||
TAD SORTCN /TEST FOR NULL PARENS.
|
||
TAD M11
|
||
SPA CLA
|
||
JMP ELPAR /MIGHT BE AN L-PAR.
|
||
ETERMN, TSTLPR
|
||
SKP
|
||
ERROR4 /OPERATOR MISSING BEFORE PAREN
|
||
ETERM, TAD SORTCN /SET FROM "TESTC"-"SORTC"
|
||
DCA THISOP
|
||
TAD THISOP
|
||
TAD M11
|
||
SMA CLA /END?
|
||
DCA THISOP /"THISOP" EQUIV. TO END OF EXP.
|
||
|
||
ETERM2, CLA IAC /COMPARE PRIORITIES
|
||
AND THISOP /PRIORITIES ARE: (^),(*/),(+-),PUT
|
||
TAD THISOP
|
||
CIA
|
||
DCA FLOPR
|
||
IAC
|
||
AND LASTOP
|
||
TAD LASTOP
|
||
TAD FLOPR
|
||
SPA CLA
|
||
JMP EPAR /CONTINUE
|
||
TAD LASTOP /FIND OPERATION FROM TABLE
|
||
TAD OPTABL
|
||
DCA FLOPR
|
||
TAD I FLOPR
|
||
DCA FLOPR
|
||
TAD LASTOP
|
||
SZA CLA /TEST FOR END OF DATA INTO FLOATING AC.
|
||
POPF /GET LAST DATA
|
||
FLAC
|
||
FENT
|
||
FLOPR, 00 /(FLOPR I PT1) +-*/^
|
||
FPT I FLARGP /SAVE RESULT
|
||
FEXT
|
||
TAD FLARGP
|
||
DCA PT1
|
||
TAD THISOP
|
||
TAD LASTOP /=0?
|
||
SNA CLA
|
||
POPJ /EXIT "EVAL"
|
||
POPA /GET PRIOR OP
|
||
DCA LASTOP
|
||
JMP ETERM2 /COMPARE THIS OP
|
||
/////
|
||
EPAR, TSTLPR /TEST FOR SUB-EXPRESSION
|
||
SKP
|
||
JMP EPAR2 /GO EVALUATE EXPRESSION
|
||
TAD LASTOP /CONTINUE READING THE EXPRESSION
|
||
PUSHA /SAVE "LASTOP".
|
||
TAD PT1
|
||
DCA .+2
|
||
PUSHF /SAVE LAST ARGUMENT
|
||
00
|
||
TAD THISOP /MORE TO COME
|
||
DCA LASTOP
|
||
ARGNXT, GETC /READ 1ST CHAR OF AN ARG.
|
||
TESTC /DO SPECIAL CHECK
|
||
JMP ELPAR /COULD BE LEFT PAREN
|
||
JMP ENUM /N
|
||
JMP EFUN /F
|
||
JMP OPNEXT-2 /L
|
||
OPTABL, OPTABS
|
||
/////
|
||
|
||
ENUM, PUSHF /TO PROCESS A NUMBER,SAVE AC
|
||
FLAC
|
||
TAD FLARGP /SET POINTER AS FOR A VARIABLE.
|
||
DCA PT1
|
||
JMS I FINPUT /READ TEXT NUMBER => (PT1)
|
||
POPF /RESTORE THE AC
|
||
FLAC
|
||
JMP OPNEXT /CONTINUE
|
||
/////
|
||
EFUN, DCA FLOPR /SET CODE
|
||
GETC /READ FUNCTION NAME.(1,2,OR 3 LETTERS)
|
||
SORTC /LOOK FOR TERMINATION CHARACTER.
|
||
TERMS-1
|
||
JMP EFUN2 /YES
|
||
TAD FLOPR /NO
|
||
CLL RAL /MISH-MASH HASH CODE
|
||
TAD CHAR
|
||
JMP EFUN
|
||
ELPAR, TSTLPR
|
||
ERROR4 /DOUBLE OPERATORS
|
||
EPAR2, TAD SORTCN /LEFT PARENS FOUND.
|
||
PUSHA
|
||
TAD LASTOP /SAVE DATA
|
||
PUSHA
|
||
PUSHJ /EVALUATE THE EXPRESSION
|
||
EVAL-1
|
||
JMP I EFUN3I
|
||
///
|
||
EFUN2, TAD SORTCN /SAVE 'SORTCN','LASTOP',AND FUNC CODE
|
||
PUSHA
|
||
TAD LASTOP
|
||
PUSHA
|
||
TAD FLOPR /SAVE FUNCTION CODE.
|
||
PUSHA
|
||
TSTLPR
|
||
ERROR4 /MUST BE FOLLOWED BY PARENS TO SET ARGUMENT
|
||
PUSHJ /YES
|
||
EVAL-1
|
||
POPA /BRANCH ON FUNCTION CODE;RETURN VIA EFUN3I.
|
||
SORTJ
|
||
FNTABL-1
|
||
FNTABF-FNTABL
|
||
ERROR2 /ILLEGAL FUNCTION NAME.
|
||
/////
|
||
|
||
241 /!
|
||
242 /"
|
||
256 /. -FOR INPUT NUMBERS
|
||
TERMS=. /TERMINATOR TABLE FOR 'EVAL' AND 'GETVAR'
|
||
240 /SPACE 0
|
||
253 /+ 1
|
||
255 /- 2
|
||
257 // 3
|
||
252 /* 4
|
||
336 /UP ARR 5
|
||
250 /( 6 L-PARS
|
||
333 /[ 7
|
||
274 /< 10
|
||
251 /) 11 R-PARS
|
||
335 /] 12
|
||
276 /> 13
|
||
254 /, 14
|
||
273 /; 15
|
||
215 /C.R. 16
|
||
275 /= TO END GETARG FROM 'SET'
|
||
OPTABS, FGT I PT1
|
||
FAD I PT1
|
||
FSB I PT1
|
||
FDV I PT1
|
||
FMY I PT1
|
||
FPW I PT1
|
||
/////
|
||
FLARG, 0 /DATA TEMPORARY STORAGE
|
||
0
|
||
0
|
||
/////
|
||
/FOCAL TEXT FOR "HELLO" COMMAND
|
||
HPT, 7056 /[T %] 8.4;
|
||
6473
|
||
1740 /OPTION K,T,I,E,:,S;
|
||
1354
|
||
2454
|
||
1154
|
||
0554
|
||
7254
|
||
2373
|
||
0540 /ERASE ALL
|
||
0177
|
||
1500
|
||
/////
|
||
/ABSOLUTE VALUE FUNCTION
|
||
XABS, TAD FLAC1
|
||
SPA CLA
|
||
NEGATE
|
||
/CONTINUATION OF FUNCTION CALLS.
|
||
|
||
EFUN3, POPA /RESTORE LAST OPERATION
|
||
DCA LASTOP
|
||
FENT
|
||
FNR /NORMALIZE FUNCTION RETURN
|
||
FPT FLARG
|
||
FEXT
|
||
TAD FLARGP /SET POINTER
|
||
DCA PT1
|
||
POPA /GET LAST PAREN CODE.
|
||
CIA /CHECK FOR PAREN MATCH.
|
||
TAD M3
|
||
TAD SORTCN /(STILL SET FROM THE LAST "EVAL")
|
||
SZA CLA /SKIP IF MATCH
|
||
ERROR4 /PAREN ERROR
|
||
GETC /MOVE PAST R-PAR, AND RETURN TO OPNEX.
|
||
JMP I .+1 /FUNCTION RETURN IS OK
|
||
OPNEXT
|
||
////
|
||
|
||
LPRTST, 0 /SKIP IF LEFT PAREN. - 'TSTLPR'
|
||
TAD SORTCN
|
||
TAD M11
|
||
SMA CLA
|
||
JMP I LPRTST
|
||
TAD SORTCN
|
||
TAD M5
|
||
SMA SZA CLA
|
||
ISZ LPRTST
|
||
JMP I LPRTST
|
||
|
||
/THE DELETE A LINE ROUTINE
|
||
|
||
DELETE, FINDLN /SETS "THISLN" AND "LASTLN".
|
||
POPJ /ALREADY GONE
|
||
ISZ DEBGSW /DISABLE TRACE
|
||
GETC /MEASURE LENGTH
|
||
TAD CHAR
|
||
TAD MCR
|
||
SZA CLA
|
||
JMP .-4
|
||
TAD AXOUT /SAVE LAST ADDRESS
|
||
CMA
|
||
TAD THISLN
|
||
DCA CNTR /LENGTH < 0
|
||
TAD I THISLN /DISCONNECT
|
||
DCA I LASTLN
|
||
TAD CFRS /START LIST AT TOP
|
||
DOK, DCA T2 /EXAMINATION ADDRESS
|
||
TAD I T2 /GET THE NEXT ADDR.
|
||
SNA /TEST FOR END
|
||
JMP DONE /YES-WRAP UP ALL.
|
||
DCA T1 /SAVE NEXT ADDRESS.
|
||
TAD THISLN /COMPARE LINE POSITIONS
|
||
CIA CLL
|
||
TAD T1
|
||
SZL CLA /SKIP IF THISLN > X
|
||
TAD CNTR /CHANGE (X) TO ACCOUNT FOR
|
||
TAD T1 /GARBAGE COLLECTION.
|
||
DCA I T2
|
||
TAD T1 /GET NEXT
|
||
JMP DOK
|
||
/////
|
||
/GARBAGE COLLECTION
|
||
|
||
DONE, CMA /BACKUP L FOR XR
|
||
TAD THISLN
|
||
DCA XRT
|
||
TAD CNTR /SETUP END OF HOSE
|
||
CMA
|
||
TAD THISLN
|
||
DCA XRT2
|
||
TAD CNTR /CORRECT END OF BUFFER POINTER.
|
||
TAD BUFR
|
||
DCA BUFR
|
||
TAD AXIN /COMPUTE COUNT
|
||
CMA
|
||
TAD XRT2
|
||
DCA T1
|
||
TAD AXIN
|
||
TAD CNTR
|
||
DCA AXIN
|
||
TAD I XRT2 /SIPHON LOWER PART.
|
||
DCA I XRT
|
||
ISZ T1
|
||
JMP .-3
|
||
JMP DELETE /RESET 'LASTLN','THISLN', AND DATA`FIELD.
|
||
/////
|
||
/OPTION TABLE
|
||
OPTTBL, OPTK /SWITCH TO KEYBOARD INPUT
|
||
OPTR /READER INPUT
|
||
OPTT /TTY OUTPUT
|
||
OPTP /PUNCH OUTPUT
|
||
OPTI /INTERPRETIVE/NUMERIC I/O
|
||
OPTC /SINGLE CHARACTER I/O
|
||
OPTCOL /PRINT ":" AT "ASK"
|
||
OPTX /SUPPRESS ":"
|
||
OPTE /ECHO KEYBOARD INPUT
|
||
OPTN /NO ECHO
|
||
OPTS /SET VARIABLE TERMINATOR
|
||
OPTM /START DISK MONITOR
|
||
|
||
FNTABL=.
|
||
2533 /ABS
|
||
2650 /SGN
|
||
2636 /ITR
|
||
2565 /DIS
|
||
2630 /RAN
|
||
2623 /DXS
|
||
2517 /ADC
|
||
2572 /ATN
|
||
2624 /EXP
|
||
2625 /LOG
|
||
2654 /SIN /LIST OF CODED FUNCTION NAMES
|
||
2575 /COS
|
||
2702 /SQT
|
||
2631 /NEW
|
||
/ERASE SINGLE LINES, GROUPS, OR VARIABLES
|
||
ERASE, TAD CHAR /SEE IF "ALL"
|
||
TAD MINUSA
|
||
SZA CLA
|
||
JMP ERVX
|
||
TAD ENDT /YES, ERASE ALL TEXT
|
||
DCA BUFR
|
||
DCA I CFRS
|
||
ERV, TAD STARTV /ERASE VARIABLES
|
||
DCA LASTV
|
||
JMP START /PROGRAM EXECUTION ENDS
|
||
/////
|
||
ERVX, GETLN /GET LINE NUMBER
|
||
TAD LINENO /SEE OF ZERO OR NONE
|
||
SZA CLA
|
||
JMP ERL /NO, ERASE LINES
|
||
TAD STARTV /YES, ERASE VARIABLES
|
||
DCA LASTV
|
||
JMP I .+1 /CONTINUE PROCESSING
|
||
PROC
|
||
/////
|
||
ERL, TAD BUFR /ERASE LINES
|
||
DCA AXIN
|
||
ERG, PUSHJ /EXTRACT ONE LINE
|
||
DELETE
|
||
ISZ THISLN
|
||
TAD NAGSW
|
||
SMA CLA
|
||
TAD I THISLN
|
||
TSTGRP /IF GROUP, SEE IF END OF GROUP
|
||
JMP ERV /YES
|
||
TAD I THISLN /NO, CONTINUE ERASING GROUP
|
||
DCA LINENO
|
||
JMP ERG
|
||
/ROUTINE CALLED VIA "FINDLN":
|
||
|
||
/SEARCH FOR A GIVEN LINE I.D. =[ "LINENO" ]
|
||
/1ST RETURN IF NOT FOUND,
|
||
/2AND IF FOUND.
|
||
/"THISLN" = FOUND LINE OR NEXT LARGER.
|
||
/"LASTLN" = LESSER AND/OR LAST.
|
||
/"TEXTP" IS SET
|
||
|
||
XFIND, 0
|
||
TAD CFRS /INITIALIZE POINTERS TO FIRST LINE
|
||
DCA LASTLN
|
||
TAD CFRS
|
||
FINDN, DCA THISLN /SAVE THIS ONE
|
||
TAD THISLN
|
||
DCA XRT2
|
||
TAD LINENO
|
||
CIA
|
||
TAD I XRT2 /LINENO=0 WILL ALSO BE FOUND
|
||
SNA
|
||
ISZ XFIND /FOUND IT (2ND EXIT)
|
||
SMA CLA
|
||
JMP FEND3 /PAST IT.
|
||
TAD THISLN /MOVE POINTERS
|
||
DCA LASTLN
|
||
TAD I THISLN
|
||
SZA /SKIP IF END OF TEST
|
||
JMP FINDN
|
||
FEND3, TAD THISLN
|
||
IAC
|
||
DCA AXOUT /SET "TEXTP".
|
||
DCA XCT
|
||
JMP I XFIND
|
||
|
||
UTRA, 0 /UNPACK CHARACTER. - "GETC"
|
||
JMS GET1
|
||
UTE, SPA CLA /NORM & EXTEND
|
||
TAD C100 /300-337 & 340-376
|
||
TAD M137 /240-276 & 200-236
|
||
TAD CHAR
|
||
SNA
|
||
JMP UTX /"?" FOUND
|
||
TAD P337
|
||
UTQ, DCA CHAR
|
||
TAD DEBGSW
|
||
TAD DMPSW
|
||
SNA CLA /PRINT ONLY IF BOTH ARE ZERO.
|
||
PRINTC
|
||
JMP I UTRA
|
||
//////
|
||
EXTR, JMS GET1
|
||
CMA
|
||
JMP UTE
|
||
///
|
||
UTX, TAD DEBGSW /TEST FOR TRACE-ENABLED
|
||
SZA CLA
|
||
JMP .+6
|
||
TAD DMPSW /FLIP THE TRACE FLOP
|
||
SNA CLA
|
||
IAC
|
||
DCA DMPSW
|
||
JMP UTRA+1 /GET NEXT CHARACTER INSTEAD.
|
||
TAD P277 /TRACE DISABLED = RETURN "?"
|
||
JMP UTQ
|
||
|
||
GET1, 0 /UNPACK 6-BITS
|
||
ISZ XCT /STARTS=0
|
||
JMP GET3
|
||
TAD GTEM
|
||
GEND, AND P77
|
||
DCA CHAR /SAVE
|
||
TAD CHAR
|
||
TAD M77
|
||
SNA CLA
|
||
JMP EXTR /EXTENDED
|
||
TAD CHAR
|
||
TAD M40
|
||
JMP I GET1
|
||
/////
|
||
|
||
GET3, TAD I AXOUT /(X-MEM)
|
||
DCA GTEM
|
||
CMA
|
||
DCA XCT
|
||
TAD GTEM
|
||
RTL6
|
||
RAL
|
||
JMP GEND
|
||
M40, -40
|
||
M137, -137
|
||
/////
|
||
/OPTION LIST
|
||
OPTLST, "K
|
||
"R
|
||
"T
|
||
"P
|
||
"I
|
||
"C
|
||
":
|
||
"X
|
||
"E
|
||
"N
|
||
"S
|
||
"M
|
||
/////
|
||
/ANALOG-DIGITAL CONVERSION
|
||
XADC, 6004
|
||
DCA FLAC1 /ARG MUST BE 0
|
||
RETURN
|
||
|
||
XENDLN, 0 /TERMINATE THE BUFFERED LINE - "ENDLN"
|
||
TAD I LASTLN /SAVE OLD POINTER
|
||
DCA I BUFR
|
||
TAD BUFR /POINT TO NEW LAST LINE
|
||
DCA I LASTLN
|
||
TAD ADD /CHECK FOR EXTRA INFO
|
||
SZA
|
||
DCA I AXIN
|
||
TAD AXIN /COMPUTE NEW`END OF BUFFER
|
||
IAC
|
||
DCA BUFR
|
||
TAD STARTV /RESET VARIABLE LIST
|
||
DCA LASTV
|
||
JMP I XENDLN
|
||
/////
|
||
TXTSAV, 0 /SAVE CHAR AND TEXT POINTERS
|
||
PUSHF
|
||
TEXTP
|
||
TAD CHAR
|
||
PUSHA
|
||
JMP I TXTSAV
|
||
/
|
||
TXTRES, 0 /RESTORE SAME
|
||
POPA
|
||
DCA CHAR
|
||
POPF
|
||
TEXTP
|
||
JMP I TXTRES
|
||
/////
|
||
GRPTST, 0 /AC VS LINENO - "TSTGRP"
|
||
AND P7600
|
||
CIA
|
||
DCA T2
|
||
TAD LINENO
|
||
AND P7600
|
||
TAD T2
|
||
SNA CLA
|
||
ISZ GRPTST
|
||
JMP I GRPTST
|
||
/I-O SUBROUTINES
|
||
|
||
VAL=.
|
||
CHIN, 0 /READ IN A CHARACTER SUBR. - "READC"
|
||
JMS I INDEV
|
||
DCA CHAR
|
||
SORTC /LINEFEED OR RUBOUT?
|
||
ECHOLST-1
|
||
JMP I CHIN /YES
|
||
ECHO, PRINTC
|
||
TAD CHAR /SEE IF 200 (L/T)
|
||
TAD P7600
|
||
SZA CLA
|
||
JMP I CHIN /NO, EXIT
|
||
JMP CHIN+1 /YES, GET ANOTHER
|
||
/////
|
||
OUT, 0 /OUTPUT A CHARACTER - "PRINTC"
|
||
SNA /USE (AC) OR (CHAR)
|
||
TAD CHAR
|
||
TAD MCR
|
||
SNA
|
||
JMP OUTCR
|
||
TAD CCR
|
||
JMS I OUTDEV
|
||
OUTX, JMP I OUT
|
||
/////
|
||
OUTCR, TAD CCR
|
||
JMS I OUTDEV
|
||
TAD CLF
|
||
JMP OUTX-1
|
||
/////
|
||
/TEST FOR A COMMA, SEMICOLON, OR CR - "TSTERM"
|
||
/RETURNS: OTHER, ; OR CR, COMMA
|
||
/GETS NEXT CHARACTER AFTER COMMA OR OTHER
|
||
XTSTER, 0
|
||
SORTC /LOOK FOR ,;CR
|
||
TLIST-1
|
||
SKP
|
||
JMP .+6 /OTHER, GO PAST IT
|
||
TAD SORTCN /FOUND ONE, SEE WHAT IT IS
|
||
ISZ XTSTER
|
||
SZA CLA
|
||
JMP I XTSTER /; OR CR: 2ND EXIT
|
||
ISZ XTSTER /COMMA, 3RD EXIT
|
||
GETC
|
||
JMP I XTSTER
|
||
/////
|
||
|
||
COMEIN=.-1 /COMMAND-INPUT BUFFER LIVES HERE.
|
||
|
||
COMOUT=2600
|
||
*COMOUT
|
||
|
||
/INTERRUPT PROCESSOR.
|
||
|
||
SAVAC, 0 /CONTENTS OF AC
|
||
SAVLK, 0 /CONTENTS OF LINK
|
||
MBREAK, -203 /CONTROL-C
|
||
INTRPT, DCA SAVAC /SAVE WORKING DATA
|
||
RAR
|
||
DCA SAVLK
|
||
KSF /CHECK FOR KEYBOARD FIRST
|
||
JMP TINT
|
||
KRB /READ BUFFER AND CLEAR FLAG TO FETCH NEXT
|
||
AND P177 /IGNORE PARITY BIT
|
||
TAD C200
|
||
DCA SIN
|
||
TAD SIN
|
||
TAD MBREAK /MANUAL STOP?
|
||
SNA CLA
|
||
JMP RECOVR
|
||
TAD INBUF /ANY SPACE?
|
||
SZA CLA
|
||
ERROR2 /WILL WAIT FOR OUTPUT BUFFER
|
||
TAD SIN
|
||
DCA INBUF /SAVE INPUT
|
||
TINT, TSF
|
||
JMP EXIT
|
||
TCF
|
||
DCA TELSW /TURN OFF THE IN-PROGRESS FLAG.
|
||
TAD I OPTRI
|
||
SNA
|
||
JMP EXIT /DONE
|
||
TPC /TYPE NEXT.
|
||
DCA TELSW /CLEAR AC AND TURN ON THE FLAG.
|
||
DCA I OPTRI /ZERO OUT THE DATA AREA
|
||
TAD OPTRI
|
||
IAC
|
||
AND P17
|
||
TAD OPTR0
|
||
DCA OPTRI
|
||
EXIT, 6244 /RESTORE MEMORY FIELD
|
||
6101 /SMP
|
||
NOP /(HLT)-IF YOU HAVE MEMORY PARITY
|
||
RSF /TEST H.S. READER FLAG
|
||
JMP .+3
|
||
RRB /READ BUFFER AND CLEAR FLAG
|
||
DCA HINBUF /SAVE CHARACTER
|
||
TAD SAVLK
|
||
RAL CLL
|
||
TAD SAVAC
|
||
ION
|
||
EXITJ, JMP I 0
|
||
|
||
TELSW, 1 /INPUT SWITCH
|
||
OPTR0, IOBUF /OUTPUT POINTERS
|
||
OPTRO, IOBUF /VARS
|
||
OPTRI, IOBUF
|
||
INBUF, 0 /KEYBOARD BUFFER.
|
||
/////
|
||
XI33, 0 /VIA (INDEV)
|
||
TAD INBUF /ANY INPUT?
|
||
SPA SNA
|
||
JMP .-2 /NO = WAIT
|
||
DCA XOUTL
|
||
DCA INBUF /CLEAR INPUT BUFFER
|
||
TAD XOUTL
|
||
JMP I XI33
|
||
/////
|
||
XOUTL, 0 /VIA (OUTDEV)
|
||
DCA XI33 /SAVE CURRENT CHARACTER.
|
||
TAD XI33 /IS IT A CR?
|
||
TAD MCR
|
||
SNA CLA
|
||
DCA TABCTR /YES, RESET CARRIAGE INDEX
|
||
TAD XI33
|
||
JMS I SKPNP /SKIP IF A NON-PRINTING CHARACTER
|
||
ISZ TABCTR /PRINTING: INCREMENT INDEX
|
||
SIN, 0
|
||
ION /BE SURE INTERRUPT IS ON.
|
||
TAD I OPTRO /ANY ROOM?
|
||
SZA CLA /A CHARACTER IS NON-ZERO
|
||
JMP .-2 /NO = WAIT.
|
||
TAD TELSW /IN PROGRESS?
|
||
SZA CLA
|
||
JMP .+5
|
||
TAD XI33 /NO
|
||
TLS /TYPE CHARACTER.
|
||
DCA TELSW /SET IN-PROGRESS FLAG.
|
||
JMP I XOUTL /RETURN
|
||
TAD XI33 /SEND DATA
|
||
DCA I OPTRO
|
||
TAD OPTRO /SET POINTERS
|
||
IAC
|
||
AND P17
|
||
TAD OPTR0
|
||
DCA OPTRO
|
||
JMP I XOUTL
|
||
///////
|
||
SKPNP, SKIPNP
|
||
ERROR2=ERROR; ERROR3=ERROR; ERROR4=ERROR
|
||
WAITP, OWAIT
|
||
OPTDOP, OPTTDO
|
||
ERROR5, DCA .+1 /ERROR CALLED FROM A TABLE
|
||
ERR2, 0 /LIMIT EXCEEDED
|
||
CLA CMA /COMPUTE CALLING ADDRESS (ALSO "SPACE")
|
||
TAD ERR2 /AND USE IT AS ERROR NUMBER.
|
||
DCA LINENO /SAVE ERROR CODE.
|
||
JMS I WAITP /WAIT FOR OUTPUT TO FINISH
|
||
IOF /DISABLE INTERRUPT FOR INITIALIZATIONS
|
||
JMP .+3
|
||
RECOVR, TAD C200
|
||
DCA LINENO /SAVE ERROR NUMBER
|
||
ISZ TELSW /TURN ON IN-PROGRESS SWITCH
|
||
TAD M20 /SETUP INIT COUNT
|
||
DCA CNTR
|
||
CMA
|
||
TAD OPTR0
|
||
DCA XRT /INIT I/O BUFFERS.
|
||
DCA I XRT
|
||
ISZ CNTR
|
||
JMP .-2
|
||
DCA INBUF /INIT KEY-BUFR.
|
||
TAD OPTR0 /INIT TTY POINTERS.
|
||
DCA OPTRI
|
||
TAD OPTR0
|
||
DCA OPTRO
|
||
JMS I OPTDOP /SET TO TTY OUTPUT
|
||
TAD PTCH /RESET "READC"
|
||
DCA 113 /IF AN ERROR OCCURS.
|
||
CMA /PREPARE A STOP BIT FOR TTY
|
||
TLS /AND RAISE FLAG
|
||
CLA
|
||
TAD CCR /PRINT A CR
|
||
PRINTC
|
||
TAD P277 /MAKE A ?
|
||
PRINTC /AND TURN ON THE INTERRUPT
|
||
PRNTLN /PRINT ERROR NUMBER AND,
|
||
ISZ PC
|
||
TAD I PC /UNLESS IT IS ZERO, (X-MEM)
|
||
SNA
|
||
JMP .+6
|
||
DCA LINENO
|
||
TAD P7700
|
||
PRINTC
|
||
PRINTC /PRINT SPACE AGAIN AND
|
||
PRNTLN /PRINT LINE OF ERROR.
|
||
TAD CCR
|
||
PRINTC
|
||
JMP START /INTERRUPT WILL BE RE-ENABLED SOON.
|
||
/////
|
||
/SKIP IF (AC) IS A NON-PRINTING CHARACTER
|
||
SKIPNP, 0
|
||
RTL6 /PRINTING CHARACTERS ARE 240-337
|
||
SPA CLA
|
||
CML
|
||
SNL
|
||
ISZ SKIPNP
|
||
JMP I SKIPNP
|
||
/////
|
||
/PACK A CHARACTER INTO THE BUFFER - "PACKC"
|
||
PACBUF, 0
|
||
SORTJ /LOOK FOR ? OR RUBOUT
|
||
PACLST-1
|
||
PACLS2-PACLST
|
||
TAD CHAR
|
||
JMS SKIPNP /PRINTING CHARACTER?
|
||
JMP .+3 /YES
|
||
TAD P77 /NO, PACK 77 FIRST
|
||
JMS PCK1
|
||
TAD CHAR /PACK 6-BIT CHARACTER
|
||
AND P77
|
||
JMS PCK1
|
||
JMP I PACBUF
|
||
/////
|
||
PQUES, TAD P337 /USE 337 FOR ?
|
||
JMP .-4
|
||
/////
|
||
/PACK ONE 6-BIT WORD
|
||
PCK1, 0
|
||
ISZ XCTIN
|
||
JMP ROT /PACK LEFT HALF
|
||
TAD ADD /PACK RIGHT HALF AND STORE
|
||
DCA I AXIN
|
||
TAD PDLXR /CHECK FOR SPACE
|
||
CLL CIA
|
||
TAD P13
|
||
TAD AXIN
|
||
SZL CLA
|
||
ERROR /BUFFER OR STORAGE OVERFLOW
|
||
JMP I PCK1
|
||
/////
|
||
PACLST, 277 /?
|
||
377 /RUBOUT
|
||
/////
|
||
ROT, RTL6 /SAVE LEFT HALF
|
||
DCA ADD
|
||
CMA
|
||
DCA XCTIN
|
||
JMP I PCK1
|
||
/RUBOUT ONE CHARACTER
|
||
RUB1, TAD AXIN /SAVE POINTER
|
||
DCA PCK1
|
||
TAD XCTIN /CHARACTER IN ADD?
|
||
SZA CLA
|
||
JMP RUB2 /YES
|
||
TAD AXIN /NO, BEGINNING OF BUFFER?
|
||
CIA
|
||
TAD PACKST
|
||
SMA CLA
|
||
JMP PKZERO /YES, IGNORE
|
||
RUB2, TAD SPLAT /ECHO A BACKSLASH
|
||
PRINTC
|
||
ISZ XCTIN
|
||
JMP RUB3 /BACKUP STORAGE
|
||
TAD I PCK1 /KILL ADD AND CHECK FOR 77
|
||
AND P77 /IN 2ND HALF OF LAST STORED WORD
|
||
TAD M77
|
||
SZA CLA
|
||
JMP PKZERO /NO, DONE
|
||
RUB3, TAD I PCK1 /KILL 2ND HALF OF LAST STORED WORD
|
||
AND P7700
|
||
DCA ADD
|
||
CMA /BACKUP POINTER
|
||
TAD AXIN
|
||
DCA AXIN
|
||
TAD ADD /TEST FOR 77 IN ADD
|
||
TAD C100
|
||
SZA CLA
|
||
CMA
|
||
PKZERO, DCA XCTIN
|
||
JMP I PACBUF
|
||
SPLAT, 334
|
||
/DUMP THE SYMBOL TABLE CONTENTS
|
||
TDUMP, PUSHF /SAVE TEXT POINTERS
|
||
TEXTP
|
||
CMA
|
||
TAD STARTV /START VARIABLE LIST
|
||
TDLOOP, DCA FLTXR
|
||
TAD FLTXR /TEST FOR END OF LIST
|
||
CMA
|
||
TAD LASTV
|
||
SNA CLA
|
||
JMP TDEND /END FOUND
|
||
TAD TDTEXT /NO, SET UP POINTERS
|
||
DCA AXOUT
|
||
DCA XCT
|
||
TAD I FLTXR /2 LETTERS OF VAR. NAME
|
||
DCA TDTEXT+1
|
||
PUSHJ /PRINT NAME AND "("
|
||
TQUOT
|
||
TAD I FLTXR /GET AND PRINT SUBSCRIPT
|
||
JMS I TDOUTP
|
||
PUSHJ /PRINT ")="
|
||
TQUOT
|
||
TAD P13 /SPACE TO 11TH COLUMN
|
||
DCA FLAC2
|
||
PUSHJ
|
||
TAB+12
|
||
ISZ FLTXR
|
||
FENT /PICK UP VALUE
|
||
FGT I FLTXR /(DOES NOT AUTOINDEX)
|
||
FEXT
|
||
JMS I FOUTPUT /PRINT VALUE
|
||
TAD CCR /AND A C.R.
|
||
PRINTC
|
||
TAD FLTXR /INCREMENT FOR NEXT VAR.
|
||
TAD P2
|
||
JMP TDLOOP
|
||
TDEND, POPF /RESTORE TEXT POINTERS
|
||
TEXTP
|
||
JMP I .+1
|
||
TASK4
|
||
TDOUTP, SIGOUT
|
||
TDTEXT, . /THE FOLLOWING IS FOCAL TEXT
|
||
0 /VAR. NAME GOES HERE
|
||
5077 /"(" AND C.R.
|
||
1551 /")=" AND C.R.
|
||
7577
|
||
1500
|
||
/OPTION ROUTINES
|
||
/
|
||
/ROUTINE TO SET UP OUTPUT
|
||
OPTTDO, 0
|
||
TAD CTSF
|
||
DCA I OPTTL /TSF
|
||
TAD I OPTTL
|
||
IAC
|
||
DCA I OPTTL+1 /TCF
|
||
TAD I OPTTL+1
|
||
TAD P2
|
||
DCA I OPTTL+2 /TPC
|
||
TAD I OPTTL+2
|
||
TAD P2
|
||
DCA I OPTTL+3 /TLS
|
||
JMP I OPTTDO
|
||
CTSF, TSF
|
||
OPTTL, TINT
|
||
TINT+2
|
||
TINT+7
|
||
SIN+11
|
||
/////
|
||
/ROUTINE TO WAIT UNTIL OUTPUT FINISHES
|
||
OWAIT, 0
|
||
ION /(SWAP) - FOR 2-USER
|
||
TAD I TSWP /LOOK AT TELSW
|
||
SZA CLA
|
||
JMP .-3
|
||
JMP I OWAIT
|
||
TSWP, TELSW
|
||
/////
|
||
OPTP, JMS OWAIT /SET UP FOR PUNCH OUTPUT
|
||
TAD M20 /CONVERT TO PSF, ETC.
|
||
SKP
|
||
OPTT, JMS OWAIT /SET UP FOR TTY OUTPUT
|
||
JMS OPTTDO
|
||
OPTXIT, JMP I .+1 /EXIT OPTIONS
|
||
OPTRET
|
||
|
||
OPTX, TAD OPTC1 /SUPPRESS ":" ON ASK
|
||
OPTCOL, TAD CPRINT /RESTORE ":"
|
||
DCA I COLP
|
||
JMP OPTXIT
|
||
CPRINT, PRINTC
|
||
OPTC1, CLA-PRINTC
|
||
COLP, TASKCL
|
||
/////
|
||
OPTE, TAD CPRINT /SET UP FOR KEYBOARD ECHO
|
||
OPTN, DCA I ECHP /SUPPRESS ECHO
|
||
JMP OPTXIT
|
||
ECHP, ECHO
|
||
/////
|
||
OPTS, GETC /SET UP USER TERMINATOR FOR "ASK"
|
||
SORTC
|
||
TERMS-3
|
||
SKP
|
||
JMP .-4
|
||
PUSHJ /GET CHARACTER
|
||
EVAL
|
||
FIX
|
||
DCA I USERTP
|
||
JMP OPTXIT
|
||
USERTP, USERT
|
||
/////
|
||
OPTM, JMS OWAIT /EXIT TO DISK MONITOR
|
||
IOF
|
||
JMP I P7600
|
||
/////
|
||
/THIS IS THE INITIALIZATION COMMAND
|
||
HELLO, TAD HP
|
||
DCA AXOUT
|
||
DCA XCT
|
||
PUSHJ /START BY SETTING FORMAT
|
||
TINTR
|
||
/////
|
||
HP, HPT-1 /FOCAL TEXT "%8.4;O K,T,I,E,:,S;E A"
|
||
/ I/O MODE OPTIONS
|
||
OPTC, CLA CMA
|
||
OPTI, DCA IOSW
|
||
JMP OPTXIT
|
||
/////
|
||
IOSW, 0
|
||
/ I/O MODE: "I" = 0000 = INTERPRETIVE INPUT, NUMERIC OUTPUT
|
||
/ "C" = 7777 = SINGLE CHARACTER I/O
|
||
/////
|
||
/"ASK" MASTER ROUTINE
|
||
INTASK, 0
|
||
TAD PT1 /SAVE VAR. POINTER
|
||
DCA OWAIT
|
||
TAD IOSW /WHAT MODE OF INPUT?
|
||
SNA CLA
|
||
JMP STRING /INTERPRETIVE
|
||
READC /SINGLE CHARACTER
|
||
TAD CHAR /CONVERT CHARACTER CODE TO FLOATING
|
||
FLOAT /POINT NUMBER
|
||
ASKEND, FENT /SAVE VALUE
|
||
FPT I OWAIT
|
||
FEXT
|
||
JMP I INTASK
|
||
/INTERPRETIVE BUFFERED INPUT
|
||
STRING, TAD PDLXR /SAVE PUSHDOWN LIST POINTER
|
||
DCA OPTTDO
|
||
TAD BUFTOP /PROTECT TOP OF ASKBUF
|
||
DCA PDLXR
|
||
ISZ DEBGSW /DISABLE TRACE
|
||
INBARR, TAD BUFBOT /INITIALIZE ASKBUF
|
||
DCA AXIN
|
||
DCA XCTIN
|
||
TAD BUFBOT
|
||
DCA PACKST
|
||
READC /IGNORE SPACES
|
||
SORTC
|
||
C240-1
|
||
JMP .-3
|
||
SORTJ /SEARCH FOR TERMINATOR
|
||
ASKLST-1
|
||
ASKLS2-ASKLST
|
||
PACKC /PACK INTO BUFFER
|
||
INGT, READC
|
||
JMP .-5
|
||
/TERMINATOR FOUND, PROCESS INPUT
|
||
INTERM, TAD CCR /PACK A C.R.
|
||
DCA CHAR
|
||
PACKC
|
||
PACKC
|
||
TAD OPTTDO /RESTORE PDLXR
|
||
DCA PDLXR
|
||
TAD BUFBOT /INITIALIZE UNPACKING
|
||
DCA AXOUT
|
||
DCA XCT
|
||
PUSHJ /EVALUATE EXPRESSION
|
||
EVAL-1
|
||
JMP ASKEND
|
||
/////
|
||
BUFBOT, ASKBUF /BOTTOM OF BUFFER
|
||
BUFTOP, ASKBND /TOP+12 OF BUFFER
|
||
/////
|
||
/"TYPE" OUTPUT
|
||
OUTPT, 0
|
||
TAD IOSW /WHAT KIND OF OUTPUT
|
||
SZA CLA
|
||
JMP COUTPT /SINGLE CHARACTER
|
||
JMS I FOUTPUT /NUMERIC OUTPUT, PRINT VALUE
|
||
JMP I OUTPT
|
||
/////
|
||
COUTPT, FIX /GET CODE FOR CHARACTER
|
||
SNA /MODULO 256
|
||
CLL CML RAR /TO ALLOW ZERO CODE TO BE PRINTED
|
||
JMS I OUTDEV
|
||
JMP I OUTPT
|
||
/NOTE: "TDUMP" PRINTS ONLY IN NUMERIC MODE
|
||
IOBUF=3400
|
||
/
|
||
*IOBUF+20
|
||
FRST, 0 /TEXT POINTER
|
||
0000 /DUMMY LINE NO
|
||
0355 / C-
|
||
0617 / FO
|
||
0301 / CA
|
||
1454 / L,
|
||
4040
|
||
6557 / 5/
|
||
FRSTX, 6671 / 69
|
||
7715
|
||
BUFBEG=.
|
||
/////
|
||
/FOCAL INITIALIZATION ROUTINE
|
||
*BUFBEG
|
||
BEGIN, CLA CLL
|
||
TAD (RECOVR+1 /RESTORE RESTART
|
||
DCA START-1
|
||
IOF /CLEAR FLAGS TO PREVENT INTERRUPT
|
||
6022 /PCF
|
||
6032 /KCC
|
||
6203 /CDF CIF 00
|
||
6402 /CLEAR PT08'S
|
||
6412
|
||
6422
|
||
6432
|
||
6442
|
||
6452
|
||
6462
|
||
6472
|
||
6764 /CLEAR DECTAPE
|
||
6772
|
||
CLA
|
||
TLS /START LOW SPEED OUTPUT
|
||
DCA I FLTXR /CLEAR OUTPUT BUFFER
|
||
ISZ (-20
|
||
JMP .-2
|
||
TAD BOTTOM /INITIALIZE PUSHDOWN LIST
|
||
DCA PDLXR
|
||
ION
|
||
PRINTC /CHAR IS A C.R
|
||
PRINTC
|
||
PRINTC
|
||
PUSHJ /TYPE FOCAL HEADING
|
||
WRITE
|
||
JMP I .+1
|
||
ERV-3 /ERASE ALL
|
||
|
||
/EXTENDED FUNCTION PACKAGE FOR FOCAL 5/69
|
||
/E.A.TAFT, 6/10/69
|
||
/
|
||
/FSIN: SIN(X) X IN RADIANS
|
||
/FCOS: COS(X) X IN RADIANS
|
||
/FATN: ARC TAN(X) RESULT IN RADIANS
|
||
/FEXP: EXP(X)
|
||
/FLOG: LN(X)
|
||
/////
|
||
/DEFINITIONS
|
||
FIXMRI FAD=1000
|
||
FIXMRI FSB=2000
|
||
FIXMRI FMY=3000
|
||
FIXMRI FDV=4000
|
||
FIXMRI FGT=5000
|
||
FIXMRI FPT=6000
|
||
FNR=7000
|
||
FENT=4407
|
||
FEXT=0
|
||
/////
|
||
NEGATE= 4450
|
||
GETSGN= 1045
|
||
RETURN= 5500
|
||
SN= 10
|
||
FIX= 4452
|
||
PUSHA= 4503
|
||
POPA= 1413
|
||
FLAC= 44
|
||
FLTEMP= 7545
|
||
FLTONE= 1573
|
||
PDLXR= 13
|
||
ERROR= 4526
|
||
FLOAT= 4430
|
||
FNTABF= 571
|
||
BOTTOM= 27
|
||
COMGO= 1164
|
||
SORTJ= 4510
|
||
M5= 67
|
||
CNTR= 132
|
||
AXIN= 10
|
||
TSTERM= 4565
|
||
PROC= 616
|
||
ERROR5= 2735
|
||
DBCONV= 5600
|
||
*BOTTOM
|
||
FCOS-1 /TOP OF TEXT
|
||
*FNTABF+7
|
||
FATN /POINTERS TO EXTENDED FUNCTIONS
|
||
FEXP
|
||
FLOG
|
||
FSIN
|
||
FCOS
|
||
/////
|
||
/ENABLE A "LIBRARY DELETE" COMMAND
|
||
/WHICH WILL DELETE THE EXTENDED FUNCTIONS AND
|
||
/FREE MORE FOR USER AREA.
|
||
*COMGO+10
|
||
LIBRARY
|
||
*6555
|
||
LIBLST, "D
|
||
/////
|
||
LIBRARY,SORTJ /"LIBRARY" - EXPANDABLE COMMAND
|
||
LIBLST-1
|
||
LIBGO-LIBLST
|
||
ERROR /ILLEGAL LIBRARY COMMAND
|
||
/////
|
||
LIBD, TAD M5 /DELETE THE EXTENDED FUNCTIONS
|
||
DCA CNTR
|
||
TAD EXTAB
|
||
DCA AXIN
|
||
TAD PERROR
|
||
DCA I AXIN /SET ERROR5 POINTERS
|
||
ISZ CNTR
|
||
JMP .-3
|
||
TAD DTOP
|
||
DCA BOTTOM /MOVE TOP POINTER UP
|
||
JMP 6461 /OPTRET (TO REACH END OF COMMAND)
|
||
/////
|
||
EXTAB, FNTABF+6
|
||
DTOP, DBCONV-1
|
||
LIBGO, LIBD
|
||
*175
|
||
PERROR, ERROR5
|
||
/FOCAL EXTENDED FUNCTIONS
|
||
*5113
|
||
/ COSINE
|
||
FCOS, NEGATE /COS(X)=SIN(PI/2-X)
|
||
FENT
|
||
FAD I PI2
|
||
FEXT
|
||
/////
|
||
/ SINE
|
||
FSIN, GETSGN
|
||
SNA
|
||
RETURN /SIN(0)=0
|
||
SPA CLA
|
||
JMS I NEG2 /SIN(-X)=-SIN(X)
|
||
DCA SN
|
||
FENT
|
||
FDV TWOPI /REDUCE MODULO 2 PI
|
||
FPT I X2
|
||
FEXT
|
||
FIX
|
||
NEGATE
|
||
FENT
|
||
FNR
|
||
FAD I X2
|
||
FMY TWOPI
|
||
FPT I X2
|
||
FSB PI
|
||
FEXT
|
||
GETSGN /X<PI?
|
||
SPA CLA
|
||
JMP PCHECK /YES
|
||
FENT /NO, SIN(X-PI)=-SIN(X)
|
||
FPT I X2
|
||
FEXT
|
||
TAD SN
|
||
CMA
|
||
DCA SN
|
||
PCHECK, FENT /X<PI/2?
|
||
FGT I X2
|
||
FSB I PI2
|
||
FEXT
|
||
GETSGN
|
||
SPA CLA
|
||
JMP PALGO /YES
|
||
FENT /NO, SIN(X)=SIN(PI-X)
|
||
FGT PI
|
||
FSB I X2
|
||
FPT I X2
|
||
FEXT
|
||
PALGO, JMP I .+1 /PERFORM POWER SERIES EXPANSION
|
||
PALG
|
||
|
||
NEG2, FNEG
|
||
PI2, PIOT
|
||
X2, X
|
||
TWOPI, 0003
|
||
3110
|
||
3761
|
||
PI, 0002
|
||
3110
|
||
3761
|
||
/ EXPONENTIAL
|
||
FEXP, GETSGN /TAKE ABSOLUTE VALUE
|
||
SPA CLA
|
||
JMS FNEG
|
||
DCA SN
|
||
FENT
|
||
FMY LG2E
|
||
FPT X
|
||
FEXT
|
||
FIX
|
||
PUSHA /SAVE INTEGER PART
|
||
NEGATE
|
||
FENT
|
||
FNR
|
||
FAD X /RETAIN FRACTIONAL PART
|
||
FPT X
|
||
FMY X
|
||
FPT XSQR
|
||
FAD DF
|
||
FPT I TP
|
||
FGT CF
|
||
FDV I TP
|
||
FSB X
|
||
FAD AF
|
||
FPT I TP
|
||
FGT BF
|
||
FMY XSQR
|
||
FAD I TP
|
||
FPT I TP
|
||
FGT X
|
||
FDV I TP
|
||
FMY TWO
|
||
FAD I ONEPT
|
||
FEXT
|
||
POPA
|
||
TAD FLAC
|
||
DCA FLAC
|
||
ISZ SN /EXP(-X)=1/EXP(X)
|
||
RETURN
|
||
FENT
|
||
FPT X
|
||
FGT I ONEPT
|
||
FDV X
|
||
FEXT
|
||
RETURN
|
||
/EXP AND ARCTANGENT CONSTANTS
|
||
AF, 0004
|
||
2372
|
||
1402
|
||
BF, 7774
|
||
2157
|
||
5157
|
||
CF, 0012
|
||
5454
|
||
0343
|
||
DF, 0007
|
||
2566
|
||
5341
|
||
LG2E, 0001
|
||
2705
|
||
2435
|
||
TWO, 0002
|
||
2000
|
||
BET1, 0000
|
||
2427
|
||
2323
|
||
BET2, 7775
|
||
3427
|
||
7052
|
||
BETZ, 0000
|
||
2437
|
||
1646
|
||
ALF2, 7773
|
||
3306
|
||
5454
|
||
ALF1, 7777
|
||
3304
|
||
4434
|
||
ALFZ, 0000
|
||
2437
|
||
1643
|
||
/////
|
||
/ROUTINE TO NEGATE FLAC AND RETURN WITH AC=7777
|
||
FNEG, 0
|
||
NEGATE
|
||
CMA
|
||
JMP I FNEG
|
||
/VARIABLES
|
||
X, 0
|
||
0
|
||
0
|
||
XSQR, 0
|
||
0
|
||
0
|
||
/POINTERS
|
||
TP, FLTEMP
|
||
ONEPT, FLTONE
|
||
/ ARC TANGENT
|
||
FATN, GETSGN /TAKE ABSOLUTE VALUE
|
||
SPA CLA
|
||
JMS FNEG
|
||
DCA SN
|
||
FENT
|
||
FPT X
|
||
FGT X
|
||
FSB I ONEPT
|
||
FEXT
|
||
GETSGN
|
||
SPA CLA
|
||
JMP GO
|
||
FENT
|
||
FGT I ONEPT
|
||
FDV X
|
||
FPT X
|
||
FEXT
|
||
CMA
|
||
GO, PUSHA /SIGN FLAG
|
||
FENT
|
||
FGT X
|
||
FMY X
|
||
FPT XSQR
|
||
FMY BET2
|
||
FAD BET1
|
||
FMY XSQR
|
||
FAD BETZ
|
||
FPT I TP
|
||
FGT ALF2
|
||
FMY XSQR
|
||
FAD ALF1
|
||
FMY XSQR
|
||
FAD ALFZ
|
||
FMY X
|
||
FDV I TP
|
||
FEXT
|
||
ISZ I PDLXR /CHECK SIGN FLAG
|
||
JMP EXIT2
|
||
NEGATE /SUBTRACT FROM PI/2
|
||
FENT
|
||
FAD PIOT
|
||
FEXT
|
||
EXIT2, ISZ SN /ARC TAN(-X)=-ARC TAN(X)
|
||
RETURN
|
||
NEGATE
|
||
RETURN
|
||
/ARCTANGENT AND LOG CONSTANTS AND POINTERS
|
||
PIOT, 0001 /PI/2
|
||
3110
|
||
3761
|
||
L8, 7771
|
||
4544
|
||
1735
|
||
L7, 7774
|
||
2236
|
||
4304
|
||
L6, 7775
|
||
4746
|
||
0771
|
||
L5, 7776
|
||
2535
|
||
3301
|
||
L4, 7776
|
||
4113
|
||
7211
|
||
L3, 7777
|
||
2517
|
||
0307
|
||
L2, 7777
|
||
4000
|
||
4100
|
||
L1, 0000
|
||
3777
|
||
7742
|
||
LOGE2, 0000
|
||
2613
|
||
4414
|
||
TP1, FLTEMP
|
||
ONEP2, FLTONE
|
||
X1, X
|
||
/ LOGARITHM
|
||
FLOG, GETSGN
|
||
SPA SNA
|
||
ERROR /ZERO OR NEGATIVE ARGUMENT
|
||
FENT
|
||
FPT I TP1
|
||
FSB I ONEP2
|
||
FEXT
|
||
GETSGN
|
||
SNA
|
||
JMP ZERGO /LOG(1)=0
|
||
SMA CLA
|
||
JMP STARTL
|
||
FENT /LOG(X)=-LOG(1/X)
|
||
FGT I ONEP2
|
||
FDV I TP1
|
||
FPT I TP1
|
||
FEXT
|
||
CMA
|
||
STARTL, DCA SN
|
||
CMA
|
||
TAD I TP1
|
||
FLOAT
|
||
FENT
|
||
FMY LOGE2
|
||
FPT I X1
|
||
FEXT
|
||
IAC
|
||
DCA I TP1
|
||
FENT
|
||
FGT I TP1
|
||
FSB I ONEP2
|
||
FPT I TP1
|
||
FMY L8
|
||
FAD L7
|
||
FMY I TP1
|
||
FAD L6
|
||
FMY I TP1
|
||
FAD L5
|
||
FMY I TP1
|
||
FAD L4
|
||
FMY I TP1
|
||
FAD L3
|
||
FMY I TP1
|
||
FAD L2
|
||
FMY I TP1
|
||
FAD L1
|
||
FMY I TP1
|
||
FAD I X1
|
||
FEXT
|
||
JMP EXIT2
|
||
ZERGO, FLOAT
|
||
RETURN
|
||
/CONTINUATION OF SINE ROUTINE
|
||
PALG, FENT
|
||
FGT I X1
|
||
FDV PIOT
|
||
FPT I X1
|
||
FMY I X1
|
||
FPT I TP1
|
||
FMY C9
|
||
FAD C7
|
||
FMY I TP1
|
||
FAD C5
|
||
FMY I TP1
|
||
FAD C3
|
||
FMY I TP1
|
||
FAD PIOT
|
||
FMY I X1
|
||
FEXT
|
||
JMP EXIT2
|
||
/SINE CONSTANTS
|
||
C9, 7764
|
||
2366
|
||
5735
|
||
C7, 7771
|
||
5466
|
||
6317
|
||
C5, 7775
|
||
2431
|
||
5053
|
||
C3, 0000
|
||
5325
|
||
0420
|
||
|
||
/***** FLOAT -- FOR FOCAL 5/69 *****
|
||
/E.A.TAFT 25-JUL-72
|
||
*5600
|
||
/DECIMAL TO BINARY CONVERSION 2/10/69
|
||
DBCONV, 0
|
||
FLOAT /FLOAT A ZERO
|
||
DCA DECEXP /INITIALIZE
|
||
CMA
|
||
DCA PSWIT
|
||
TAD C43 /35(10)
|
||
DCA FLAC0
|
||
JMS I SGNTST /SIGN OF MANTISSA
|
||
DCA INSIGN
|
||
JMP NEWDIG+1
|
||
PERIOD, ISZ PSWIT /. FOUND, SEE IF FIRST
|
||
ERROR /DOUBLE PERIODS
|
||
NEWDIG, GETC /LOOK FOR A DIGIT
|
||
TESTN
|
||
JMP PERIOD /. FOUND
|
||
JMP NOTDIG /NOT FOUND
|
||
TAD PSWIT /DECREMENT DECIMAL EXPONENT
|
||
SMA CLA /IF AFTER .
|
||
CMA
|
||
TAD DECEXP
|
||
DCA DECEXP
|
||
JMS MULT10 /MULTIPLY FLAC BY 10
|
||
TAD SORTCN /ADD NEW DIGIT
|
||
DCA FLOP3
|
||
DCA FLOP2
|
||
DCA FLOP1
|
||
JMS TRPLAD
|
||
OVCHEK, TAD REMAIN /CHECK FOR OVERFLOW
|
||
SZA CLA
|
||
JMP .+4
|
||
TAD FLAC1
|
||
SMA CLA
|
||
JMP NEWDIG /NO OVERFLOW
|
||
TAD IOVRL /OVERFLOW, ROTATE RIGHT
|
||
DCA I IRARAC /SET UP RETURN TO OVCHEK
|
||
TAD REMAIN /ROTATE REMAIN
|
||
CLL RAR
|
||
DCA REMAIN
|
||
TAD FLAC1
|
||
JMP I ROTRAC /ROTATE REST OF FLAC
|
||
|
||
NOTDIG, SORTC /TEST FOR LETTER E
|
||
C305-1
|
||
JMP EINPUT /FOUND E
|
||
DBTERM, ISZ INSIGN /END OF INPUT, AFFIX SIGN
|
||
NEGATE
|
||
TAD CFNR /SET UP TO NORMALIZE
|
||
DBLOOP, DCA .+2
|
||
FENT
|
||
PSWIT, FNR /OR FMY BY 10 OR .10
|
||
FPT I PT1 /SAVE RESULT
|
||
FEXT
|
||
TAD DECEXP /CHECK DECIMAL EXPONENT
|
||
SNA
|
||
JMP I DBCONV /DONE
|
||
SMA
|
||
JMP .+4
|
||
IAC /NEGATIVE, SET UP TO FMY BY .10
|
||
DCA DECEXP
|
||
JMP .+5
|
||
CLA CMA /POSITIVE, SET UP TO FMY BY 10
|
||
TAD DECEXP
|
||
DCA DECEXP
|
||
TAD M3
|
||
TAD FLINST /INSTRUCTION FMY FLTEN OR FLPTEN
|
||
JMP DBLOOP
|
||
EINPUT, GETC /FOUND "E"
|
||
JMS I SGNTST /TEST FOR SIGN
|
||
DCA FLOP0
|
||
JMS I DECIN1 /INPUT A DECIMAL INTEGER
|
||
TAD DECNUM
|
||
ISZ FLOP0 /CHECK SIGN
|
||
CIA
|
||
TAD DECEXP
|
||
DCA DECEXP
|
||
JMP DBTERM
|
||
/ADD FLOP TO FLAC TRIPLE PRECISION WITH OVERFLOW
|
||
TRPLAD, 0
|
||
CLA CLL
|
||
TAD FLOP3
|
||
TAD FLAC3
|
||
DCA FLAC3
|
||
RAL
|
||
TAD FLOP2
|
||
TAD FLAC2
|
||
DCA FLAC2
|
||
RAL
|
||
TAD FLOP1
|
||
TAD FLAC1
|
||
DCA FLAC1
|
||
RAL
|
||
TAD REMAIN
|
||
DCA REMAIN
|
||
JMP I TRPLAD
|
||
/MULTIPLY FLAC BY 2
|
||
MULT2, 0
|
||
JMS I MULT2I
|
||
TAD REMAIN
|
||
RAL
|
||
DCA REMAIN
|
||
JMP I MULT2
|
||
/MULTIPLY FLAC BY 10
|
||
MULT10, 0
|
||
PUSHF /FLAC=>FLOP
|
||
FLAC1
|
||
POPF
|
||
FLOP1
|
||
DCA REMAIN /CLEAR OVERFLOW
|
||
JMS MULT2 /FLAC*10 = (FLAC*2*2+FLAC)*2
|
||
JMS MULT2
|
||
JMS TRPLAD
|
||
JMS MULT2
|
||
JMP I MULT10
|
||
SGNTST, TSTSGN
|
||
MULT2I, RALAC
|
||
DECIN1, DECINT
|
||
IRARAC, RARAC
|
||
IOVRL, OVCHEK
|
||
ROTRAC, RARAC+5
|
||
C43, 43
|
||
DECEXP, 0 /IMPLICIT DECIMAL EXPONENT
|
||
INSIGN, 0 /SIGN OF MANTISSA
|
||
CFNR, FNR
|
||
FLINST, FMY .+4
|
||
FLTEN, 0004 /10(10) FLOATING
|
||
2400
|
||
0000
|
||
FLPTEN, 7775 /.10(10) FLOATING
|
||
3146
|
||
3147
|
||
REMAIN=TEMP1
|
||
/CHARACTER LIST FOR "ASK"
|
||
ASKLST, 215 /CR
|
||
214 /FF
|
||
337 /BA
|
||
254 /COMMA
|
||
USERT, 0 /USER-SELECTED CHARACTER
|
||
212 /LF
|
||
/POWER OF 10 TABLE
|
||
INTABL, -1750 /1000
|
||
-144 /100
|
||
-12 /10
|
||
-1 /1
|
||
/INPUT A DECIMAL INTEGER <2048
|
||
DECINT, 0
|
||
DCA DECNUM
|
||
TESTN /GET A DIGIT
|
||
NOP
|
||
JMP I DECINT /NONE FOUND
|
||
GETC
|
||
TAD DECNUM /MULTIPLY PREV. # BY 10
|
||
CLL RTL
|
||
SPA SZL
|
||
JMP .+5 /OVERFLOW (>2047)
|
||
TAD DECNUM
|
||
RAL
|
||
TAD SORTCN /ADD NEW DIGIT
|
||
SPA SZL
|
||
ERROR
|
||
JMP DECINT+1
|
||
DECNUM=TEMP3
|
||
/TEST FOR A SIGN
|
||
TSTSGN, 0
|
||
SPNOR
|
||
DCA SORTCN
|
||
SORTC /LOOK FOR + OR -
|
||
SNLIST-1
|
||
GETC /SIGN FOUND
|
||
SPNOR /NOT FOUND
|
||
CLA CMA
|
||
TAD SORTCN /SORTCN: 0=+, 1=-
|
||
JMP I TSTSGN /AC: 7777=+, 0=-
|
||
DIGIT=TEMP2
|
||
/PRINT A 2-4 DIGIT UNSIGNED DECIMAL INTEGER
|
||
/FIRST 2 LEADING ZEROES NOT PRINTED
|
||
INTOUT, 0
|
||
DCA DECNUM
|
||
TAD INTPTR /POWER OF 10 POINTER
|
||
DCA INTSUB
|
||
DCA DECINT /DECINT=0 MEANS SKIP 0 OUTPUT
|
||
JMS INTDO /1ST DIGIT (1000S)
|
||
JMS INTDO /2ND DIGIT (100S)
|
||
ISZ DECINT /DECINT>0 MEANS PRINT 0S
|
||
JMS INTDO /3RD DIGIT (10S)
|
||
JMS INTDO /4TH DIGIT (UNITS)
|
||
JMP I INTOUT
|
||
INTDO, 0
|
||
DCA DIGIT /INITIALIZE
|
||
TAD DECNUM
|
||
INTSUB, TAD INTABL /SUBTRACT A POWER OF 10
|
||
SPA
|
||
JMP INTNEG
|
||
DCA DECNUM /POSITIVE RESULT
|
||
ISZ DIGIT /NONZERO DIGIT, SO IGNORE NO
|
||
ISZ DECINT /FURTHER ZEROES
|
||
JMP INTSUB-1
|
||
INTNEG, CLA CLL /NEGATIVE RESULT
|
||
ISZ INTSUB /SET UP NEXT POWER OF 10
|
||
TAD DECINT /IS IT A LEADING 0?
|
||
SNA CLA
|
||
JMP I INTDO /YES, SKIP IT
|
||
TAD DIGIT /NO, PRINT DIGIT
|
||
TAD C260
|
||
PRINTC
|
||
JMP I INTDO
|
||
/OUTPUT A SIGNED INTEGER IN AC
|
||
SIGOUT, 0
|
||
DCA DECNUM /SAVE NUMBER
|
||
TAD DECNUM
|
||
SPA CLA
|
||
TAD P2 /MAKE A -
|
||
TAD C253 /MAKE A +
|
||
PRINTC
|
||
TAD DECNUM /OUTPUT ABSOLUTE VALUE
|
||
SPA
|
||
CIA
|
||
JMS INTOUT /OUTPUT THE NUMBER
|
||
JMP I SIGOUT
|
||
INTPTR, TAD INTABL
|
||
SNLIST=. /FOR SIGN TESTING
|
||
C253, 253 /+
|
||
255 /-
|
||
/E FORMAT OUTPUT ROUTINE
|
||
XXX, CLA /CONVERT TO E FORMAT ON OVERFLOW
|
||
TAD TOTDIG
|
||
SKP
|
||
FLOUT, TAD DECP /E FORMAT (%0) FLOATING OUTPUT
|
||
CIA
|
||
SNA
|
||
TAD MDIG /6 DIGITS IF 0 GIVEN
|
||
DCA DECNUM /DIGIT COUNTER
|
||
TAD PER /PERIOD
|
||
PRINTC
|
||
FLDIG, TAD I XRT2 /NEXT DIGIT
|
||
ISZ T2 /OUT OF SIG DIGITS?
|
||
JMP .+3 /NO, PRINT DIGIT
|
||
CLA CMA /YES, RESET POINTER AND PRINT 0
|
||
DCA T2
|
||
JMS I OUTP
|
||
SKP /FIELD NOW FILLED, PRINT EXPONENT
|
||
JMP FLDIG
|
||
/B-D CONV EXPONENT OUTPUT
|
||
TAD C305 /PRINT LETTER E
|
||
PRINTC
|
||
TAD T1 /OUTPUT THE EXPONENT
|
||
JMS SIGOUT
|
||
BDEND, JMP I BDCONV /DONE
|
||
C305, 305 /E
|
||
MDIG, -DIGITS
|
||
OUTP, OUTA
|
||
/PRINT A LINE NUMBER - "PRNTLN"
|
||
XPRNTL, 0
|
||
TAD LINENO
|
||
RTL6
|
||
AND P77
|
||
JMS INTOUT /2-DIGIT PART NUMBER
|
||
TAD PER
|
||
PRINTC /DECIMAL POINT
|
||
TAD LINENO
|
||
AND P177 /2-DIGIT STEP NUMBER
|
||
JMS INTOUT
|
||
TAD C240 /SPACE
|
||
DCA CHAR
|
||
PRINTC
|
||
JMP I XPRNTL
|
||
|
||
NEGSGN, 255-240
|
||
/BINARY TO DECIMAL CONVERSION AND OUTPUT
|
||
BDCONV, 0
|
||
TAD FLAC1 /CHECK SIGN
|
||
SMA CLA
|
||
JMP .+3
|
||
NEGATE /NEGATIVE, TAKE ABSOLUTE VALUE
|
||
TAD NEGSGN /MAKE A -
|
||
TAD C240 /MAKE A SPACE
|
||
PRINTC
|
||
CLA CMA /DECREMENT BINARY EXPONENT
|
||
TAD FLAC0
|
||
DCA FLAC0
|
||
BDSCAL, DCA T1 /INITIALIZE DECIMAL EXPONENT
|
||
TAD FLAC0 /START SCALING: -4<EXP<0?
|
||
SMA
|
||
JMP SDOWN /TOO BIG, SCALE DOWN
|
||
TAD I TENPT
|
||
SMA CLA
|
||
JMP SCALED /WITHIN LIMITS, DONE
|
||
FENT /TOO SMALL, SCALE UP
|
||
FMY I TENPT
|
||
FEXT
|
||
CLA CMA
|
||
TAD T1 /DECREMENT DECIMAL EXPONENT
|
||
JMP BDSCAL
|
||
SDOWN, FENT /SCALE DOWN
|
||
FMY I PTENPT
|
||
FEXT
|
||
IAC /INCREMENT DECIMAL EXPONENT
|
||
JMP .-6
|
||
/CONSTANTS
|
||
DCOUNT, -DIGITS-1
|
||
MDIGIT, -DIGITS
|
||
RND2, DIGITS+1
|
||
M12, -12
|
||
/POINTERS
|
||
TENPT, FLTEN
|
||
PTENPT, FLPTEN
|
||
MULT2P, MULT2
|
||
MUL10P, MULT10
|
||
BUFST, DIGBUF-1
|
||
FLOUTP, FLOUT
|
||
XXXP, XXX
|
||
/ROUTINE TO DECREMENT THE DIGIT POINTER
|
||
DECR, CMA
|
||
TAD FLOP0
|
||
DCA FLOP0
|
||
JMP RET
|
||
/FINISHED SCALING, GENERATE DIGITS
|
||
SCALED, JMS I MULT2P /ROTATE FLAC LEFT
|
||
TAD BUFST /INITIALIZE DIGIT BUFFER
|
||
DCA XRT2
|
||
JMS I MUL10P /MULTIPLY BY 10
|
||
TAD REMAIN /OVERFLOW
|
||
JMP BDC1
|
||
BDC0, CLL RAR
|
||
DCA FNEGSW /TEMP STORAGE OF FIRST DIGIT
|
||
TAD FLAC1 /ROTATE FLAC RIGHT
|
||
RAR
|
||
DCA FLAC1
|
||
TAD FLAC2
|
||
RAR
|
||
DCA FLAC2
|
||
TAD FLAC3
|
||
RAR
|
||
DCA FLAC3
|
||
TAD FNEGSW /PREV. OVERFLOW
|
||
BDC1, ISZ FLAC0 /CHECK ROTATE COUNT
|
||
JMP BDC0
|
||
SZA
|
||
JMP BDC2
|
||
CLA CMA /FIRST DIGIT IS 0, IGNORE
|
||
TAD T1 /DECREMENT DECIMAL EXPONENT
|
||
DCA T1
|
||
TAD FLAC1
|
||
SNA CLA
|
||
DCA T1 /EXP=0 IF MANTISSA=0
|
||
SKP
|
||
BDC2, DCA I XRT2 /FIRST DIGIT WAS NOT 0
|
||
TAD DCOUNT /SET TO COUNT DIGITS
|
||
DCA FLAC0
|
||
JMS I MUL10P /MULTIPLY BY 10
|
||
TAD REMAIN
|
||
DCA I XRT2 /SAVE DIGIT JUST GENERATED
|
||
ISZ FLAC0
|
||
JMP .-4
|
||
TAD BUFST /REINITIALIZE POINTER
|
||
DCA XRT2
|
||
TAD DCOUNT /DIGITS AVAILABLE
|
||
DCA T2
|
||
TAD TOTDIG /DIGITS WANTED
|
||
SNA
|
||
JMP R6 /E FORMAT, ROUND TO 6 PLACES
|
||
CIA /COMPUTE FIELD SIZES
|
||
TAD DECP
|
||
SPA SNA
|
||
JMP .+4 /COMPARE DECP TO TOTDIG
|
||
CLA /MORE DECP THAN TOTAL DIGITS!
|
||
TAD TOTDIG
|
||
DCA DECP
|
||
TAD T1 /COMPARE EXPONENT TO FIELD SIZE
|
||
SMA
|
||
CLA /INTEGER FIELD >= EXPONENT
|
||
TAD TOTDIG
|
||
SPA
|
||
JMP FPRNT-2 /NO ROUNDING NEEDED
|
||
TAD MDIGIT /ROUND TO DECP+EXP PLACES
|
||
SMA
|
||
CLA
|
||
R6, TAD RND2 /START ROUNDING
|
||
DCA FNEGSW /PLACES TO ROUND TO
|
||
TAD BUFST /ROUNDING START ADDRESS
|
||
TAD FNEGSW /SET UP ROUND COUNT
|
||
DCA FLOP0
|
||
TAD FNEGSW
|
||
CIA
|
||
DCA FNEGSW /START ROUNDING PROCESS BY
|
||
TAD I TENPT /ADDING 4 TO FIRST DIGIT
|
||
RET, ISZ I FLOP0 /INCREMENT CURRENT DIGIT
|
||
TAD I FLOP0
|
||
TAD M12
|
||
SPA CLA /DIGIT>9?
|
||
JMP FPRNT /NO, END ROUNDING
|
||
DCA I FLOP0 /YES, SET DIGIT TO 0 AND CARRY
|
||
ISZ FNEGSW /BEGINNING OF BUFFER?
|
||
JMP DECR /NO DECREMENT BUFFER ADDRESS
|
||
ISZ I FLOP0 /YES, FAKE CARRY FROM FIRST DIGIT
|
||
ISZ T1
|
||
CLA
|
||
|
||
FPRNT, TAD TOTDIG /SET UP FIELD SIZES
|
||
SNA
|
||
JMP I FLOUTP /E FORMAT OUTPUT
|
||
CIA
|
||
DCA DECNUM /NUMBER OF PLACES TO PRINT
|
||
TAD DECNUM
|
||
TAD T1
|
||
SMA SZA
|
||
JMP I XXXP /TOO BIG, PRINT E FORMAT
|
||
TAD DECP /OK, TEST DECIMAL PLACES
|
||
SMA
|
||
CLA /ADJUST DECIMAL POINT
|
||
CIA
|
||
TAD T1
|
||
CLL CIA
|
||
DCA FNEGSW /NUMBER OF INTEGER PLACES
|
||
SZL
|
||
JMP IN+4 /NO INTEGER PLACES
|
||
/START PRINTING
|
||
BACK, TAD T1
|
||
TAD FNEGSW
|
||
SNA CLA
|
||
JMP DIG /PRINT A DIGIT
|
||
TAD FNEGSW
|
||
IAC
|
||
SPA CLA /PRINT 0 IF ONE INTEGER PLACE LEFT
|
||
TAD M20 /OTHERWISE A SPACE
|
||
IN, JMS OUTA /PRINT A CHARACTER
|
||
JMP I BDENDP /FIELD FILLED, EXIT
|
||
ISZ FNEGSW
|
||
JMP BACK /CONTINUE
|
||
TAD PER /DECIMAL POINT
|
||
PRINTC
|
||
JMP BACK
|
||
DIG, CMA
|
||
TAD T1 /DECREMENT DECIMAL EXPONENT
|
||
DCA T1
|
||
ISZ T2 /CHECK SIG DIGIT COUNT
|
||
JMP .+4 /SOME LEFT
|
||
CMA /ALL USED UP
|
||
DCA T2
|
||
JMP IN /PRINT A 0
|
||
TAD I XRT2 /PRINT A SIG DIGIT
|
||
JMP IN
|
||
/DIGIT PRINT ROUTINE FOR BDCONV
|
||
OUTA, 0
|
||
TAD C260 /CONVERT TO ASCII
|
||
PRINTC
|
||
ISZ DECNUM /FIELD FILLED?
|
||
ISZ OUTA /NO, GO TO SECOND RETURN
|
||
JMP I OUTA
|
||
BDENDP, BDEND
|
||
/ "OPTION" PROCESSOR
|
||
OPTION, SPNOR /GET OPTION LETTER
|
||
SORTJ
|
||
OPTLST-1
|
||
OPTTBL-OPTLST
|
||
ERROR /ILLEGAL OPTION NAME
|
||
/////
|
||
OPTR, CLA CMA /SWAP INPUT TO HIGH SPEED READER
|
||
DCA HINBUF
|
||
RFC /START READER
|
||
TAD RESTR /POINT TO "HREAD"
|
||
OPTK, TAD PTCH /SWAP TO KEYBOARD IF CALLED HERE
|
||
DCA 113
|
||
/////
|
||
OPTRET, TSTERM /MOVE TO ,;CR
|
||
JMP .-1
|
||
JMP I .+2 /END OF OPTIONS
|
||
JMP OPTION /CONTINUE PROCESSING OPTIONS
|
||
PROC
|
||
/////
|
||
/HIGH SPEED INPUT ROUTINE
|
||
HREAD, 0
|
||
#ifdef NEWWAY
|
||
CLA CLL
|
||
NOP /PLACE KEEPERS FOR COMPATIBILITY
|
||
NOP /WITH THE OLD HREAD ROUTINE
|
||
#else
|
||
TAD M5
|
||
DCA T1
|
||
DCA T2
|
||
#endif
|
||
HREAD2, ION /(SWAP) - FOR 2-USER
|
||
TAD HINBUF /WAIT FOR INPUT
|
||
#ifdef NEWWAY
|
||
SMA
|
||
JMP .+3
|
||
CLA
|
||
#else
|
||
SMA CLA
|
||
JMP HSGO+1
|
||
ISZ T2
|
||
#endif
|
||
JMP HREAD2
|
||
#ifdef NEWWAY
|
||
SZA /SWAPS BACK TO ADDS INPUT ON TRAILER CODE
|
||
JMP HSGO / LEGIT CHAR
|
||
#else
|
||
ISZ T1
|
||
JMP HREAD2
|
||
#endif
|
||
TAD PTCH /ALL DONE READING TAPE
|
||
DCA 113 /SWAP TO KEYBOARD INPUT
|
||
TAD P337 /RETURN A B.A. TO KILL UNENDED LINE OR GARBAGE
|
||
/CHARACTER
|
||
#ifdef NEWWAY
|
||
HSGO, DCA CHAR /FOUND CHAR
|
||
#else
|
||
HSGO, JMP RESTR-2
|
||
#endif
|
||
CMA
|
||
DCA HINBUF /SET TO READ NEXT
|
||
#ifdef NEWWAY
|
||
TAD CHAR
|
||
#else
|
||
RRB RFC
|
||
#endif
|
||
AND P177 /IGNORE PARITY AND BLANK
|
||
SNA
|
||
JMP HREAD+1
|
||
TAD C200
|
||
DCA CHAR
|
||
JMP I HREAD
|
||
/////
|
||
RESTR, HREAD-CHIN
|
||
|
||
PAGE
|
||
/FLOATING POINT PACKAGE
|
||
/ARITHMETIC INTERPRETER
|
||
FPNT, 0
|
||
CLA CLL
|
||
TAD I FPNT /FLOATING INSTRUCTION
|
||
SNA
|
||
JMP I FPNT /FEXT
|
||
AND C200 /GET PAGE BIT
|
||
SZA CLA
|
||
TAD FPNT /CURRENT PAGE
|
||
AND P7600
|
||
DCA FLADDR /START ADDRESS OF ADDRESSED PAGE
|
||
TAD I FPNT /GET ADDRESS BITS
|
||
AND P177
|
||
TAD FLADDR
|
||
DCA FLADDR /FULL 12-BIT ADDRESS
|
||
TAD I FPNT
|
||
ISZ FPNT
|
||
CLL RTL /OP BITS =>AC9-11
|
||
RTL /INDIRECT BIT =>LINK
|
||
AND P17
|
||
TAD DRECTR /SET UP OP POINTER
|
||
DCA DIRECT
|
||
TAD I FLADDR /INDIRECT?
|
||
SZL
|
||
DCA FLADDR /YES
|
||
PUSHF /NO, GET OPERAND
|
||
FLADDR, 0
|
||
POPF
|
||
FLOP
|
||
DCA FLOP3 /CLEAR LOW ORDER OPERAND
|
||
DIRECT, JMP I .+2 /OP DIRECT INSTRUCTION
|
||
DRECTR, JMP I .+1 /OP TABLE
|
||
FLPOW
|
||
FLADD
|
||
FLSUB
|
||
FLMUL
|
||
FLDIV
|
||
FLGET
|
||
FLPUT
|
||
FLNOR
|
||
|
||
FLGET, PUSHF /OP 5: GET FLAC FROM STORAGE
|
||
FLOP
|
||
TAD .+3 /SET UP POINTER TO FLAC
|
||
JMP .+4
|
||
FLPUT, PUSHF /OP 6: PUT FLAC IN STORAGE
|
||
FLAC
|
||
TAD FLADDR /SET UP POINTER TO STORAGE
|
||
DCA .+2
|
||
POPF
|
||
0 /ADDRESS OF STORAGE LOCATION
|
||
JMP FPNT+1
|
||
NEGOP, 0 /ROUTINE TO NEGATE FLOP
|
||
TAD FLOP2
|
||
CLL CIA
|
||
DCA FLOP2
|
||
CML RAL
|
||
TAD FLOP1
|
||
CIA
|
||
DCA FLOP1
|
||
TAD FNEGSW /FNEGSW IS COMPLEMENTED WHEN
|
||
CLL CMA /FLOP OR FLAC IS NEGATED
|
||
DCA FNEGSW
|
||
JMP I NEGOP
|
||
NEGAC, 0 /ROUTINE TO NEGATE FLAC - "NEGATE"
|
||
CLA CLL /TRIPLE PRECISION
|
||
TAD FLAC3
|
||
CIA
|
||
DCA FLAC3
|
||
CML RAL
|
||
TAD FLAC2
|
||
CIA
|
||
DCA FLAC2
|
||
CML RAL
|
||
TAD FLAC1
|
||
CIA
|
||
DCA FLAC1
|
||
TAD FNEGSW
|
||
CLL CMA
|
||
DCA FNEGSW
|
||
JMP I NEGAC
|
||
/ARITHMETIC OPERATIONS
|
||
/BOTH FLAC AND FLOP MUST BE NORMALIZED FOR
|
||
/+-*/^ (FAD,FSU,FMY,FDV,FXP)
|
||
FLSUB, JMS NEGOP /OP 2: SUBTRACT OP (NEGATE AND ADD)
|
||
FLADD, TAD FLAC1 /OP 1: ADD OP
|
||
SNA CLA
|
||
JMP FLGET /RESULT=OPERAND IF FLAC=0
|
||
TAD FLOP1
|
||
SNA CLA
|
||
JMP FPNT+1 /RESULT=FLAC IF FLOP=0
|
||
TAD FLOP0 /COMPARE EXPONENTS
|
||
CIA
|
||
TAD FLAC0
|
||
SNA
|
||
JMP CMBINE /EQUAL, GO ADD TOGETHER
|
||
SMA /NOT EQUAL, NEED SHIFTING
|
||
JMP SHFLOP /FLAC>FLOP, SHIFT FLOP
|
||
TAD P27 /FLAC<FLOP, SHIFT FLAC
|
||
SPA
|
||
JMP FLGET /TOO FAR TO SHIFT, TREAT AS IF FLAC=0
|
||
TAD M27
|
||
DCA DIRECT /NUMBER OF PLACES TO SHIFT
|
||
JMS I RARAC1 /SHIFT FLAC 1 TO RIGHT
|
||
ISZ DIRECT
|
||
JMP .-2
|
||
JMP CMBINE /NUMBERS NOW ALIGNED
|
||
SHFLOP, CIA /ROUTINE TO SHIFT FLOP
|
||
TAD P27
|
||
SPA
|
||
JMP FPNT+1 /FLOP TOO SMALL, TREAT AS 0
|
||
TAD M27
|
||
DCA DIRECT
|
||
JMS I RAROP1 /SHIFT FLOP 1 TO RIGHT
|
||
ISZ DIRECT
|
||
JMP .-2
|
||
CMBINE, JMS I RARAC1 /NOW SHIFT BOTH TO PREVENT OVERFLOW
|
||
JMS I RAROP1
|
||
JMS I FLAD3 /ADD TRIPLE PRECISION
|
||
FLNOR, JMS I NORF /OP 7: NORMALIZE FLAC
|
||
JMP FPNT+1
|
||
M27, -27
|
||
P27, 27
|
||
RAROP1, RAROP
|
||
RARAC1, RARAC
|
||
FLAD3, TRPLAD
|
||
NORF, FNORM
|
||
/DIRECTORY FOR INTERPRETIVE INPUT
|
||
ASKLS2, INTERM /CR, TERMINATOR
|
||
INTERM /FF, TERMINATOR
|
||
INBARR /BA, RESTART INPUT
|
||
INTERM /COMMA, TERMINATOR
|
||
INTERM /USER-SPECIFIED TERMINATOR
|
||
INGT /LF, IGNORE
|
||
|
||
MULPLR=.
|
||
FNORM, 0 /ROUTINE TO NORMALIZE FLAC
|
||
CLL CLA CMA /INITIALIZE SIGN SWITCH
|
||
DCA FNEGSW
|
||
TAD FLAC1 /TEST FOR ZERO
|
||
SNA
|
||
TAD FLAC2
|
||
SNA
|
||
TAD FLAC3
|
||
SNA CLA
|
||
JMP NOREND /ZERO, NO NEED TO NORMALIZE
|
||
TAD FLAC1
|
||
SPA CLA
|
||
NEGATE /SIGN IS NEGATIVE
|
||
DCA NORC /SHIFT COUNTER
|
||
NRLOOP, TAD FLAC1 /SHIFT NEEDED?
|
||
CLL RAL
|
||
SPA CLA
|
||
JMP NMEXIT /NO, BIT 1=1
|
||
JMS RALAC
|
||
ISZ NORC /RECORD A SHIFT
|
||
JMP NRLOOP
|
||
NMEXIT, ISZ FNEGSW /RESTORE SIGN
|
||
NEGATE
|
||
TAD NORC /CORRECT EXPONENT
|
||
CIA
|
||
TAD FLAC0
|
||
NOREND, DCA FLAC0
|
||
DCA FLAC3 /NORMALIZED # IS 3 WORDS
|
||
JMP I FNORM
|
||
FLTPT, FPNT+1
|
||
NEGOP1, NEGOP
|
||
PROD1=.
|
||
RALAC, 0 /ROUTINE TO ROTATE FLAC 1 TO LEFT
|
||
TAD FLAC3
|
||
CLL RAL
|
||
DCA FLAC3
|
||
JMS DRAL /CALL DOUBLE RAL
|
||
JMP I RALAC
|
||
DRAL, 0 /ROTATE FLAC 1 LEFT, DOUBLE PRECISION
|
||
TAD FLAC2
|
||
RAL
|
||
DCA FLAC2
|
||
TAD FLAC1
|
||
RAL
|
||
DCA FLAC1
|
||
JMP I DRAL
|
||
NORC=.
|
||
/ROUTINE TO TEST SIGNS OF FLAC AND FLOP,
|
||
/PLACE FLAC IN TEMP, FOR FLMUL AND FLDIV
|
||
FIXSGN, 0
|
||
CLL CLA CMA
|
||
DCA FNEGSW
|
||
TAD FLAC1 /TEST FLAC
|
||
SNA
|
||
JMP I FLTPT /ZERO, NO OPERATION NEEDED
|
||
SPACLA, SPA CLA
|
||
NEGATE /TAKE ABS VAL OF FLAC
|
||
TAD FLAC1 /TRANSFER TO TEMP
|
||
DCA TEMP1
|
||
TAD FLAC2
|
||
DCA TEMP2
|
||
TAD FLOP1
|
||
SGNSWT, SPA CLA /SPA CLA FOR *, SMA CLA FOR /
|
||
JMS I NEGOP1 /TAKE ABS VAL OF FLOP
|
||
TAD FNEGSW
|
||
DCA T2 /STORE SIGN OF RESULT
|
||
JMP I FIXSGN
|
||
|
||
FLMUL, TAD SPACLA /OP 3: MULTIPLY BY OPERAND
|
||
DCA SGNSWT /WANT POSITIVE OPERAND HERE
|
||
JMS FIXSGN
|
||
TAD FLOP2
|
||
JMS SDMULT /MULTIPLY (TEMP1 TEMP2) BY FLOP2
|
||
CLA CLL IAC /IGNORE LOW ORDER RESULT
|
||
TAD FLAC0 /ADD EXPONENTS
|
||
TAD FLOP0
|
||
DCA FLAC0
|
||
TAD PROD2 /SAVE PARTIAL RESULTS
|
||
DCA FLAC3
|
||
TAD PROD1
|
||
DCA FLAC2
|
||
TAD FLOP1
|
||
JMS SDMULT /MULTIPLY (TEMP1 TEMP2) BY FLOP1
|
||
TAD FLAC3
|
||
DCA FLAC3 /COMBINE RESULTS OF MULTIPLICATIONS
|
||
RAL
|
||
TAD PROD2
|
||
TAD FLAC2
|
||
DCA FLAC2
|
||
RAL
|
||
TAD PROD1
|
||
DCA FLAC1
|
||
JMS FNORM /NORMALIZE RESULTS
|
||
ISZ T2 /CHECK SIGN OF RESULT
|
||
NEGATE
|
||
JMP I FLTPT
|
||
|
||
SDMULT, 0 /UNSIGNED MULTIPLY ROUTINE
|
||
DCA MULPLR /24 BY 12 BITS
|
||
DCA PROD1
|
||
DCA PROD2
|
||
TAD M14
|
||
DCA FIXSGN /SET TO COUNT 12 MULTIPLICATIONS
|
||
CLL
|
||
SDLOOP, TAD MULPLR /NEW MULTIPLIER BIT INTO LINK
|
||
RAR
|
||
DCA MULPLR /MULPLR ALSO ACCUMULATES LOW-ORDER
|
||
SNL /RESULTS
|
||
JMP SDSHIFT
|
||
CLL /ADD MULTIPLIER IF BIT=1
|
||
TAD TEMP2
|
||
TAD PROD2
|
||
DCA PROD2
|
||
RAL
|
||
TAD TEMP1
|
||
SDSHIFT,TAD PROD1 /SHIFT PRODUCT ONE TO RIGHT
|
||
RAR
|
||
DCA PROD1
|
||
TAD PROD2
|
||
RAR
|
||
DCA PROD2
|
||
ISZ FIXSGN
|
||
JMP SDLOOP
|
||
TAD MULPLR /DONE, EXIT WITH LOW ORDER IN AC
|
||
RAR
|
||
JMP I SDMULT
|
||
PROD2=SGNSWT
|
||
M14, -14
|
||
|
||
FLDIV, TAD FLOP1 /OP 4: DIVIDE BY OPERAND
|
||
SNA CLA
|
||
ERROR /TRIED TO DIVIDE BY 0
|
||
TAD P7700 /=SMA CLA
|
||
DCA SGNSWT
|
||
JMS FIXSGN
|
||
TAD FLOP0 /SUBTRACT EXPONENTS
|
||
CIA
|
||
TAD FLAC0
|
||
IAC
|
||
DCA FLAC0
|
||
DCA FLAC1 /ZERO FLAC FOR QUOTIENT
|
||
DCA FLAC2
|
||
TAD M30 /SET COUNTER
|
||
DCA DIVCNT
|
||
JMP DVLOOP
|
||
DVSETQ, SNL /LINK IS QUOTIENT BIT
|
||
JMP ZERQUO
|
||
DCA TEMP1
|
||
TAD TEMP3 /RESTORE LOW ORDER RESULT
|
||
DCA TEMP2
|
||
ZERQUO, CLA /SHIFT RESULT BIT INTO QUOTIENT
|
||
JMS I DRALP /ROTATE LEFT DOUBLE PRECISION
|
||
TAD TEMP2 /SHIFT DIVIDEND
|
||
RAL
|
||
DCA TEMP2
|
||
TAD TEMP1
|
||
RAL
|
||
DCA TEMP1
|
||
DVLOOP, CLL
|
||
TAD FLOP2 /SUBTRACT DIVISOR FROM DIVIDEND
|
||
TAD TEMP2
|
||
DCA TEMP3
|
||
RAL
|
||
TAD FLOP1
|
||
TAD TEMP1
|
||
ISZ DIVCNT
|
||
JMP DVSETQ
|
||
CLA RAR /DONE, USE RESULT OF LAST SUBTRACTION
|
||
DCA FLAC3 /AS EXTRA PRECISION
|
||
JMS I NOR2
|
||
ISZ T2
|
||
JMP I FLOT1 /RESTORE SIGN
|
||
NEGATE
|
||
JMP I FLOT1
|
||
FLOT1, FPNT+1
|
||
DRALP, DRAL
|
||
NOR2, FNORM
|
||
|
||
RARAC, 0 /ROUTINE TO ROTATE FLAC 1 RIGHT
|
||
CLA CLL
|
||
TAD FLAC1
|
||
SPA
|
||
CML /PROPOGATE SIGN BIT
|
||
RAR /SHIFT
|
||
DCA FLAC1
|
||
TAD FLAC2
|
||
RAR
|
||
DCA FLAC2
|
||
TAD FLAC3
|
||
RAR
|
||
DCA FLAC3
|
||
ISZ FLAC0 /ADJUST EXPONENT
|
||
JMP I RARAC
|
||
JMP I RARAC
|
||
DIVCNT=.
|
||
RAROP, 0 /ROUTINE TO SHIFT FLOP 1 RIGHT
|
||
CLA CLL
|
||
TAD FLOP1
|
||
SPA
|
||
CML
|
||
RAR
|
||
DCA FLOP1
|
||
TAD FLOP2
|
||
RAR
|
||
DCA FLOP2
|
||
TAD FLOP3
|
||
RAR
|
||
DCA FLOP3
|
||
ISZ FLOP0
|
||
JMP I RAROP
|
||
JMP I RAROP
|
||
/ROUTINE TO FIX FLAC - "FIX"
|
||
/REMOVE FRACTIONAL PART BUT LEAVE FLOATING
|
||
/FIXED NUMBER IN AC ON EXIT
|
||
XFIX, 0
|
||
CLA CLL
|
||
TAD FLAC /TEST EXPONENT
|
||
M30, SPA SNA CLA /IF -1<#<1, CLEAR ENTIRELY
|
||
DCA FLAC /EXCEPT FOR SIGN BIT
|
||
TAD FLAC
|
||
TAD FIXC
|
||
DCA DIVCNT
|
||
SZL
|
||
JMP I XFIX /TOO BIG TO FIX
|
||
JMS RARAC /FIX BY ROTATING FRACTIONAL BITS
|
||
ISZ DIVCNT /OUT OF FLAC
|
||
JMP .-2
|
||
DCA FLAC+3 /CLEAR FRACTIONAL PART
|
||
TAD FLAC+2
|
||
JMP I XFIX
|
||
FIXC, -27
|
||
/ROUTINE TO FLOAT C(AC) AS FLOATING PT. INTEGER
|
||
/- "FLOAT"
|
||
XFLOAT, 0
|
||
DCA FLAC1 /SAVE NUMBER
|
||
DCA FLAC2
|
||
DCA FLAC3
|
||
TAD P13 /INTEGER EXPONENT
|
||
DCA FLAC0
|
||
JMS RARAC /IN CASE NUMBER WAS 4000
|
||
JMS I NOR2 /NORMALIZE
|
||
JMP I XFLOAT
|
||
|
||
RFLAC, RALAC
|
||
TFLAD, TRPLAD
|
||
M4, -4
|
||
RANDOM, 4421 /CURRENT RANDOM NUMBER
|
||
3040
|
||
0001
|
||
/STATISTICAL RANDOM NUMBER GENERATOR
|
||
/BASED ON DECUS 5-25, POWER RESIDUE METHOD
|
||
/NEW R=R*(2^17+3) MOD 36 BITS
|
||
FRAN, FENT
|
||
FGT RANDOM /R=OLD RANDOM NUMBER
|
||
FEXT /ALREADY SHIFTED LEFT 12 BITS
|
||
PUSHF
|
||
RANDOM
|
||
POPF
|
||
FLOP1
|
||
TAD M4 /SHIFT 4 MORE TO GET R*2^16
|
||
DCA T1
|
||
JMS I RFLAC
|
||
ISZ T1
|
||
JMP .-2
|
||
JMS I TFLAD /+R = R*(2^16+1)
|
||
JMS I RFLAC /*2 = R*(2^17+2)
|
||
JMS I TFLAD /+R = R*(2^17+3)
|
||
PUSHF
|
||
FLAC1
|
||
POPF
|
||
RANDOM /SAVE NEW RANDOM NUMBER
|
||
DCA FLAC3
|
||
DCA FLAC0 /MAKE IT A 2-WORD FRACTION
|
||
TAD FLAC1 /CHECK SIGN
|
||
SMA CLA
|
||
RETURN /POSITIVE
|
||
ISZ FLAC2 /NEGATIVE, TAKE 1S COMPLEMENT
|
||
SKP
|
||
ISZ FLAC1
|
||
NEGATE
|
||
RETURN
|
||
|
||
FLPOW, TAD I 7 /OP 0: RAISE FLAC TO POWER
|
||
PUSHA /SAVE FLOATING POINTER
|
||
PUSHF /SAVE FLAC
|
||
FLAC
|
||
POPF
|
||
FLTEMP
|
||
PUSHF /GET FLOP
|
||
FLOP
|
||
POPF
|
||
FLAC
|
||
FIX /FIX OPERAND
|
||
SPA CLA
|
||
IAC
|
||
TAD FLAC1
|
||
SZA CLA
|
||
ERROR /RAISING TO TOO HIGH A POWER
|
||
TAD FLAC2
|
||
DCA XFL
|
||
FENT /PUT 1. IN FLAC
|
||
FGT I ONEP
|
||
FEXT
|
||
TAD XFL
|
||
SNA
|
||
JMP FLXEND /X^0=1, DO NOT MULTIPLY
|
||
SMA
|
||
JMP RAISTP /RAISE TO + POWER
|
||
FENT /RAISE TO - POWER
|
||
FDV FLTEMP
|
||
FPT FLTEMP
|
||
FGT I ONEP
|
||
FEXT
|
||
JMP .+3
|
||
RAISTP, CIA
|
||
DCA XFL /SET COUNTER
|
||
FENT /DO MULTIPLICATIONS
|
||
FMY FLTEMP
|
||
FEXT
|
||
ISZ XFL
|
||
JMP .-4
|
||
FLXEND, POPA /RESTORE FLOATING POINTER
|
||
DCA I 7
|
||
JMP I .+1
|
||
FPNT+1
|
||
ONEP, FLTONE
|
||
/FLOATING SQUARE ROOT FUNCTION
|
||
FSQT, TAD FLAC1 /TEST SIGN
|
||
SPA
|
||
ERROR /SQUARE ROOT OF NEG NUMBER
|
||
SNA CLA
|
||
RETURN /ZERO, RESULT IS ZERO
|
||
TAD FLAC0 /CONSTRUCT INITIAL APPROXIMATION
|
||
SPA /BY HALVING EXPONENT
|
||
CML
|
||
RAR
|
||
DCA FLAC0
|
||
TAD SQCON
|
||
DCA FLAC1
|
||
SQLOOP, FENT /MAKE NEW APPROXIMATION
|
||
FPT FLTEMP /NEW X=(N/X+X)/2
|
||
FGT I FLARGP /ORIGINAL ARG
|
||
FDV FLTEMP
|
||
FAD FLTEMP
|
||
FEXT
|
||
CMA
|
||
TAD FLAC0
|
||
DCA FLAC0
|
||
TAD FLAC0 /COMPARE OLD AND NEW APPROXIMATIONS
|
||
CIA
|
||
TAD FLTEMP
|
||
SZA CLA
|
||
JMP SQLOOP /EXPONENTS NOT EQUAL
|
||
TAD FLAC1
|
||
CIA
|
||
TAD FLTEMP+1
|
||
SZA CLA
|
||
JMP SQLOOP /HIGH ORDER NOT EQUAL
|
||
TAD FLAC2
|
||
CIA
|
||
TAD FLTEMP+2
|
||
SNA /COMPARE LOW ORDERS TO
|
||
RETURN /WITHIN PLUS OR MINUS ONE BIT
|
||
SMA
|
||
CIA
|
||
IAC
|
||
SNA CLA
|
||
RETURN
|
||
JMP SQLOOP
|
||
SQCON, 3015
|
||
/FUNCTION TO EVALUATE SIGN PART OF FLAC
|
||
/RESULTS: -1 FOR NEGATIVE, 0 FOR ZERO, +1 FOR POSITIVE
|
||
FSGN, TAD FLAC1
|
||
SNA
|
||
JMP .+4 /ZERO, SET RESULT TO 0
|
||
SPA CLA
|
||
TAD M2 /NEGATIVE (-1)
|
||
IAC /POSITIVE (+1)
|
||
FLOAT /FLOAT C(AC) = -1,0,1
|
||
RETURN
|
||
DIGBUF=. /OUTPUT DIGIT BUFFER (8 WORDS)
|
||
FLTEMP, 0 /TEMPORARY REGISTERS
|
||
0
|
||
0
|
||
ASKBUF=. /"ASK" INPUT BUFFER (TO END OF PAGE)
|
||
ASKBND=7612 /END+12 OF "ASK" INPUT BUFFER
|
||
XFL, 0
|
||
#ifdef NEWWAY
|
||
*7600
|
||
5377
|
||
#endif
|
||
$
|
||
|