File: FOCN.PA of Tape: Sources/Focal/s6
(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
FIXTAB
/&1B
/DEFINITIONS FOR LIB AND TXT IF NEEDED
IFNZRO LTNASS <
LOWOUT=0
LOWIN=0
ERROL=0
XCOM=2200
LINE1=224
PC0=200
PDLXR=11
LINE0=210
PSHFRS=14
LIBFIL=107
ZPOPA=21
ZPOPF=115
ZPOPJ=153
ZPUSHA=25
ZPUSHF=72
ZPUSHJ=132
NOCHAR=262
ICHAR=447
FILEST=540
LOWLIB=1400
XABS=751
XSGN=740
>
IFNZRO FOCLST <XLIST>
IFZERO FFNASS <
EJECT OS-8 FOCAL INTERPRETER
/&2
FIELD 1
/MISCELLANEOUS ITEMS
*0
ECHO, 1
TABC, 0 /TABCOUNTER
SPC, 240 /CONSTANT
ATSW, 0
0
0 /FOR OD
0
T=20 /TEXT FIELD NO.
P=10 /PROGRAM FIELD NO.
L=00 /LIBRARY FIELD NO.
V=10 /VARIABLE 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, 0 /XR FOR FLOATING POINT
FLTXR2, 0 /EXTRA FOR F.P.
MINUSA, -"A /CONSTANT
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
T2, 0 /TEMP FOR NEW INSTR.
T3, 0 /TEMP. REGISTER FOR OUTPUT
INSUB, 0 /0=GETC;#0=READC
C200, 200 /CONSTANT
P177, 177 /STEP MASK;DON'T MOVE;AND P177=37!!
/&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
CELSO=. /ECALL PUSHES THESE FOUR
POPFP, CIF CDF P /+ECALL=15 BIT POPJ
EFOP, 0 /FUNCTION CODE
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
XCTIN, 0000 /PACK SWITCH
OUTDEV, LOWOUT /POINTER TO OUT. SUB.
INDEV, LOWIN /POINTER TO IN. SUB.
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
P7600, 7600 /ENDS LISTS
P77, 77 /DON'T MOVE;AND P77=100!!!
/&4
/CONSTANTS
P13, 13 /USEFUL CONSTANT
PER, 256 /PERIOD
M77, -77 /EXTEND CODE TEST
P17, 17 /BCD MASK
P277, 277 /"?"
M2, -2 /CONSTANT
ERROR2=JMS I . /FIELD 1 ERROR ADRESS
ERROR /KEEP IT AT LOC. 107;SAME ADRESS IN USR;VOL!!
C260, 260 /ASCII FOR ZERO
MPER, -256 /PERIOD TEST
MCR, -215 /C.R. TEST
M5, -5 /PAREN TEST
M11, -11 /PAREN TEST
FSIZE, 12
DECP, 0
DIGITS, 12
MFLT, -WORDS /=-4 FOR 4-WORD
/POINTERS ETC.
SUBS, 0 /VARIABLE SUBSCRIPT
CNTR, -40 /DELETE AND ERROR CNTR;ALSO FP.
PAXPNT, PDLXR /POINTER FOR 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
CFRS, LINE0 /ADRESS OF DUMMY LINE
END, STVAR /FIRST LOCATION
DECALL, ECALL /RECURSIVE EVAL
DPART, PARTES /PAREN COMPARE ETC.
ENDT, LINE1
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
XPUSHF
POPF=JMS I . /RESTORE GROUP
XPOPF
/&5
/NEW INSTRUCTIONS:
STOCHR=JMS I .
CHRSTO /STORE A CHARACTER
TSTCHR=JMS I .
CHRTST /SKIPS IF CHAR=ARG
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
IN
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
XDELETE
/VARIOUS NEW POINTERS ETC.
DPC, PCD /PC
DTHIS, THISD /THISLN
DPT1, PT1D /PT1
DXRT, XRTD /(TAD I XRT)
DAXIN, AXIND /(DCA I AXIN)
SECRTV, STSECR /FOR SECRET VARIABLES
/&6
/FOCAL'S COMMAND/INPUT DRIVER
*177
START, START1 /PROGRAM START FROM SELF (INDIRECT)
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 HPDL /SET HIGH LIMIT FOR PDL
CDF T
DCA I PAXPNT
CDF P
DCA ECHO /PRINT ONLY IF ECHO
TAD CNUM /ANNOUNCE PRESENCE WITH #
PRINTC
ISZ ECHO
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
CNUM, "# /ACKNOWLEDGE CHARACTER
HPDL, 7545
LPDL, 7505
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
/LINE NUMBER FORMATION;RANGE OF ACCEPTIBLE LINE NUMBERS
/=1.01 TO 31.99
XGETLN, 0 /COMPUTED LINE #'S
SPNOR /IGNORE SPACES
TSTCHR /'A' IS SPECIAL
-"A
SKP
JMP TESTA
PUSHJ /EVALUATE NUMBER OR EXPRESSION
EVAL
JMS I INTEGER /GET GROUP PART
TAD P7740 /CHECK IF TOO BIG
SMA CLA
GZERR, ERROR2 /BAD GROUP #
206 /IG
TAD LORD /GET GROUP AGAIN
BSW
CLL RAL
DCA LINENO /SAVE IT
JMS I MINSKI
NOP /CDF V AFTER FENT
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
JMP GZERR /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
FL100, 0007
3100
0000
FLP5, 0000
P2000, 2000
0000
0000
/&8
/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
TAD LPDL /SET LOW LIMIT FOR PDL
CDF T
DCA I PAXPNT
CDF P
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
ERROR2 /ILLEGAL LINE NUMBER ON INPUT
213 /IL
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
TSTCHR /TEST FOR END OF INPUT STRING
-215 /-C.R.
JMP .-4
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
LIBN, LIBFIL
/&9
/PUSHDOWN LIST SATELLITES
FLD1=CLA CLL IAC
XPOPA, 0
MQL
FLD1
CIF T
JMS I .+1
ZPOPA
XPUSHA, 0
MQL
FLD1
CIF T
JMS I .+1
ZPUSHA
XPUSHF, 0
MQL
FLD1
CIF T
JMS I .+1
ZPUSHF
XPOPF, 0
MQL
FLD1
CIF T
JMS I .+1
ZPOPF
XPUSHJ, 0
MQL
FLD1
CIF T
JMS I .+1
ZPUSHJ
XPOPJ, CIF CDF T
JMP I .+1
ZPOPJ
/&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
66 /DG
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
73 /DL
PUSHJ /EXECUTE IT
PROCESS
POPF /RESTORE CHAR
NAGSW
DCONT, POPF /RESTORE TEXT POINTERS
TEXTP
JMP I .+1 /CONTINUE PROCESSING THIS LINE
PROC
/&11
IN, 0 /READ IN A CHARACTER SUBROUTINE."READC"
DCA INCOMP /IF AC # 0 THEN KEEP CHAR TO COMPARE
CIF CDF L
JMS I INDEV
STOCHR
TAD CHAR
CIA /NOW COMPARE
TAD INCOMP
SNA CLA
POPJ /FOUND IT;EXIT FROM 'FIND'
SORTC
ECHOLST-1 /LF. OR RUB.?
JMP I IN /YES;IGNORE
DCA ECHO /ECHO IF ECHO
PRINTC
ISZ ECHO
JMP I IN
FIND, JMS I INTEGE /GET VALUE OF SEARCH CHAR.
READC /PASS IT ON TO 'IN'
JMP .-1 /LOOP;'IN' WILL GIVE 'POPJ'
INCOMP, 0
CHRTST, 0 /TEST CHAR SUB; "TSTCHR"
TAD I CHRTST /GET ARG
ISZ CHRTST /BUMP PAST ARG
TAD CHAR
SNA CLA
ISZ CHRTST /SKIP IF EQUAL
JMP I CHRTST
PCD, 0
CDF T
TAD I PC
CDF P
JMP I PCD
TERMER, SORTC
GLIST-1
IAC
POPJ
MMINSK, JMS I MINSKI
POPJ
/&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
/PRIMARY CONTROL AND TRANSFER
GOTO, GETLN /READ THE LINE NUMBER REQUESTE
FINDLN /LOCATE IT AND RESET TEXTP
ERROR2 /NOT THERE
156 /GO
TAD THISLN /SET PC;DON'T MOVE ;REF. "DO"
DCA PC
PROCESS,GETC /TEST FOR END OF LINE
PROC, TSTCHR /FIRST CHARACTER READY = USE PROC
-215 /C.R.
SKP
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
202 /IC
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
TSTCHR
-215 /C.R.
JMP .-4
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
ISZ XTESTC /NO
TESTN
JMP I XTESTC /.
SKP /OTHER
JMP I XTESTC /NUMBER
TSTCHR
-"F /SKIP IF 'F'
ISZ XTESTC
ISZ XTESTC /RETURNS:T;N;F;A
JMP I XTESTC
XSORTC, 0 /SORT CHAR OR AC AGAINST TABLE - "SORIC"
SNA /AC?
TAD CHAR /NO.TAKE CHAR
DCA T2 /STORE IN TEMP
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 T2
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
JMP I XSORTC
/&15
GRPTST, 0 /AC VS LINENO - "TSTGRP"
AND P7600
CIA
DCA T2
TAD LINENO
AND P7600
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
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
"X /EXTRA
"Y /YELLOW
/THIS COMMAND LIST IS SPEED OPTIMIZED;"TESTC" ENDS IT
/&16
/LOOP CONTROL STATEMENT
SET=. /SUBSET OF "FOR"
FOR, PUSHJ /LOOPS, ETC.
GETARG /LOOK FOR "=" NEXT
SPNOR
TSTCHR
-"=
ERROR2 /LEFT OF "=" IN ERROR:'FOR' OR 'SET'
324 /LE
JMS SAVNAM /SAVE NAME OF VARIABLE
PUSHJ
EVAL-1 /GET INITIAL VALUE EXPRESSION
JMS GETNAM /ALL THIS FOR ZEROED VARS
NOP /EVENTUALLY FCDF V
FINT /INITIALIZE NOW
FGET I FLARGP /FLAC GETS KILLED BY GETNAM
FPUT I PT1
FXIT
SORTJ /TEST LAST CHAR FROM "EVAL"
TLIST-1
FLIST1-TLIST
ERROR2 /EXCESS R-PAR
117 /EP
FINCR, JMS SAVNAM /SAVE VARIABLE NAME
PUSHJ /EVALUATE THE INCREMENT,IF ANY
EVAL-1
SORTJ /TEST TERMINATORS
TLIST-1
FLIST2-TLIST
ERROR2 /ILLEGAL TERMINATOR IN 'FOR'
122 /FC=FOR COMMAND
FLIMIT, CDF V
PUSHF /SAVE THE INCREMENT
FLARG
PUSHJ /GET THE LIMIT(NO ERROR DETECTION AFTER LIMIT)
EVAL-1
FCONT, CDF V
PUSHF /SAVE THE LIMIT
FLARG
PUSHF /SAVE TEXT OF OBJECT STATEMENTS
TEXTP
PUSHJ /DO THE OBJECT STATEMENTS
PROCESS
POPF /RESTORE REMAINING TEXT
TEXTP
CDF V
POPF /GET LIMIT
FLARG
POPF /GET INCREMENT
ITER1
JMS GETNAM /GET VARIABLE NAME
/&18
NOP /FSPA
NOP /FSW1
NOP /FCDF V;IN AFTER FGET
FINT /INCREMENT AND TEST
FGET I FINKP /LOAD INCREMENT
FADD I PT1 /ADD VARIABLE
FPUT I PT1 /CHANGE IT
FSUB I FLARGP /TEST IT
FXIT
TAD HORD
SMA SZA CLA
POPJ /END OF LOOP
JMS SAVNAM /SAVE NAME
PUSHF /SAVE INCREMENT AGAIN
FINKP, ITER1
JMP FCONT
FINFIN, PUSHF /SET INCREMENT TO ONE
FLTONE
JMP FCONT
SAVNAM, 0 /LOCAL SUB TO SAVE NAME AND SUBSCRIPT IN PDL
TAD SUBS
PUSHA
TAD EFOP
PUSHA
JMP I SAVNAM
GETNAM, 0 /IDEM FOR GETTING
POPA
DCA EFOP
POPA
PUSHJ /PASSES AC
GS1 /SETS PT1
JMP I GETNAM
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
/&19
COMGO=. /COMMAND ROUTINE ADRESSES
SET
FOR
IF
DO
GOTO
COMMENT
ASK
TYPE
LIB
ERASE
WRITE
MODIFY
START1 /RETURN TO COMMAND MODE VIA 'QUIT'
RETRN
FILER /OPEN
ERCALL
ERCALL
/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
DCA ECHO /ONLY IF ECHO
TAD DIDO /RING-A-DING-DONG
PRINTC
ISZ ECHO
ISZ INSUB /INDICATE 'READC'
IAC /POINT PAST CHAR
JMS I FINPUT /READ DATA AND SAVE
ENDASK, POPA /RETEST LAST TERMINATOR
STOCHR
JMP ASK /CONTINUE PROCESSING
TYPE2, PUSHJ /DO TYPE
EVAL
JMS I FOUTPUT /PRINT
JMP TYPE
ALT, CLA CMA /RESET TABC;CODE 376 IS PSEUDO-PRINTING
TAD TABC
DCA TABC
ESC, DCA ECHO /ONLY IF ECHO
FINT
FGET I PT1
FEXT
JMS I FOUTPUT /ECHO CURRENT VALUE OF LITERAL
ISZ ECHO
JMP ENDASK
DIDO, "?
/&20
TQUOT, ISZ DEBGSW /DISABLE TRACE
GETC /TYPE LITERALS
SORTJ
TLIST2-1
TLIST3-TLIST2
PRINTC
JMP TQUOT+1
TINTR, GETC /PASS PERCENT SIGN
TESTC
JMP FILL /SHOULD BE '*'
JMP FORMAT /NUMBER;NORMAL FORMAT
TAD SPCMF /F;RESET ALL
TAD CHAR /OTHER;SET LEADING CHAR
DCA I DPEQ
SKP
FILL, TAD STRMSP /SET "*"
TAD SPCMZE /SET SPACE
DCA I DFILL
JMP TINTR /GET NEXT CHAR
SPCMF, 240-"F
STRMSP, "*-240
SPCMZE, 240-"0
DPEQ, PEQ
DFILL, FILLER
FORMAT, GETLN
TAD LINENO
DCA FISW /SET FLOAT SW.
TAD LINENO
AND P7600
BSW
CLL RAR
SNA
TAD DIGITS /FLOATING
DCA FSIZE
TAD LINENO
AND P17
DCA DECP
TAD FSIZE
CIA
TAD DECP
SMA CLA
ERROR2 /FORMAT ERROR
136 /FO
JMP TASK
TCRLF2, CLA CLL IAC /PRINT CR ONLY;I.E.216
TCRLF, TAD CCR /EXCLAMATION POINT=CR,LF
PRINTC
TASK4, GETC /MOVE TO NEXT CHAR
JMP TASK
/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
/&23
XTAB, PUSHJ
EVAL-1
FENT
FADD I TRND /LET'S ROUND OFF
FEXT
JMS I INTEGE
CIA
TAD TABC
IAC
SMA
JMP BACK
DCA CNTR
TAD SPC
PRINTC
ISZ CNTR
JMP .-3
BACK, CLA CLL
JMP TASK
TRND, FLP5
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=.
IRETN /C.R. = END THE LINE HERE AS IT IS
SGOT /CHAR = SEARCH CHAR
ALIST=. /ASK/TYPE LIST OF CONTROLS
"' /EXTRA
"& /EXTRA
":
"%
242 /"
"!
"#
244 //$//
GLIST=.
240 /SPACE
TLIST=.
",
";
215 /C.R.
MGETC, GETC
POPJ
/&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.
ERROR2 /BAD ARGUMENT IN 'FOR','SET',OR 'ASK'
20 /BA
GETVAR, DCA XCTIN /PACK INTO ADD.
PACKC /PACK FIRST CHAR
TAD ADD /SAVE NAME
DCA EFOP /WHERE WE CAN PUSH IT
GETLP, GETC /GET NEXT CHAR
SORTC /END OF NAME?
TERMS-1
JMP GSERCH /YES
ISZ XCTIN /IS THIS THE SECOND CHAR?
JMP GETLP /MORE THAN 2 CHARS;IGNORE
TAD CHAR /PACK SECOND CHAR
AND P77 /MASK IT
JMP GETLP-2 /ADD TO NAME
GSERCH, TSTLPR /CHECK FOR SUBSCRIPT
JMP GS1 /NONE
JMS I DECALL /PICK IT UP
POPA /RESTORE NAME
DCA EFOP
JMS I DPART /CHECK PAREN MATCH,ETC.
JMS I INTEGE /CONVERT TO 12 BIT
GS1, DCA SUBS /SAVE SUBSCRIPT
MQL /CLEAR LAST ZERO HOLD
TAD SECRTV /START SEARCH WITH SECRET
JMP GSTRT /GO IN LOOP
GS2, ISZ XRT /NAME DID NOT MATCH
GS3, ISZ XRT /SUBSCRIPT DID NOT MATCH
TAD I XRT /GETS HORD OF VAR.
SZA CLA /IS VAR. ZERO?
JMP .+3 /NO.MUST BE REAL
TAD PT1 /YES!LET'S STORE ADRESSES
MQL /AS WE GO ALONG
TAD PT1
TAD GINC /NEXT
/VARIABLES GET ADDED IN THE FOLLOWING WAY:
/IF ANY ZERO'S AVAILABLE:FROM LASTV DOWNWARDS;BUT NOT SECRET
/IF NO ZERO'S FROM LASTV UPWARDS;THEN BLOW-UP
/&25
GSTRT, DCA PT1 /FIRST OR NEXT POINTER
TAD LASTV /CHECK FOR END OF
CIA CLL /EXISTING VARS.
TAD PT1
SZL CLA
JMP MAKVAR /VAR. NOT IN LIST;CREATE NEW ONE
TAD PT1 /REPLICATE SO PT1 STAYS
DCA XRT /AT START OF VAR.
CDF V /VARIABLE FIELD
TAD I PT1 /NAME
CIA
TAD EFOP /ASKED NAME
SZA CLA /CHECK?
JMP GS2 /NO
TAD I XRT /OK.WHAT ABOUT SUBS.?
CIA
TAD SUBS
SZA CLA
JMP GS3 /ALMOST!
ISZ PT1 /FOUND IT!!
ISZ PT1 /POINT TO DATA
POPJ
MAKVAR, MQA /GET OUT LAST ZERO ADRESS
SNA /ANY ZERO'S?
JMP TOPVAR /NO.PUT IT ON TOP
CIA /CHECK FOR SECRET VARS.
TAD END /STVAR
SNL SZA CLA
JMP TOPVAR /IT WAS SECRET;ON TOP
MQA /OK.USE ZERO VAR.
DCA PT1 /RESET PT1
JMP VAREX
/&26
TOPVAR, TAD VARTOP /CHECK FOR TOP
CIA CLL
TAD LASTV
SZL CLA
ERROR2 /REALLY NO MORE SPACE!
265 /LF=LITERALS FULL
TAD LASTV /OK;UPDATE LASTV
TAD GINC
DCA LASTV
VAREX, TAD EFOP /NOW STORE IN RIGHT PLACE
DCA I PT1
ISZ PT1
TAD SUBS
DCA I PT1
ISZ PT1 /POINTING AT DATA
CDF P /CAREFUL FPNT!
NOP /FOR FCDF V
FINT
FGET I CFRSX /ZERO THE DATA
FPUT I PT1
FXIT
POPJ /EXIT
VARTOP, FEXP-10
CHRSTO, 0 /STORE A CHAR IN FLD 0 AND 1 - "STOCHR"
DCA CHAR
TAD CHAR
CDF L
DCA I XCHAR
CDF P
JMP I CHRSTO
XCHAR, CHAR
THISD, 0
CDF T
TAD I THISLN
CDF P
JMP I THISD
PT1D, 0
CDF T
TAD I PT1
CDF P
JMP I PT1D
ATLIST=.
ERCALL /NOT YET DEFINED
ERCALL /NOT YET DEFINED
XTAB /: - TABULATOR
TINTR /% - FORMAT DELIMITER
TQUOT /" - LITERAL DELIMITER
TCRLF /! - CARRIAGE RETURN AND LINE FEED
TCRLF2 /# - CARRIAGE RETURN ONLY
TDUMP /DOLLAR/- DUMP THE SYMBOL TABLE CONTENTS
TASK4 /SP- TERMINATOR FOR NAMES
TASK4 /, - TERMINATOR FOR EXPRESSIONS
PROCESS /; - TERMINATOR FOR COMMANDS
PC1 /C.R.TERMINATOR FOR STRINGS
/DOLLAR/ - 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
ECALL, 0 /RECURSIVE CALL TO "EVAL"
PUSHF /SAVE SORTCN,LASTOP,EFOP
CELSO /INCLUDES 'CIF CDF P' FOR POPJ
TAD ECALL /RETURN TO CALLING
PUSHA /ADRESS AFTER NEXT POPJ
GETC /MOVE PAST EXTRA CHAR
EVAL, DCA LASTOP /EVALUATION CONTROLLER(CHECKPOINT?)
NOP /REFRESH?
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
ERROR2 /OPERATOR MISSING BEFORE PAREN
336 /NO=NO OPERATOR
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
NOP /LATER FCDF V
FINT
FLOP, 00 /(FLOPR I PT1)+-*/
FPUT I FLARGP /SAVE RESULT
FXIT
TAD FLARGP
DCA PT1
TAD THISOP
TAD LASTOP /=0?
SNA CLA
JMP EVLEX /EXIT EVAL
POPA /GET PRIOR OP
DCA LASTOP
JMP ETERM2 /COMPARE THIS OP
EVLEX, TAD SORTCN
DCA I ULTSOR /SAVE LAST "SORTCN"
POPJ
EPAR, TSTLPR /TEST FOR SUB-EXPRESSION
SKP
JMP EPAR2 /GO EVALUATE EXPRESSION
TAD LASTOP /CONTINUE READING THE EXPRESSION
PUSHA /SAVE "LASTOP"
TAD PT1
DCA .+3
CDF V
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
ERROR2 /MUST BE FOLLOWED BY PARENS TO SET ARGUMENT
25 /BF=BAD FUNCTION
JMS ECALL /CALL "EVAL" TO COMPUTE ARGUMENT
POPA /GET OUT EFOP
SORTC
FNTABL-1
JMP I STFUNC /FOUND IT
ELPAR, TSTLPR /LEFT PAREN OR FELL THROUGH FUNCTION TABLE
ERROR2 /DOUBLE OPERATORS OR ILLEGAL FUNCTION NAME
124 /FE=FUNCTION ERROR
EPAR2, JMS ECALL /EVALUATE NESTED EXPRESSION
POPA /DUMP EXTRA ARG
JMP I EFUN3I
STFUNC, FUNCST
EFUN3I, EFUN3
ULTSOR, SORTUL
/&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'
FNTAPT, FNTABF-1 /POINTER TO 2-WORD FNTABF
FUNCST, TAD SORTCN /SET BY SORTC
CLL RAL /*2
TAD FNTAPT
DCA XRT2
TAD I XRT2 /GET FIELD OF FUNCTION
DCA .+3
TAD I XRT2 /GET ADRESS
DCA .+3
HLT
PUSHJ
HLT
/&31
EFUN3, NOP /FOR FCDF
FINT
FNOR /NORMALIZE FUNCTION RETURN
FPUT I FLARGP /SAVE FUNCTION VALUE
FXIT
TAD FLARGP /SET POINTER
DCA PT1
JMS PARTEST
JMP I .+1
OPNEXT
SORTUL, 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 SORTUL /(STILL SET FROM THE LAST 'EVAL')
SZA CLA /SKIP IF MATCH
ERROR2 /PAREN ERROR
317 /MP=MISSING PARENTHESIS
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
TSTCHR
-215 /C.R.
JMP .-3
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 /CORRECT END OF BUFFER POINTER
TAD BUFR
DCA BUFR
TAD AXIN /COMPUTE COUNT
CMA
TAD AXOUT
DCA T1
TAD AXIN
TAD CNTR
DCA AXIN
TAD I AXOUT
DCA I XRT
ISZ T1
JMP .-3
JMP XDELETE+1 /RESET 'LASTLN','THISLN', AND DATA FIELD
FNTABL=.
2533 /ABS
2650 /SGN
2636 /ITR
2630 /RAN
2572 /ATN
2624 /EXP
2625 /LOG
2654 /SIN /LIST OF CODED FUNCTION NAMES
2575 /COS
2702 /SQT
1140 /IN
2672 /OUT
2604 /(F)IND
0324 /T
0325 /U
0326 /V
0327 /W
0330 /X
0331 /Y
0332 /Z
/&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 .+3 /ERROR
TSTCHR /ALL TEXT
-"A
ERROR2 /BAD ARG FOR ERASE
24 /BE=BAD 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, STOCHR
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, CDF T
TAD I AXOUT
CDF P
DCA GTEM
CMA
DCA XCT
TAD GTEM
BSW
JMP GEND
M137, -137
/&37
RETRN, TAD C200
DCA PC
POPJ
PGETLN, GETLN
POPJ
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
ALT /ALT MODE=EXIT
ESC /ESC=ALT
FLTONE, 0001 /(NO RELATIVE REFERENCES)
2000
0000
0000
M12, -12
XSPNOR, 0 /IGNORE LEADING SPACES - "SPNOR"
TSTCHR
-240 /SPACE
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 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
/&38
XPRNT, 0 /PRINT A LINENUMBER -"PRNTLN"
DCA COMBO+3 /IF AC='SKP' :PACK ALSO
TAD LINENO
AND P7600
BSW
RAR
JMS PRNT /TWO DIGIT PART NUMBER
TAD PER
PRINTC
TAD LINENO
JMS PRNT /TWO DIGIT STEP NUMBER
TAD SPC
JMS COMBO /PRINT AND SOMETIMES PACK
DCA COMBO+3 /RESET TO PRINT ONLY
JMP I XPRNT
PRNT, 0 /PRINT TWO DEZIMAL DIGITS
AND P177
DCA T1
TAD C260
DCA T3
JMP .+3
ISZ T3
XYZ, DCA T1
TAD T1
TAD M12
SMA
JMP XYZ-1
CLA
TAD T3
JMS COMBO
TAD T1
TAD C260
JMS COMBO
JMP I PRNT
COMBO, 0 /COMBINED PRINT PACK
STOCHR
PRINTC
0
JMP I COMBO
PACKC
JMP I COMBO
/&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
CDF V
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
CDF V
TAD I PT1 /PRINT SUBSCRIPT TO 99
CDF P
JMS PRNT
GETC /PRINT ")"
PRINTC
ISZ PT1
NOP /FCDF V
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
OP, PC0+3
PC0+4
/&40
LGOSUB, PUSHJ /EXECUTE THE SUBROUTINE
DO+1
TAD SPC
STOCHR
SKP
LIB, SPNOR /IGNORE SPACES
DCA GOSWIT /I.E. TO "PROC" FOR REST OF LINE
CIF CDF L
JMP I LIBLOW
TAD JMPGOS /RETURN TO APPROPRIATE ROUTINE
TAD GOSWIT
DCA GOSWIT
GOSWIT, JMP I .+1
PROC
START1
LGOSUB
GOTO+1
LIBLOW, LOWLIB
JMPGOS, JMP I GOSWIT+1
SPECIAL=. /INPUT CHARS
337 /LEFT ARROW
377 /RUBOUT
212 /LINE FEED
375 /ALT MODE
233 /ESCAPE
/&41
/SEARCH ROUTINES
MODIFY, GETLN /READ LINE NO.
FINDLN /LOOK IT UP NOW
ERROR2 /NOT THERE = BAD COMMAND UNLESS ZERO
34 /BM=BAD MODIFY
TAD BUFR /SET POINTERS
DCA AXIN /FOR INPUT
DCA XCTIN
TAD BUFR
DCA PACKST
TAD MODSKP /SET PRNTLN FOR PACKING
PRNTLN
SCONT, CIF CDF L
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, CLL CML CLA IAC RAL /RESTART-B.A.
TAD BUFR
DCA AXIN /SET POINTERS
DCA XCTIN
SFOUND, READC /READ FROM KEYBOARD
SORTJ /TEST
LIST6-1
SRNLST-LIST6
SGOT, PACKC /PACK CHAR.
JMP SFOUND /MORE
MODSKP, SKP
/&42
OUT, 0 /OUTPUT A CHARACTER-"PRINTC"
SNA /USE AC OR CHAR
TAD CHAR
TAD M216 /CNTRL N MEANS RETURN ONLY
SNA
DCA TABC /XOUTL WILL HANDLE CR ONLY
IAC /CHECK FOR CR
SNA
JMP NEWLIN /TYPE CR,LF
TAD CRMSPC
SMA
ISZ TABC /IT PRINTS, INCREMENT COUNT
IFNOP, NOP
TAD SPC
OUTCLF, CIF L
JMS I OUTDEV
JMP I OUT
NEWLIN, DCA TABC
TAD CCR /CR
CIF L
JMS I OUTDEV
TAD CLF /LF
JMP OUTCLF
M216, -216
CRMSPC, 215-240
/&43
*2676 /SO 'IF3' IS JUST PAST PAGE BOUNDARY
/CONDITIONAL TRANSFER PROCESS
IFLIST, 300
276 /.GT.
275 /.EQ.
300
274 /.LT.
SPNA, SPA SNA CLA
P76MSP, 7600-7750 /7750=SPA SNA CLA
P2004, 2004
IFSPA, SPA
IF, TESTC /FIRST CHAR. MUST BE TERMINATOR
JMP IFOK /OK!
FRSTIF, 0
SCNDIF, 0
JMP IFER
IFOK, TAD IFSPA
DCA IF2 /RESET IF2
JMS I DECALL /EVALUATE FIRST EXPRESSION
TSTCHR
-", /TEST IF TERMINATED BY ','
JMP COMPIF /NO COMPUTED IF
GETC /GOBBLE COMMA
SORTC
IFLIST-1 /GET FIRST REL. OP.
SKP
IFER, ERROR2 /NO SUCH!
204 /IE=IF ERROR
TAD SORTCN
DCA FRSTIF /KEEP FIRST REL. OP.
DCA SORTCN
GETC /NEXT REL. OP. IF ANY
SORTC
IFLIST-1
GETC /FOUND ONE;MOVE TO NEXT CHAR
TAD SORTCN
DCA SCNDIF /KEEP;IF NONE = 0
CLA CLL IAC RAL /2=OP. '-'
DCA THISOP
PUSHJ
EPAR /EVALUATE SECOND ARGUMENT
/&44
TAD FRSTIF
CIA
TAD SCNDIF
SNA CLA
JMP IFER /SOME COMBINATION LIKE:'=='
TAD IFNOP
DCA IF2 /SET FOR TWO EXITS
TAD FRSTIF /NOW COMPUTE INSTRUCTION
TAD SCNDIF
CLL RAR /.GT. IN LINK
SZL
CMA /COMPL. IF .GT.
SZL
TAD P2004 /SET REVERSE SENSE
BSW
CLL RAR
TAD P76MSP
COMPIF, TAD SPNA
DCA IF3-1
POPA /DUMP EFOP
JMS I DPART /CHECK PARENS.
TAD M2
DCA T1
TAD HORD /TEST COMP.IF. -,0,+
IF2, SPA
ISZ T1
SPA SNA CLA /OR SOME OTHER INSTR.
IF3, ISZ T1 /COUNT COMMAS
SKP
JMP I IFGO /TRANSFER TO GO
SORTJ /SEARCH TEXT UNTIL ,;C.R.
TLIST-1
ILIST-TLIST
GETC
JMP .-4
IF1, GETC /MOVE PAST COMMA
JMP IF3
IFGO, GOTO
FILER, CIF CDF L
JMP I .+1
FILEST
ERCALL, ERROR2 /NON EXISTENT ITEM IN LIST
320 /NA=NOT AVAILABLE
/&45
/CHARACTER REMOVAL ROUTINE
*3022
RUB1, TAD AXIN /RUBOUT ONE LETTER
CIA
TAD PACKST /PROTECTION
SPA CLA
TAD AXIN /IF TOO LOW PUT 0 IN T2
DCA T2
CDF T
ISZ XCTIN /TEST HALF
JMP RUB2
TAD I T2 /ADD IS FULL
AND P77 /IF PROTECTION
TAD M77 /THIS NEVER GIVES ZERO
M140, SZA CLA /BECAUSE LOC.0 FLD T IS ZERO
JMP RUB4
RUB3, CMA /IT IS EXTEND CODE
DCA XCTIN /SET SWITCH
CMA
TAD AXIN
DCA AXIN
TAD I T2 /RESET ADD
AND P7700
RUB4, DCA ADD
CDF P
DCA ECHO /ONLY IF ECHO
TAD SPLAT /FOR RUBOUT ACKNOWLEDGEMENT
PRINTC
ISZ ECHO
JMP I PACBUF
RUB2, TAD T2
SNA CLA
JMP PACX /PROTECTED!
TAD I T2 /CHECK FOR EXTEND
AND P7700
TAD M140-2
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
P377, 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
ROT, BSW
DCA ADD
CMA
DCA XCTIN
JMP I PCK1
P40, 40
P7700, 7700
PCK1, 0
ISZ XCTIN /=0 TO START
JMP ROT
TAD ADD
JMS I DAXIN
DCA ADD /CLEAR PACKING WORD
JMP I PCK1
/&47
AXIND, 0 /AXIN SUB. NOW CHECKS FOR OVERFLOW
CDF T
DCA I AXIN
TAD I PAXPNT /PDLXR
CLL CIA
TAD AXIN
TAD AXILIM /ONE BLOCK DISTANCE FOR PDL
CDF P
SNL CLA
JMP I AXIND
ERROR2 /TEXT OVERFLOW
365 /PF=PROGRAM FULL
AXILIM, 400
FIN, READC /SINGLE CHAR. INPUT FUNCTION
TAD CHAR /FLOAT CHAR.
DCA HORD
DCA LORD
DCA OVER2
TAD P13
DCA EXP
POPJ
FOUT, JMS I INTEGE /SINGLE CHAR OUTPUT FUNCTION
SNA
CLA CLL CML RTR /IN CASE IT'S ZERO
PRINTC
POPJ
XINT, JMS I INTEGE
CLA CLL
POPJ
C140, 140 /DON'T MOVE!!
/&48
*3200
/SECRET VARIABLES
STSECR=.
4400
DOLL=.+2
ZBLOCK 5
4300
NMBSGN=.+2
ZBLOCK 5
4100
EXCLA=.+2
ZBLOCK 5 /INTRPT VARIABLES
4200
QUOTS=.+2
ZBLOCK 5
2011 /SECRET PI
0000
0002
3110
3755
2421
STVAR=.
PAGE
>
IFNZRO FOCLST <XLIST>