File: FOC.PA of Tape: Sources/Focal/s9
(Source file text)
/OS8-FOCAL FOR 8EE/12K
XLIST
/&0
IFNDEF FOCLST <FOCLST=1>
IFNDEF FLTLST <FLTLST=1>
IFNDEF LIBLST <LIBLST=1>
IFNDEF TXTLST <TXTLST=1>
IFNZRO FOCLST+FLTLST <FFNASS=0>
IFZERO FOCLST+FLTLST <FFNASS=1>
IFNZRO LIBLST+TXTLST <LTNASS=0>
IFZERO LIBLST+TXTLST <LTNASS=1>
/PSEUDO FLOATING POINT INSTRUCTIONS
FIXMRI FGET=0000
FIXMRI FADD=1000
FIXMRI FSUB=2000
FIXMRI FDIV=3000
FIXMRI FMUL=4000
FIXMRI FPOW=5000
FIXMRI FPUT=6000
FNOR=7000
FINT=JMS I 7
FENT=JMS I 7
FEXT=0
FXIT=0
/&1A
/SYSTEM INSTRUCTIONS (NOT LISTED)
/PERMANENT SYMBOLS FOR PAL8
/PDP8/E-SYMBOLS
BSW=7002
MQL=7421
MQA=7501
SWP=7521
CAM=7621
SKON=6000
SRQ=6003
GTF=6004
RTF=6005
SGT=6006
CAF=6007
CINT=6204
SINT=6254
CUF=6264
SUF=6274
/VARIOUS 8E OR NEW INSTRUCTIONS
KCF=6030
KIE=6035
TFL=6040
TSK=6045
RPE=6010
RIE=6013 /S/CL ERR. INT. (READER)
RCR=6015 /CLEAR READER/PUNCH ERROR
RSE=6017 /SKIP ERROR READER
PCE=6020
PIE=6023 /S/CL ERR. INT. (PUNCH)
PSK=6025 /SKIP ON READER OR PUNCH FLAG
PSE=6027 /SKIP ERROR PUNCH
/KE8-E (EAE)-SYMBOLS
SWAB=7431
SWBA=7447
SKB=7671
SCA=7441
SCL=7403
MUY=7405
DVI=7407
NMI=7411
SHL=7413
ASR=7415
LSR=7417
ASC=7403
SAM=7457
DAD=7443
DLD=7663
DST=7445
DPIC=7573
DCM=7575
DPSZ=7451
/TIMER/COUNTER CODES
TCEI=6570
TCSD=6571
TCSE=6572
TCCL=6573
TCME=6574
TCRB=6575
TCSF=6576
TCRF=6577
CTSI=6560
CTSA=6561
CTCB=6562
CTCT=6563
CTST=6564
CTRB=6565
CTSF=6566
CTRF=6567
/MAGNET CODES
MARL=6170
MARH=6171
MARM=6172
MASD=6173
MACL=6174
MALM=6175
MALH=6176
MALL=6177
/DISPLAY PLOTTER CODES
DLXA=6060
DLXB=6061
DLXC=6062
DLXD=6063
DSPA=6064 /PEN UP
DSPB=6065 /PEN DOWN
DINX=6066
DSC=6067
DLYA=6070
DLYB=6071
DLYC=6072
DLYD=6073
DCHS=6074 /SCOPE CHANNEL
DCHP=6075 /PLOTTER CHANNEL
DINY=6076
DCSI=6077
DIEN=6050
DSPD=6051
DSCD=6052
DSLP=6053
DSDF=6054
DRIS=6055
DSFF=6056
DCFF=6057
/BUFFERED DIGITAL I/O
DBDI=6500
DBEI=6501
DBSK=6502
DBCI=6503
DBRI=6504 /FOR SECOND UNIT : DBRI 10
DBCO=6505
DBSO=6506
DBRO=6507
/DAC INSTRUCTIONS
DAL1=6161 /LOAD DAC1
DAL2=6162 /LOAD DAC2
DAL3=6163 /LOAD DAC3
DASK=6164 /SKIP ON ANY DAC FLAG
DARS=6165 /READ STATUS
DALS=6166 /LOAD STATUS;CLEAR SELECTED FLAGS
DACL=6167 /LOCAL INIT
/DIGITAL INTEGRATOR INSTRS.
INCF=6146 /CLEAR FLAG
INSF=6141 /SKIP
INLHI=6142 /LOAD HI,INHIBIT COUNT
INLLO=6143 /LOAD LO,ENABLE COUNT
INRHI=6144 /READ HI,INHIBIT BUFFER LOAD
INRLO=6145 /READ LO,ENABLE BUFFER LOAD
INIE=6147 /SET/CLEAR INT. ENABLE (DATA 11)
FIXTAB
/&1B
/DEFINITIONS FOR LIB AND TXT IF NEEDED
IFNZRO LTNASS <
CMST=1000
DISFIL=5000
DISPL=0047
ENDTXT=4177
FELD=0200
FILEST=5540
FOUCC=642
FOUEXP=555
FOUJ0=600
FOUNJ=740
FOUSCS=755
FXLOW=506
ICHAR=5447
LIBFIL=0104
LINE0=0210
LINE1=0224
LOWLIB=6400
MPD2=5671
MPD3=5725
MPOPA=5746
MPUSHA=5646
NOCHAR=4253
PC0=0200
PDLSET=5755
XADC0=0400
>
IFNZRO FOCLST <XLIST>
IFZERO FFNASS <
EJECT OS-8 FOCAL INTERPRETER
/&2
FIELD 1
/MISCELLANEOUS ITEMS
*0
ECHOP, ECHO
TABC, 0 /TAB COUNTER
CNTRX, 0
ATSW, 0
0
0 /FOR OD
0
T=40 /TEXT FIELD NO.
DI=20 /DISPLAY FIELD
P=10 /PROGRAM FIELD NO.
L=00 /LIBRARY FIELD NO.
FPNT /ADRESS OF FLOATING POINT(LOC*7)
/AUTO INDEX REGISTERS
AXIN, 0 /STORAGE INDEX(LOC*10)
XRT, 0 /EXTRA XR
XRT2, 0 /EXTRA XR
MCOMA, -254 /LET'S HOPE IT IS NOT INDIRECTLY ADRESSED!
FLTXR, IOBUF-1 /XR FOR FLOATING POINT
FLTXR2, 0 /EXTRA FOR F.P.
TELSW, 0 /CLEAR IN PROGRESS FLAG
TEXTP=. /TEXT POINTERS(LOC*17)
AXOUT, LINE1+13 /OUTPUT INDEX
XCT, 7777 /UNPACK SWITCH;THESE 4 ARE PUSHED
GTEM, 0 /UNPACK STORAGE
PC, PC0 /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
PACKST, 0 /RUBOUT PROTECTION
PT1, 0 /VARIABLE POINTER
LASTV, STVAR /ADRESS OF LAST VARIABLE
T1, 0 /TEMP. REGISTER - MAIN
T3, 0 /TEMP. REGISTER FOR OUTPUT
INBUF, 0 /KEYBOARD INPUT BUFFER
BOTTOM, 4400-1 /LAST LOC. AVAILABLE IN FIELD 1
INSUB, 0 /0=GETC;#0=READC
INDX, 0 /USED BY FCOM
/&3
*40 /FLOATING POINT
EX1, 0 /OPERAND STORAGE
AC1H, 0
AC1L, 0
OVER1, 0
FLAC=. /FLOATING ACCUMULATOR
EXP, 0
HORD, 0
LORD, 0
OVER2, 0
SIGNF, 0 /FLOATING SIGN
MINSKI, ACMINS /NEGATE FLAC SUBROUTINE
FISW, 0000 /OUTPUT FORMAT
INTEGE, FIX /FIX FLAC
*54 /VARIABLES - INITIALIZED FOR THE DIALOGUE
CNTR, -20 /DELETE AND ERROR COUNTER(ALSO FP)
EFOP, 0 /FUNCTION CODE;THESE 4 ARE PUSHED
LASTOP, 0 /LAST OPERATION FOR EVAL
SORTCN, 0 /NUMBER IN TABLE FROM SORTC
BUFR, LINE1+11 /NEXT LOC. IN BUFFER=LAST LOC. IN TEXT
ADD, 4300 /CHAR. BUF. IN;THESE 4 ARE RESTORED TOGETHER
XCTIN, 0000 /PACK SWITCH
OUTDEV, XOUTL /POINTER TO OUT. SUB.(OUTL FOR DEBUG.)
INDEV, XI33 /POINTER TO IN. SUB.(I33 FOR DEBUG.)
NAGSW, 0001 /4000=ONE;1=ALL;0=GROUP;ALSO PUSHED
CHAR, 215 /THE MOST IMPORTANT REGISTER
LINENO, 0000 /LINE NUMBER READ BY GETLN
GINC, WORDS+2 /=6 FOR 4-WORD-CONSTANT
LIST6=. /INPUT LIST FOR "SFOUND"
214 /F.F. (^L)
207 /BELL
LIST7=.
P337, 337 /LEFT ARROW
CLF, 212 /L.F.
LIST3=. /EXCRETION LIST
CCR, 215 /LIST BRANCHER
DMPSW, HLT /(SEARCH CHAR)-VARIABLE
/=0000 FOR TRACE ON
M20, -20 /ENDS LISTS
P77, 77 /DON'T MOVE;AND P77=100!!!
/&4
/CONSTANTS
P13, 13 /USEFUL CONSTANT
PER, 256 /PERIOD
M77, -77 /EXTEND CODE TEST
P177, 177 /STEP MASK
P17, 17 /BCD MASK
P277, 277 /"?"
M2, -2 /CONSTANT
MINUSA, -301 /CONSTANT
C260, 260 /ASCII FOR ZERO
M240, -240 /SPACE TEST
MPER, -256 /PERIOD TEST
MCR, -215 /C.R. TEST
MFLT, -WORDS /=-4 FOR 4-WORD
M5, -5 /PAREN TEST
IOREST=.
M11, -11 /PAREN TEST
C200, 200 /CONSTANT
OUTLP, XOUTL /THESE 4 ARE USED TO RESTORE I/O
XI33P, XI33
/POINTERS ETC.
T2, 0 /TEMP.REG.-FOR NEW INST. ROUTINES
PDPTR, PDLSET /POINTER FOR PDL RESET
FLARGP, FLARG /DATA ADRESS
CFRSX, FLTZER /POINTER TO ZERO DATA &
DOUBLE, MULT2 /MULTIPLY FLAC BY 2
FOUTPU, FLOUTP /FLOATING OUTPUT
FINPUT, FLINTP /FLOATING INPUT
LIBN, LIBFIL
CFRS, LINE0 /ADRESS OF DUMMY LINE
END, STVAR /FIRST LOCATION
ENDT, LINE1 /START OF STORAGE AREA
EFUN3I, EFUN3 /FUNCTION RETURN
WORDS=4
/PDL INSTRUCTIONS
POPA=JMS I . /RESTORE AC
XPOPA
PUSHJ=JMS I . /RECURSIVE SUB. CALL
XPUSHJ
POPJ=JMP I . /SUB. RETURN
XPOPJ
PUSHA=JMS I . /SAVE AC
XPUSHA
PUSHF=JMS I . /SAVE GROUP OF DATA
PD2
POPF=JMS I . /RESTORE GROUP
PD3
/&5
/NEW INSTRUCTIONS:
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 DATA INTO CHAR AND PRINT IT
RDIV, CHIN
PRNTLN=JMS I . /PRINT C(LINENO)
XPRNT
GETLN=JMS I . /UNPACK AND FORM A LINENUMBER
XGETLN
FINDLN=JMS I . /SEARCH FOR A GIVEN LINE
XFIND
SPNOR=JMS I . /IGNORE SPACES AND LEADING ZEROS
XSPNOR
TESTN=JMS I . /PERIOD;OTHER;NUMBER
XTESTN
TSTLPR=JMS I . /SKIP IF 5.L.SORTCN.L.E.11(I.E. AN L-PAR)
LPRTST
TSTGRP=JMS I . /SKIP IF G(AC)=G(LINENO)
GRPTST
TESTC=JMS I . /TERM;NUMBER;FUNCTION;LETTER- AND IGNORE SPACES
XTESTC
DELETE=JMS I . /REMOVE OLD TEXT LINE
PSIN, XDELETE
ERROR2=JMS I . /EXCESS SOMETHING ERROR
ERROR3=JMS I . /MISCELLANEOUS ERROR
ERROR4=JMS I . /FORMAT ERROR
ERR2
/VARIOUS NEW POINTERS ETC.
CHARLY, 0 /SUPERCHAR
DISD, DISPL /DISPLAY POINTER
DPC, PCD /PC
DTHIS, THISD /THISLN
DPT1, PT1D /PT1
DXRT, XRTD /(TAD I XRT)
DAXIN, AXIND /(DCA I AXIN)
DAXOUT, AXOUTD /(TAD I AXOUT)
SECRTV, STSECR /FOR SECRET VARIABLES
RECOVR-1
/&6
/FOCAL'S COMMAND/INPUT DRIVER
*177
START, START1 /PROGRAM START FROM SELF (INDIRECT)
JMP I 176 /CONSOLE START: SW=200
JMP I GOCHN /OS8 CHAIN ENTRY POINT
START1, TAD C200
DCA PC /FOR COMMAND MODE
IAC /USE ONE IN THE AC TO
DCA DMPSW /INIT UNPACK AND TRACE SWITCH
DCA DEBGSW /ENABLE TRACE FOR INPUT OF (?)
TAD CSTAR /ANNOUNCE PRESENCE
JMS I ECHOP /SHOULD WE PRINT A'*'
IBAR, TAD BUFR /COMMAND INPUT BUFFER
DCA AXIN /FOR UNPACKING
DCA XCTIN
TAD BUFR /RUBOUT PROTECTION
DCA PACKST
IGNOR, READC /READ COMMAND STRING
SORTJ
LIST7-1
INLIST-LIST7
PACKC /SAVE STRING CHARACTER
JMP IGNOR
CSTAR, 252 /ACKNOWLEDGE CHARACTER
P7600, 7600
GOCHN, GOTO
INPUTX, PUSHJ /PROCESS IMMEDIATE COMMAND
PROC
JMS I DPC /TAD I PC
SNA /END OF PROGRM?
JMP I 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.
/&7
/COMMAND/INPUT PROCESSOR
IRETN, PACKC /START TO PACK C.R.
PACKC /FINISH C.R.
TAD BUFR /INITIALIZE FOR UNPACKING
GONE, DCA AXOUT /SETUP CURRENT LINE
DCA XCT
GETC /READ FIRST CHARACTER
CIF CDF L
JMS I PDPTR /GO RESET PDL
SPNOR /IGNOR LEADING BLANKC
TESTN /DOES THE LINE BEGIN WITH 1-9?
JMP GZERR /PERIOD =ILLEGAL GROUP ZERO USAGE
JMP INPUTX /NO
ISZ DEBGSW /YES, DISABLE TRACE FOR REPACKING
GETLN /READ THIS LINE NUMBER
CLA CLL CML RAR /TEST FOR SINGLE LINE
TAD NAGSW
SZA CLA
ERROR3 /ILLEGAL LINE NUMBER ON INPUT
TAD BUFR /SET POINTERS
DCA AXIN
DCA XCTIN
TAD LINENO /SAVE LINE #
JMS I DAXIN /DCA I AXIN
SPNOR /IGNORE SPACES AFTER LINE NUMBER
SKP
GETC /READ 1ST AFTER LINENO TERMINATOR
SRETN, PACKC /SAVE TEXT AND RESTORE DATA FIELD
TAD CHAR /TEST FOR END OF INPUT STRING
TAD MCR
SZA CLA
JMP .-5
DELETE /REMOVE OLD LINE, IF ANY
CDF T /TERMINATE THE BUFFER LINE:OLD "ENDLN"
TAD I LASTLN
DCA I BUFR
TAD BUFR /POINT TO NEW NEXT LINE
DCA I LASTLN
TAD ADD /CHECK FOR EXTRA INFO.
SZA
DCA I AXIN
TAD AXIN /COMPUTE NEW END OF BUFFER
IAC
DCA BUFR
GOKILL, CDF L
DCA I LIBN /WE'VE CHANGED SOMETHING
CDF P
JMP I START /POINTERS MUST BE REINITIALIZED
/&8
/LINE NUMBER FORMATION;RANGE OF ACCEPTIBLE LINE NUMBERS
/=1.01 TO 31.99
FL100, 7
3100
0
FLP5, 0
P2000, 2000
0
0
XGETLN, 0 /COMPUTED LINE #'S
SPNOR /IGNORE SPACES
TAD CHAR /'A' IS SPECIAL
TAD MINUSA
SNA CLA
JMP TESTA
PUSHJ /EVALUATE NUMBER OR EXPRESSION
EVAL
JMS I INTEGER /GET GROUP PART
TAD P7740 /CHECK IF TOO BIG
SMA CLA
ERROR2 /BAD GROUP #
TAD LORD /GET GROUP AGAIN
BSW
CLL RAL
DCA LINENO /SAVE IT
JMS I MINSKI
FENT
FADD I FLARGP /GET FRACTION
FMUL FL100
FADD FLP5 /ROUND UP
FEXT
JMS I INTEGER
TAD LINENO /ADD GROUP
TESTA, DCA LINENO
CLA CLL
TAD LINENO /CHECK FOR ERROR
AND P7600
SZA CLA
CML
TAD LINENO
AND P177
SNL SZA
GZERR, ERROR2 /ILLEGAL GROUP ZERO USAGE
P7740, SMA SZA CLA /SMA FOR 7740
TAD P2000 /SET NAGSW;GROUP=0,LINE=4000,ALL=1
CML RAL
DCA NAGSW
JMP I XGETLN
/&9
/LIST OF FUNCTION ADDRESSES, (NAMES ARE IN "FNTABL")
FNTABF=.
XABS /ABS -ABSOLUTE VALUE
XSGN /SGN -SIGN PART
XINT /ITR -INTEGER PART
XFX /FX -COMMON TO DIS CONVERSION
FRAN /RAN -RANDOM NUMBER
XADC /ADC -TIMER-COUNTER-DVM FUCTION
ARTN /ATN -
FEXP /EXP -EXPONENTIAL FUNCTIONS
FLOG /LOG -
FSIN /SIN -TRIG FUNCTIONS
FCOS /COS -
XSQRT /SQT -SQUARE ROOT
FIN /INP -CHARACTER INPUT
FOUT /OUT -CHARACTER OUTPUT
MAGNET /FELD -BRUKER CONTROL
XDYS /FDIS -DISPLAY COMMON FUNCTION
XCOM /FCOM -FLOATING INTEGER COMMON
FIOP /FIOP -INPUT OUTPUT FUCTION
XXX /FOUR -AUTONOMOUS FOURIER FUNCTION
DAC /FDAC -DAC FUNCTION
LUX /FLUX -DIGITAL FLUX INTEGRATOR
PD2, 0
CLA CMA
TAD I PD2
ISZ PD2
CIF
JMS I .+2
JMP I PD2
MPD2
PD3, 0
CLA CMA
TAD I PD3
ISZ PD3
CIF
JMS I .+2
JMP I PD3
MPD3
XPOPA, 0
CIF
JMS I .+2
JMP I XPOPA
MPOPA
/&10
/RECURSIVE OPERATE, EXECUTE, OR CALL
DO, GETLN /EXECUTE ONE LUNE, A GROUP, OR ALL
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
NOP
TAD THISLN /TEST FOR GOOD GROUP NUMBER
DCA XRT
JMS I DXRT /TAD I XRT
TSTGRP
ERROR2 /NO SUCH GROUP NUMBER
DGRP1, PUSHJ /EXECUTE OBJECT LINE AND SET PC
PROCESS-2
POPF /RESTORE THE DATA
NAGSW
JMS I DPC /CHECK FOR END OF TEXT
SNA
JMP DCONT /ALL DONE
IAC
DCA PT1 /SAVE POINTER TO LINENO
TAD NAGSW /CHECK FOR GROUP
SMA SZA CLA
JMP .+4 /DO ALL
JMS I DPT1 /TEST GROUP
TSTGRP
JMP DCONT /NOT IN GROUP
JMS I DPT1 /READ NEXT LINE NO
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
JMP I .+1 /CONTINUE PROCESSING THIS LINE
PROC
/&11
/DISPLAY FILE INTEGER STORAGE FUNCTION
XDYS, JMS I INTEGER
CLL
TAD MLMIT /TEST OVERFLOW
SZL CLA
ERROR2
TAD LORD
TAD NFILB /FILE START
PUSHA
TAD CHAR
TAD MCOMA /2ND ARG?
SZA CLA
JMP FIND
PUSHJ
EVAL-1
POPA
DCA INDX
JMS I INTEGER
CDF DI
DCA I INDX
JMP OUTDIS
FIND, POPA
DCA INDX
CDF DI
TAD I INDX
DCA HORD
DCA LORD
DCA OVER2
TAD P13
DCA EXP
OUTDIS, CDF P
JMP I EFUN3I
MLMIT, -2000
NFILB, DISFIL
AXOUTD, 0
CDF T
TAD I AXOUT
CDF P
JMP I AXOUTD
PCD, 0
CDF T
TAD I PC
CDF P
JMP I PCD
/&12
INLIST=. /INPUT CONTROL CHARACTERS
IBAR /B.A. = RESTART
IGNOR /L.F. = IGNORE
IRETN /C.R. = TERMINATE STRING
FLIST2, FLIMIT /,=STANDARD
FINFIN /;=SHORT
FLIMIT-1 /CR=DUMB
FLIST1, FINCR /,=STANDARD FORMAT
PROCESS /;=SET;PLUS,..
PC1 /C.R.=SET COMMAND
MF, -306 /USED BY TESTC
/PRIMARY CONTROL AND TRANSFER
GOTO, GETLN /READ THE LINE NUMBER REQUESTE
FINDLN /LOCATE IT AND RESET TEXTP
ERROR2 /NOT THERE
TAD THISLN /SET PC
DCA PC
PROCESS,GETC /TEST FOR END OF LINE
PROC, TAD CHAR /FIRST CHARACTER READY = USE PROC
TAD MCR
SNA CLA
PC1, POPJ /EXIT "PROCESS"
SORTC /IGNORE "SPACE",",", AND ";"
GLIST-1
JMP PROCESS
TAD CHAR /SAVE COMMAND CHARACTER
AND P337 /EXECUTE LOWER CASE ALSO
PUSHA
GETC /GO TO TERMINATOR
SORTC
GLIST-1
SKP
JMP .-4
POPA
SORTJ /GO DO COMMAND
COMLST-1
COMGO-COMLST
ERROR2 /ILLEGAL COMMAND
COMMENTS=PC1 /ALSO IS CONTINUE
/&13
/OUTPUT COMMAND TEXT
WRITE, GETLN /SET LINENO
ISZ DEBGSW /DISABLE TRACE
FINDLN /SEARCG 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
JMS I DTHIS /TEST FOR END OF TEXT
WTEST2, SNA
JMP WX-2 /EXIT;DO NEXT INDIRECT LINE
IAC
DCA PT1 /SAVE POINTER TO LINENO OF NEXT
TAD NAGSW
SMA CLA
JMS I DPT1
TSTGRP /TRY NEXT LINENO FOR GROUP
JMP WX
WALL, JMS I DPT1 /SET LINENO
DCA LINENO
JMP WRITE+2
WTESTG, TAD THISLN /INIT GROUP PRINTOUT
JMP WTEST2
DCA DEBGSW
POPJ
WX, TAD NAGSW
SPA SNA CLA /SKIP IF ALL
JMP WX-2
PRINTC /PRINT C.R. AGAIN
JMP WALL
/&14
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
TAD CHAR /NO
ISZ XTESTC
TAD MF
SNA CLA /TEST FOR "F"
JMP XT3
TESTN
JMP I XTESTC /.
SKP /OTHER
JMP I XTESTC /NUMBER
ISZ XTESTC
XT3, ISZ XTESTC /RETURNS:T;N;F;A
JMP I XTESTC
XSORTC, 0 /SORT CHAR AGAINST TABLE - "SORIC"
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
MASK76, 7600 /CLA
JMP I XSORTC
/&15
GRPTST, 0 /AC VS LINENO - "TSTGRP"
AND MASK76
CIA
DCA T2
TAD LINENO
AND MASK76
TAD T2
SNA CLA
ISZ GRPTST
JMP I GRPTST
/INPUT FROM TEXT OR KEYBOARD;
/IF BACK-ARROW, RESTART INPUT
INPUT, 0 /INPUT A CHARACTER
TAD INSUB /NON/ZERO FOR KEYBOARD
SZA CLA
JMP .+3
GETC
JMP I INPUT
READC
SORTJ
SPECIAL-1
INFIX-SPECIAL
JMP I INPUT
ILIST, IF1 /,
PROCESS /;
PC1 /CR
/ENGLISH-FRENCH
COMLST=. /COMMAND DECODING LIST
"S /SET
"F /FOR
"I /IF
"D /DO
"G /GOTO
"C /COMMENT
"A /ASK
"T /TYPE
"L /LIBRARY
"E /ERASE
"W /WRITE
"M /MODIFY
"Q /QUIT
"R /RETURN
"O /OPEN
/THIS COMMAND LIST IS SPEED OPTIMIZED
/&16
/CONDITIONAL TRANSFER PROCESS
IF, TESTC /IGNORE SPACES AND TEST
JMS I IECALL /T
POPA
JMS I IPART /F-CHECK FOR PAREN MATCH
TAD M2 /A
DCA T1
TAD HORD /TEST -,0,+
SPA
ISZ T1 /N-TO -1,-2,-3
SPA SNA CLA
IF3, ISZ T1 /COUNT COMMAS
SKP
JMP I COMGO+4 /TRANSFER
SORTJ /SEARCH TEXT UNTILL ,;C.R.
TLIST-1
ILIST-TLIST
GETC
JMP .-4
IF1, GETC /MOVE PAST COMMA
JMP IF3
IECALL, ECALL
IPART, PARTEST
/&17
/LOOP CONTROL STATEMENT
SET=. /SUBSET OF "FOR"
FOR, PUSHJ /LOOPS, ETC.
GETARG /LOOK FOR "=" NEXT
SPNOR
TAD CHAR
TAD MEQ
SZA
ERROR4 /LEFT OF "=" IN ERROR:'FOR' OR 'SET'
TAD PT1
PUSHA /SAVE POINTER TO VARIABLE
PUSHJ
EVAL-1 /GET INITIAL VALUE EXPRESSION
POPA
DCA PT1
FINT /INITIALIZE NOW
FPUT I PT1
FXIT
SORTJ /TEST LAST CHAR FROM "EVAL"
TLIST-1
FLIST1-TLIST
ERROR4 /EXCESS R-PAR
FINCR, TAD PT1 /SAVE VARIABLE ADRESS
PUSHA
PUSHJ /EVALUATE THE INCREMENT,IF ANY
EVAL-1
SORTJ /TEST TERMINATORS
TLIST-1
FLIST2-TLIST
ERROR4 /ILLEGAL TERMINATOR IN 'FOR'
FLIMIT, PUSHF /SAVE THE INCREMENT
FLARG
PUSHJ /GET THE LIMIT(NO ERROR DETECTION AFTER LIMIT)
EVAL-1
FCONT, PUSHF /SAVE THE LIMIT
FLARG
PUSHF /SAVE TEXT OF OBJECT STATEMENTS
TEXTP
PUSHJ /DO THE OBJECT STATEMENTS
PROCESS
POPF /RESTORE REMAINING TEXT
TEXTP
POPF /GET LIMIT
FLARG
POPF /GET INCREMENT
ITER1
POPA /GET VARIABLE ADRESS
DCA PT1
/&18
FINT /INCREMENT AND TEST
FGET I PT1 /LOAD THE VARIABLE
FADD I FINKP /INCREMENT IT
FPUT I PT1 /CHANGE IT
FSUB I FLARGP /TEST IT
FXIT
TAD HORD
SMA SZA CLA
POPJ /END OF LOOP
TAD PT1
PUSHA /SAVE ADRESS
PUSHF /SAVE INCREMENT AGAIN
FINKP, ITER1
JMP FCONT
MEQ, -275
FINFIN, PUSHF /SET INCREMENT TO ONE
FLTONE
JMP FCONT
/TRANSFER FUNCTION;FX("0 OR 1",REL.DIS START)
/0:FCOM[0-255];1:FCOM[256-511];COMMON VARIABLES SCALED
/TO DIS FORMAT;LARGEST EXP IS EVALUATED AND COMES BACK
XFX, JMS I INTEGE
SZA CLA /FIRST OR SECON HALF
TAD FX1000 /SECOND HALF
TAD FX1000 /FIRST HALF;DEPENDS ON COMMONSTART
PUSHA
PUSHJ
EVAL-1 /EVALUATE SECOND ARGUMENT
JMS I INTEGE
TAD FXM140 /REL. START .L. 1400
SZL CLA /INTEGE RETURNS CLL
ERROR2
CIF CDF L /GO TO FLD. 0
JMP I .+1
FXLOW
FX1000, 1000
FXM140, -1400
/TAKE THE INTEGER PART
XINT, JMS I INTEGER /(FIX)
JMP I EFUN3I
/&19
COMGO=. /COMMAND ROUTINE ADRESSES
SET
FOR
IF
DO
GOTO /(REFERENCED)(IF3+2)
COMMENT
ASK
TYPE
LIB
ERASE
WRITE
MODIFY
START1 /RETURN TO COMMAND MODE VIA 'QUIT'
RETRN
FILER /OPEN
/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
TAD CHAR /SAVE IN LINE CHARACTER
PUSHA
TAD P77 /TYPE QUESTION MARK
JMS I ECHOP
ISZ INSUB /INDICATE 'READC'
IAC /POINT PAST CHAR
JMS I FINPUT /READ DATA AND SAVE
POPA /RETEST LAST TERMINATOR
DCA CHAR
JMP ASK /CONTINUE PROCESSING
TYPE2, PUSHJ /DO TYPE
EVAL
JMS I FOUTPUT /PRINT
JMP TYPE
/&20
TQUOT, ISZ DEBGSW /DISABLE TRACE
GETC /TYPE LITERALS
SORTJ
TLIST2-1
TLIST3-TLIST2
PRINTC
JMP TQUOT+1
TINTR, GETC /PAS PERCENT SIGN
GETLN /READ FORMAT CONTROL: "%7.03"
TAD LINENO
DCA FISW /SAVE FORMAT CODE
JMP TASK
TCRLF2, TAD P15 /PRINT CR ONLY
PRINTC /PRINTC HANDLES NULL FOR DELAY!
JMP .+3
TCRLF, TAD CCR /EXCLAMATION POINT=CR,LF
PRINTC
TASK4, GETC /MOVE TO NEXT CHAR
JMP TASK
P15, 15
/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
/&21
/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 NO.
JMS I DAXIN /DCA I AXIN
TAD AXIN /SAVE START OF NEW LINE
DCA PACKST
SCONT, JMS I INDEV /READ THE TELETYPE SILENTLY
DCA LIST3+1 /SAVE SEARCH CHAR.
ISZ DEBGSW /NO BREAKS
SCHAR, GETC /TYPE+TEST-F.F.
PRINTC /PLAYBACK THE TEXT
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
/&22
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 NUMBER**
JMP SEX /READ EXIT
TAD T2 /FIND ADRESS
SZA CLA
JMP .-5
TAD XRT2 /MATCH FOUND
TAD I SORTB
DCA T2
TAD I T2
DCA T2 /DEBUG: AC=ADRESS
JMP I T2
SEX, ISZ SORTB /MATCH NOT FOUND
CLA CLL
JMP I SORTB /RETURN TO CALLING SEQUENCE
OCHAR, 0 /OUTPUT A CHARACTER
DCA T2
OUTECH, SKP /ECHO ON TELETYPE?
JMP .+5 /NO
TAD T2 /YES
SNA
CLA CLL CML RAR /LET HIM PRINT NULLS!
JMS I OUTLP
TAD T2
CIF L
JMS I NOCARE /OUTPUT IT
JMP I OCHAR
NOCARE, NOCHAR
/&23
EOF, 0 /TRYING TO READ FROM A FILE AFTER END
TAD XI33P
DCA INDEV /RESET POINTER TO TTY
TAD P277 /PRINT A "?"
JMS I OUTLP /ON THE TTY
JMS I INDEV /READ A CHARACTER
JMP I EOF
SRNLST=. /'MODIFY' CONTROL CHARACTER TABLE
SCHAR /F.F. = CONTINUE
SCONT /BELL = CHANGE SEARCH CHAR
SBAR /B.A. = RESTART
SCONT+1 /L.F. = FINISH THE LINE AS BEFORE
LISTGO=.
SRETN /C.R. = END THE LINE HERE AS IT IS
SGOT /CHAR = SEARCH CHAR
ALIST=. /ASK/TYPE LIST OF CONTROLS
":
"%
242 /"
"!
"#
"$
GLIST=.
SP, 240 /SPACE;REFERENCED!
TLIST=.
",
";
215 /C.R.
/THIS LIST IS ENDED BY 'TESTC'
/&24
/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 ARGUMENT IN 'FOR','SET',OR 'ASK'
GETVAR, DCA XCTIN /PACK INTO ADD.
PACKC
GETC /SECOND LETTER
SORTC /TERMINATOR?
TERMS-1
JMP GSERCH /YES
TAD CHAR /NO
AND P77 /SAVE 2AND LETTER OF NAME
TAD ADD
DCA ADD
GETC /IGNORE THE REST
SORTC
TERMS-1
JMP GSERCH
JMP .-4
GSERCH, TSTLPR /LOOK FOR SUBSCRIPT VIA SORTCN
JMP GS1 /NOT SUBSCRIPTED BY L-PAR
TAD ADD /SAVE NAME
DCA EFOP /FOR RECURSIVE AND ERROR CHECK
JMS I GECALL /TO EVAL
POPA
DCA ADD /RESTORE NAME
JMS I PTEST /TEST PAREN MATCH, ETC.
JMS I INTEGER /CONVERT TO 12-BIT NUMBER
GS1, DCA SUBS /SAVE SUBSCRIPT
TAD SECRTV /VARIABLE STARTS WITH SECRET VARIABLES
GS3, DCA PT1
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
PTEST, PARTEST
GECALL, ECALL
/&25
GS2, TAD LASTV /ADD THE VARIABLE
CIA CLL
TAD BOTTOM /CHECK FOR OVERFLOW
SNL CLA
ERROR3
TAD LASTV /UPDATE THE LIST
TAD GINC
DCA LASTV
TAD ADD /SAVE NAME
DCA I PT1
ISZ PT1 /SAVE SUBSCRIPT
TAD SUBS
DCA I PT1
ISZ PT1 /SET PT1
FINT
FGET I CFRSX
FPUT I PT1
FXIT
POPJ /EXIT
GFND1, TAD PT1 /FOUND SAME
DCA XRT /TEST SUBSCRIPTS
TAD I XRT
CIA
TAD SUBS
SZA CLA
JMP GS4 /WRONG SUBSCRIPT
ISZ PT1 /SET POINTER TO DATA
ISZ PT1
POPJ
/&26
SUBS=.
XSPNOR, 0 /IGNORE LEADING SPACES - "SPNOR"
TAD CHAR
TAD M240
SZA CLA
JMP I XSPNOR
GETC
JMP XSPNOR+1
XTESTN, 0 /RETURNS: .; OTHER; NUMBER - "TESTN"
TAD CHAR
TAD MPER
SZA
ISZ XTESTN
TAD M2
DCA SORTCN /SAVE VALUE OF THE NUMBER
TAD SORTCN /TEST IF REALLY A DIGIT
SPA CLA
JMP I XTESTN
TAD SORTCN
TAD M11
SPA SNA CLA
ISZ XTESTN /IF A NUMBER
JMP I XTESTN
LGOSUB, CLA CLL
PUSHJ /EXECUTE THE SUBROUTINE
DO+1
TAD SP /LIBRARY SPACE = LIBRARY RETURN
DCA CHAR
JMP I .+1
LIB+1
RETRN, TAD C200
DCA PC
XPOPJ, POPA
DCA T2
JMP I T2
ATLIST=.
XTAB /: - TABULATOR
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
/$/ - FOR TDUMP TERMINATES THE COMMAND
/&27
/EVALUATE AN EXPRESSION WHICH
/TERMINATES WITH AN R-PAR, ; OR C.R. AND
/LEAVE THE RESULT IN FLAC AND IN FLARG
DIS1A, DIS
ECALL, 0 /RECURSIVE CALL TO "EVAL"
PUSHF /SAVE SORTCN,LASTOP,EFOP
EFOP
TAD ECALL /RETURN TO CALLING
PUSHA /ADRESS AFTER NEXT POPJ
GETC /MOVE PAST EXTRA CHAR
EVAL, DCA LASTOP /EVALUATION CONTROLLER(CHECKPOINT?)
JMS I DIS1A /REFRESH DISPLAY
TAD CHAR
DCA CHARLY /SUPERCHAR SUPERSTAR
TESTC /TEST CHAR AND IGNORE SPACES
JMP ETERM1 /TERMINATOR
JMP ENUM /NUMBER
JMP EFUN /FUNCTION
PUSHJ /LETTER OF VARIABLE
GETVAR /FIND OR CREATE VARIABLE;ALSO SET PT1
OPNEXT, TESTC /PT1 TO ARG
JMP ETERMN /T
ECHOLS, 0212 /N-ERROR IN FORMAT
0377 /F
JMP ETERM+1 /'EVAL'FOUND A TERMINATOR WHICH WAS NOT AN OP.
ETERM1, TAD CFRSX /SET PT1
DCA PT1 /TO POINT TO ZERO
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
/&28
ETERM2, TAD THISOP /COMPARE PRIORITIES
CIA
TAD LASTOP
SPA CLA
JMP EPAR /CONTINUE
TAD LASTOP /FIND OPERATION
CLL RTR
RTR
TAD OPTABL
DCA FLOP
TAD LASTOP
SZA CLA /TEST FOR END OF DATA INTO FLOATING AC
POPF /GET LAST DATA
FLAC
FINT
FLOP, 00 /(FLOPR I PT1)+-*/
FPUT I FLARGP /SAVE RESULT
FXIT
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 FIRST CHAR OF AN ARG.
TESTC /DO SPECIAL CHECK
JMP ELPAR
JMP ENUM /N
JMP EFUN /F
JMP OPNEXT-2 /L
OPTABL, FGET I PT1 /BASE FOR OPERATION COMPUTATION
/&29
ENUM, PUSHF /TO PROCESS ANUMBER,SAVE AC
FLAC
TAD FLARGP /SET POINTER AS FOR A VARIABLE
DCA PT1
DCA INSUB /POINT TO 'GETC' AND USE CHAR
JMS I FINPUT /READ TEXT NUMBER INTO FLARG
POPF /RESTORE THE AC
FLAC
JMP OPNEXT /CONTINUE
EFUN, DCA EFOP /SET CODE
GETC /READ FUNCTION NAME(1,2,3 LETTERS)
SORTC /LOOK FOR TERMINATION CHAR
TERMS-1
JMP EFUN2 /YES
TAD EFOP /NO
CLL RAL /MISH-MASH HASH CODE
TAD CHAR
JMP EFUN
EFUN2, TSTLPR
ERROR4 /MUST BE FOLLOWED BY PARENS TO SET ARGUMENT
JMS ECALL /CALL "EVAL" TO COMPUTE ARGUMENT
POPA /BRANCH ON FUNCTION CODE;RETURN VIA EFUN3I
SORTJ
FNTABL-1
FNTABF-FNTABL
ELPAR, TSTLPR /LEFT PAREN OR FELL THROUGH FUNCTION TABLE
ERROR4 /DOUBLE OPERATORS OR ILLEGAL FUNCTION NAME
EPAR2, JMS ECALL /EVALUATE NESTED EXPRESSION
POPA /DUMP EXTRA ARG
JMP I EFUN3I
/&30
TERMS=. /TERMINATOR TABLE FOR 'EVAL' AND 'GETARG'
240 /0 SPACE
"+ /1
"- /2
"/ /3
"* /4
"^ /5
"( /6
"[ /7
274 /10 (LEFT ANGLE BRACKET)
") /11
"] /12
276 /13(RIGHT ANGLE BRACKET)
", /14
"; /15
215 /16 C.R.
"= /17 TO END GETARG FROM 'SET'
/THREE MINOR FUNCTIONS
XADC, CIF CDF L
JMP I .+1
XADC0 /FIELD 0 CONNECTOR
XSGN, TAD HORD /REAL SIGNUM FUNCTION!
SNA CLA
JMP EFUN3
PUSHF
FLTONE
POPF
FLAC
XABS, TAD FLARG+1 /TAKE ABSOLUTE VALUE OF FLAC
SPA CLA /SKIP TO CONTINUE
JMS I MINSKI
/CONTINUATION OF FUNCTION CALLS
EFUN3, FINT
FNOR /NORMALIZE FUNCTION RETURN
FPUT FLARG /SAVE FUNCTION VALUE
FXIT
TAD FLARGP /SET POINTER
DCA PT1
JMS PARTEST
JMP I .+1
OPNEXT
/&31
FLARG, 0 /DATA TEMPORARY STORAGE
0
0
0
P3, 3
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
PARTES, 0 /TEST THE PAREN MATCHINGS
POPA /RESTORE THE LAST OPERATION
DCA LASTOP
POPA
TAD P3 /+3 TO COMPARE CODES
CIA /CHECK FOR PAREN MATCH
TAD SORTCN /(STILL SET FROM THE LAST 'EVAL')
SZA CLA /SKIP IF MATCH
ERROR4 /PAREN ERROR
POPA /DUMP 'BUFR' FROM PUSHF EFOP
CLA CLL
GETC /MOVE PAST R-PAR
JMP I PARTEST
/&32
/THE DELETE ALINE ROUTINE
XDELET, 0 /UNCHAIN A LINE AND RECOVER THE SPACE
IOF /PROTECT POINTER CHANGES FROM INTERRUPTIONS
FINDLN /SETS "THISLN" AND "LASTLN"
JMP I XDELETE /ALREADY GONE
ISZ DEBGSW /DISABLE TRACE
GETC /MEASURE LENGTH
TAD CHAR
TAD MCR
SZA CLA
JMP .-4
TAD AXOUT /SAVE LAST ADRESS
CMA
TAD THISLN
DCA CNTR /LENGTH .L. 0
TAD CFRS /IT IS ILLEGAL TO DELETE THE FIRST LINE
CIA
TAD THISLN
SNA CLA
JMP I START /JUST IGNORE SUCH COMMANDS
CDF T /CHANGE DATA FIELD TO TEXT
TAD I THISLN /DISCONNECT
DCA I LASTLN
TAD CFRS /START LIST AT TOP
DOK, DCA T2 /EXAMINATION ADRESS
TAD I T2
SNA /TEST FOR END
JMP DONE /YES-WRAP UP ALL
DCA T1 /SAVE NEXT ADRESS
TAD THISLN /COMPARE LINE POSITIONS
CIA CLL
TAD T1
SZL CLA /SKIP IF THISLN .G. X
TAD CNTR /CHANGE (X) TO ACCOUNT FOR
TAD T1 /GARBAGE COLLECTION
DCA I T2
TAD T1 /GET NEXT
JMP DOK
/&33
/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 XDELETE+1 /RESET 'LASTLN','THISLN', AND DATA FIELD
FNTABL=.
2533 /ABS
2650 /SGN
2636 /ITR
0330 /X
2630 /RAN
2517 /ADC
2572 /ATN
2624 /EXP
2625 /LOG
2654 /SIN /LIST OF CODED FUNCTION NAMES
2575 /COS
2702 /SQT
1140 /IN
2672 /OUT
2560 /(F)ELD
2565 /DIS
2567 /COM
2622 /IOP
2670 /(F)OUR
2525 /DAC
2662 /(F)LUX /TECO:^O^T+200*2UX^T+200+QX*2UX^T+200+QX=^D
/&34
/ERASE SINGLE LINES, GROUPS, OR VARIABLES
ERASE, TESTC /TEST THE SECOND WORD IF ANY
JMP ERVX /ERASE THE VARIABLES
JMP ERL /LINES OR GROUPS
JMP .+4 /ERROR
TAD CHAR /ALL TEXT
TAD MINUSA
SZA
ERROR3 /BAD ARG FOR ERASE
ERT, TAD ENDT /ERASE ALL TEXT
DCA BUFR
CDF T
DCA I CFRS
JMP I GOK /RESTART
ERL, GETLN /ERASE LINES
TAD BUFR /PROTECT REST OF TEXT
DCA AXIN
ERG, DELETE /EXTRACT ONE LINE
ISZ THISLN
TAD NAGSW
SMA CLA
JMS I DTHIS /(TAD I THISLN)
TSTGRP /DONE ERASING GROUP?(SKIP)
JMP I GOK /YES,ERASE 'CURRENT PROGRAM SAVED' FLAG
JMS I DTHIS /(TAD I THISLN)
DCA LINENO
JMP ERG
ERVX, TAD END /ZERO VARIABLES(BUT NOT SECRET VARIABLES)
DCA LASTV /MAY BE INDIRECT COMMAND
POPJ
GOK, GOKILL
/&35
/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 XRT
TAD LINENO
CLL CMA IAC /CLEAR LINK AND NEGATE LINENO
JMS I DXRT /LINENO=0 WILL BE FOUND (X-MEM)
SNA
JMP FEND3-1 /FOUND IT
SZL CLA
JMP FEND3 /PASSED IT
TAD THISLN /MOVE POINTERS
DCA LASTLN
JMS I DTHIS /END OF TEXT ? (X-MEM)
SZA
JMP FINDN /NOT YET
SKP
ISZ XFIND /2ND EXIT = FOUND
FEND3, TAD THISLN /1ST RETURN = NOT FOUND
IAC
DCA AXOUT /SET "TEXTP"
DCA XCT
JMP I XFIND
/&36
UTRA, 0 /UNPACK CHARACTER. - "GETC"
JMS GET1
UTE, SPA CLA /NORM & EXTEND
TAD GEND /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
M40, SMA SZA CLA /DEBGSW NEVER NEGATIVE
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, JMS I DAXOUT /TAD I AXOUT
DCA GTEM
CMA
DCA XCT
TAD GTEM
BSW
JMP GEND
M137, -137
/&37
XPUSHJ, 0
CLA CLL IAC
TAD XPUSHJ /BUMP RETURN ADRESS
PUSHA /SAVE IT ON STACK
TAD I XPUSHJ /GET THE ADRESS
DCA XPUSHJ /INDIRECT INDIRECT!
JMP I XPUSHJ
TLIST3=.
TASK4 /" (LITERAL TERMINATORS)
PC1 /C.R.=AUTOMATIC QUOTE MATCH
INFIX=. /DATA CONTROL CHARACTERS
FLINTP+2 /LEFT ARROW=KILL
INPUT+1 /RUBOUT=IGNORE
INPUT+1 /L.F.=IGNORE
ENDFI+15 /ALT MODE=EXIT
INPUT+1 /^L=IGNORE
FLTONE, 0001 /(NO RELATIVE REFERENCES)
2000
FLTZER, 0000
0000
0000
0000
M12, -12
CHIN, 0 /READ IN A CHARAKTER SUBR. -"READC"
JMS I INDEV
DCA CHAR
SORTC /L.F. OR RUBOUT ?
ECHOLST-1
JMP I CHIN /YES
PRINTC /ECHO THE INPUT
JMP I CHIN
ECHO, 0
ION /MAKE SURE!
DCA CHAR /SAVE IN CHAR
TAD ECHO
DCA CHIN /PREPARE RETURN THRU CHIN
JMP CHIN+6
/&38
XPRNT, 0 /PRINT A LINENUMBER -"PRINTLN"
TAD LINENO
AND MSK
BSW
RAR
JMS PRNT /TWO DIGIT PART NUMBER
TAD PER
PRINTC
TAD LINENO
JMS PRNT /TWO DIGIT STEP NUMBER
TAD SPC
DCA CHAR /SAVE SPACE IN CHAR
PRINTC /PRINT TRAILING SPACE
JMP I XPRNT
SPC, 240
VAL=T1
PRNT, 0 /PRINT TWO DEZIMAL DIGITS
AND P177
DCA VAL
TAD C260
DCA T3
JMP .+3
ISZ T3
XYZ, DCA VAL
TAD VAL
TAD M12
SMA
JMP XYZ-1
MSK, 7600 /CLA
TAD T3
PRINTC
TAD VAL
TAD C260
PRINTC
JMP I PRNT
/&39
/SYMBOL TABLE TYPEOUT ROUTINE
TDUMP, TAD END /INIT POINTER FOR DUMP (DON'T DUMP SECRET VARIABLES)
DCA PT1
TAD LASTV /TEST FOR END OF LIST
CIA
TAD PT1
SNA CLA
POPJ
TAD I PT1 /GET VARIABLE
CDF T
DCA I OP+1
CDF P
TAD OP /SETUP UNPACK POINTERS
DCA AXOUT
DCA XCT
GETC /READ AND PRINT "XX("
PRINTC
GETC
PRINTC
GETC
PRINTC
ISZ PT1
TAD I PT1 /PRINT SUBSCRIPT TO 99
JMS I PRNT2
GETC /PRINT ")"
PRINTC
ISZ PT1
FINT /PICK UP VALUE
FGET I PT1
FXIT
JMS I FOUTPUT /PRINT VALUE
TAD CCR
PRINTC
TAD GINC
TAD M2
TAD PT1
JMP TDUMP+1
PRNT2, PRNT
OP, PC0+3
PC0+4
/&40
OUT, 0 /OUTPUT A CHARACTER-"PRINTC"
SNA /USE AC OR CHAR
TAD CHAR
TAD (-15 /7-BIT CR MEANS RETURN ONLY
SNA
JMP CRONLY
TAD MSK /=-200;CHECK FOR CR
SNA
JMP NEWLIN /TYPE CR,LF
TAD (215-240
SMA
ISZ TABC /IT PRINTS, INCREMENT COUNT
NOP
TAD SPC
OUTCLF, JMS I OUTDEV
JMP I OUT
CRONLY, TAD CCR
JMS I OUTDEV /PRINT CRONLY
DCA TABC
TAD C200 /NULL FOR DELAY
JMP OUT+3
NEWLIN, DCA TABC
TAD CCR /CR
JMS I OUTDEV
TAD CLF /LF
JMP OUTCLF
CPRNT, 0 /CROSS-FIELD LINKS
PRINTC
CIF CDF L
JMP I CPRNT
PAGE
/&41
/INTERRUPT PROCESSOR
MBREAK, -220 /^P
INTRPT, 0
TSF /GIVE OUTPUT PRIORITY
JMP KINT
TCF
DCA TELSW /TURN OFF THE IN-PROGRESS-FLAG
TAD I OPTRI
SNA
JMP KINT
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
KINT, KSF /CHECK FOR KEYBOARD FIRST
JMP EXIT
KRS /INPUT CHARACTER
KCF /CLEAR FLAG
AND P177 /IGNORE BLANK AND L-T AND PARITY BIT
SNA
JMP EXIT-1 /GO INITIATE NEXT READ
TAD C200
DCA I SIN
TAD I SIN
TAD MBREAK /MANUAL STOP ?
SNA CLA
JMP RECOVR+1
TAD I SIN
DCA INBUF
SKP
KCC /INITIATE NEXT READ
/&42
EXIT, TCSD /SKIP DVM
JMP .+3
DCA I XNMBSG /CLEARS HORD OF VARIABLE "#"
TCEI /TURN OFF INT.-DON'T CLEAR FLAG
MASD /SKIP MAGNET
JMP .+3
DCA I XEXCLA /VARIABLE "!"
MACL /CLEAR FLAG
DBSK /SKIP INPUT OUTPUT
JMP .+3
DCA I XQUOTS /VARIABLE """
DBDI /DISABLE INTERRUPT
INSF /SKIP FLUXMETER
JMP .+3
DCA I XPERCT /VARIABLE "%"
INCF
PCF
RCR /CLEAR OTHER FLAGS
RRB
CIF CDF L
JMP I INTRPT
SIN, DOLL
XNMBSG, NMBSGN
XEXCLA, EXCLA
XQUOTS, QUOTS
XPERCT, PERCEN
IOBUF=7600
/&43
OPTR0, IOBUF /OUTPUT POINTER
OPTRO, IOBUF
OPTRI, IOBUF
XI33, 0 /VIA (INDEV)
JMS DIS /WHILE WAITING DISPLAY
TAD INBUF /ANY INPUT ?
SPA SNA
JMP .-3
DCA XOUTL
DCA INBUF /CLEAR INPUT BUFFER
KCC /INITIATE NEXT READ
TAD XOUTL
JMP I XI33
XOUTL, 0 /VIA (OUTDEV)
DCA XI33 /SAVE CURRENT CHAR.
ION /BE SURE INT. IS ON
JMS DIS /HERE ALSO
TAD I OPTRO /ANY ROOM ?
SZA CLA /A CHAR. IS NONZERO
JMP .-3 /NO = WAIT
IOF
TAD TELSW /IN PROGRESS ?
SZA CLA
JMP .+5
TAD XI33 /NO
TLS /TYPE CHAR
DCA TELSW /SET IN PROGRESS FLAG
JMP .+10 /RETURN
TAD XI33 /SEND DATA
DCA I OPTRO
TAD OPTRO /SET POINTERS
IAC
AND P17
TAD OPTR0
DCA OPTRO
ION
JMP I XOUTL
DIS, 0 /DISPLAY CONNECTOR
CIF CDF DI
JMS I DISD
JMP I DIS
/&44
/ERROR RECOVERY PROCEDURE
ERR2, 0
ION
TAD TELSW /WAIT FOR OUTPUT TO FINISH
SZA CLA
JMP .-2
CLA CLL CMA /PUT ERROR CODE IN 'LINENO' FOR 'PRNTLN'
TAD ERR2
JMP .+3
DCA TELSW /RECOVR-1:START ENTRY
RECOVR, TAD C200
DCA LINENO /RECOVR+1:BREAK ENTRY
IOF
TAD M20 /CLEAR OUTPUT BUFFER
DCA CNTR
SWAB /BE SURE IT IS IN MODE B
CMA
TAD OPTR0
DCA AXIN
TAD OPTR0
DCA OPTRI
TAD OPTR0
DCA OPTRO
CDF P
DCA I AXIN
ISZ CNTR
JMP .-2
DCA INBUF /AND INPUT BUFFER
RECOVX, PUSHF
IOREST /RESTORE I/O
POPF
ADD
TAD .+6
DCA I PRNRES /IN CHIN
TAD LINENO
SNA CLA /REDUCE OUTPUT FOR BREAK
JMP .+4
TAD P277
PRINTC /PRINT A '?'
PRNTLN
ISZ PC
JMS I DPC
SNA
JMP .+6
DCA LINENO
TAD .+2
PRINTC
CLA CMA BSW IAC /!!
PRNTLN
TAD CCR
PRINTC
JMP I START
PRNRES, CHIN+6
/&45
/CHARACTER REMOVAL ROUTINE
RUB1, TAD XCTIN /RUBOUT ONE LETTER
M140, SZA CLA
JMP .+6
TAD AXIN
CIA
TAD PACKST
P7700, SMA CLA /TEST NULL LINE
JMP PACX
TAD SPLAT /FOR A RUBOUT ACKNOWLEDGEMENT
JMS I ECHOP /SHALL WE ECHO A "\" ?
TAD AXIN
DCA T2
CDF T
ISZ XCTIN /TEST HALF
JMP RUB2
TAD I T2 /"ADD" IS FULL
AND P77 /REFERENCED
TAD M77
SZA CLA /TEST FOR EXTEND
JMP RUB4
RUB3, CMA /SET SWITCH
DCA XCTIN
CMA
TAD AXIN
DCA AXIN
TAD I T2 /RESET ADD
AND P7700
RUB4, DCA ADD
JMP PACX
RUB2, TAD I T2 /CHECK FOR EXTENDED
AND P7700
TAD RUB3-4 /C=100
SZA CLA
JMP RUB3
DCA I T2 /SAVE CORRECTION
JMP RUB3+1
SPLAT, 334
/&46
PACBUF, 0 /PACK A CHAR. -"PACKC"
TAD P277
CIA
TAD CHAR
SNA /CHANGE 277 TO 377
TAD P40
TAD P7700
SNA /TEST FOR RUBOUT
JMP RUB1
TAD P377
DCA T2 /SAVE INPUT ITEM
TAD T2 /SO THAT QUESTION DOESN'T MAKE
AND C140 /CHAR LOOK LIKE A LEFT ARROW
TAD M140
SZA /DATA WORD
TAD C140
SNA CLA
JMP ESCA /200-237 & 340-377
PA1, TAD T2 /240-337
AND P77
SZA /IGNORE 300
JMS PCK1
PACX, CDF P
JMP I PACBUF
ESCA, TAD P77
JMS PCK1
JMP PA1
PCK1, 0
ISZ XCTIN /=0 TO START
JMP ROT
TAD ADD
JMS I DAXIN
DCA ADD /CLEAR PACKING WORD
CLL
TAD TOP /END OF TEXT BUFFER(-)
TAD AXIN
SNL CLA
JMP I PCK1
ERROR2 /FULL BUFFER
TOP, -ENDTXT
P40, 40
P377, 377
C140, 140
ROT, BSW
DCA ADD
CMA
DCA XCTIN
JMP I PCK1
/&47
FIN, DCA LORD /SINGLE CHAR. INPUT FUNCTION
DCA OVER2 /CLEAR FLAC
TAD SORTCN /IN CASE OF RUBOUT OR LF
DCA FOUT-1
READC
TAD CHAR /FLOAT IT
DCA HORD
TAD P13
DCA EXP
TAD FOUT-1
DCA SORTCN
JMP I EFUN3I
0
FOUT, JMS I INTEGE
SNA /SINGLE CHAR, OUTPUT FUNCTION
CLA CLL CML RAR /IN CASE IT'S ZERO
PRINTC
JMP I EFUN3I
*3200
ICHARF, 0 /INPUT A CHARACTER FROM A FILE
CIF CDF L
JMS I .+2
JMP I ICHARF
ICHAR
*3206
/SECRET VARIABLES
STSECR=.
4500
PERCEN=.+2
ZBLOCK 5
4400
DOLL=.+2
ZBLOCK 5
4300
NMBSGN=.+2
ZBLOCK 5
4200
QUOTS=.+2
ZBLOCK 5
4100
EXCLA=.+2
ZBLOCK 5 /INTRPT VARIABLES
2011 /SECRET PI
0000
0002
3110
3755
2421
STVAR=.
PAGE
>
IFNZRO FOCLST <XLIST>