Directory of image this file is from
This file as a plain text file
/ GENERAL PURPOSE OPERTING PROGRAM "TOOL".
/ MK. V / 5TH. ED. - 7/1/69
/DEFINE TOOL INSTRUCTIONS
RCHAR=JMS I 20
TCHAR=JMS I 21
RTCHAR=JMS I 22
TDC=JMS I 23
LINE=JMS I 24
CHECK=JMS I 25
CHBLOK=JMS I 26
IGSP=JMS I 27
RTIGSP=JMS I 30
TOOLSR=JMS I 31
CHOCT=JMS I 32
ROCT=JMS I 33
OUTOCT=JMS I 34
RTIGAN=JMS I 36
IGCOM=JMS I 37
TOOLGO=JMP I 35
FIXTAB
/SET PAGE 0 POINTERS
*20
SRRCH
SRTCH
SRRTCH
SRTDC
SRLINE
SRCH
SRCHBK
SRIGSP
SRRTIS
SRTOOL
SRCHOC
SRROCT
SROOP
RTOOL+1
SRRTGN
SRIGCM
*300
SRRTGN, 0 /IGNORE ALPHANUMERICS
RTCHAR
CHBLOK
301
32
JMP SRRTGN+1
CHBLOK
260
12
JMP SRRTGN+1
IGSP
JMP I SRRTGN
SRIGCM, 0 /IGNORE COMMENTS
IGSP
CHECK
250 /"(" FOR COMMENTS
SKP
JMP I SRIGCM
NEXTIG, RTCHAR
CHECK
212
JMP I SRIGCM
CHECK
215
JMP I SRIGCM
JMP NEXTIG
SROOP, 0 /OCTAL OUTPUT
MQL
TAD P4
CIA
DCA T1
NEXTO, CLA SHL
2
TAD P260
TCHAR
ISZ T1
JMP NEXTO
TDC
240
JMP I SROOP
P4, 4
P260, 260
T1, 0
/ --------------------
EXTEND, CHECK
203 /TYPE CONTROLC TO RET TO MON
JMP KBM
JMS I TERMI
0
JMP I .-1
TERMI, TERM
KBM, CIF CDF 0
JMP I .+1
7600
*400
RTOOL, TLS
LINE
TOOLSR
JMP .-1
SRTOOL, 0
KSF
JMP I SRTOOL /IMMEDIATE RETURN
CLA /UNLESS KEYBOARD STRUCK
NOETAL, TAD ERINST
DCA ETAL+2 /DISABLE "&"
BACK, RTIGSP /GET 1ST ARGUMENT
CHBLOK
301 /"A"
32 /=26 DECIMAL
JMP LET
CHOCT
SKP
JMP OCT
CHECK
246 /"&"
JMP ETAL
EXIT, JMP I .+1
EXTEND
LET, TAD LCONST
DCA TAG /SET TAG
TAD ADD
DCA ETAL+2 /ENABLE "&"
RTIGAN /GET OPERATOR
CHECK
253 /"+"
JMP ADD
CHECK
300 /"@"
JMP AT
CHSTAR, CHECK
252 /"*"
JMP STAR
CHECK
257 /"/" FOR "="
JMP EQ
JMP EXIT
LCONST, TABLE-300
ADD, RTIGSP
ROCT
DCA ARGA /SAVE TERMINATOR
TAD I TAG
JMP OCTA
/ ----------
OCT, ROCT
DCA ARGA /SAVE TERMINATOR
OCTA, TAD OCNUM
DCA TABLE /SET DUMMY
TAD TABAD
DCA TAG /SET TAG
TAD ADD
DCA ETAL+2 /ENABLE "&"
TAD ARGA /RESTORE TERMINATOR
IGSP /GET OPERATOR
JMP CHSTAR
ETAL, CLA IAC
DCA OCNUM /SIMULATE "+1"
RTIGSP /GET OPERATOR
JMP ADD+2
AT, RTIGSP /GET 2ND. ARGUMENT
JMS ARGA
CLA
TAD OCNUM
DCA I TAG /EXECUTE "@"
JMP I TRET
EQ, CLA
TAD I TAG
DCA ARGA
TAD I ARGA
OUTOCT /DISPLAY CONTENTS
TAD I TAG /AND LOCATION
RTIGSP /GET 2ND. ARGUMENT
CHECK
255 /"-"
JMP NEG
JMS ARGA
NEGIN, CLA
TAD I TAG
DCA ARGA
TAD OCNUM
DCA I ARGA /EXECUTE "="
TAD LF+1
DCA I ERRORI /RESTORE LOCATION "E"
JMP I TRET
STAR, LINE
TAD I TAG
DCA SRTOOL
JMP CR+2 /EXECUTE "*"
NEG, RTIGSP /GET 2ND. ARGUMENT
JMS ARGA
CLA
TAD OCNUM /NEGATE OCNUM
CIA
DCA OCNUM
JMP NEGIN
ARGA, 0
ROCT
JMS TERM /HANDLE TERMINATOR
TRET, 0
JMP I ARGA
TERM, 0
IGCOM
CHECK
212 /"LF"
JMP LF
CHECK
215 /"CR"
JMP CR
ERINST, JMP I ERRORI
LF, JMS I TERM
TDC
215 /"CR"
JMP BACK /AWAIT NEXT COMMAND
CR, JMS I TERM
LINE
TSF
JMP .-1 /WAIT TO FINISH TYPING
JMP I SRTOOL /RETURN TO CALLING PROGRAM
ERRORI, ERROR
OCNUM, 0
TAG, 0
TABAD, TABLE
TABLE, E
E /A
E /B
E /C
E /D
E /E
E /F
E /G
E /H
E /I
E /J
E /K
E /L
E /M
E /N
E /O
E /P
E /Q
E /R
E /S
E /T
E /U
E /V
E /W
E /X
E /Y
E /Z
/ GENERAL PURPOSE SUBROUTINES
E,
ERROR, TDC /TYPE "? CR LF" AND
277 /AWAIT NEXT COMMAND
LINE
JMP I BACKI
BACKI, BACK
SRRCH, 0 /READ A CHARACTER
KSF
JMP .-1
KRB
JMP I SRRCH
SRTCH, 0 /TYPE A CHARACTER
TSF
JMP .-1
TLS
JMP I SRTCH
TEMPB,
SRRTCH, 0 /READ AND TYPE A CHARACTER
RCHAR
TCHAR
JMP I SRRTCH
TEMPA,
SRTDC, 0 /TYPE DIAGNOSTIC SYMBOL
CLA
TAD I SRTDC
ISZ SRTDC
TCHAR
CLA
JMP I SRTDC
TEMP,
SRLINE, 0 /TYPE "CR LF"
TDC
215
TDC
212
CLA
JMP I SRLINE
SRCH, 0 /CHECK AND SKIP IF WRONG
DCA TEMP /SAVE AC
TAD I SRCH
ISZ SRCH
CIA
TAD TEMP
SZA CLA
ISZ SRCH
TAD TEMP /RESTORE AC
JMP I SRCH
SRCHBK, 0 /SKIP IF NOT IN BLOCK
DCA TEMP /SAVE AC
TAD I SRCHBK
ISZ SRCHBK
CIA
TAD TEMP
SPA
JMP NO
CMA
TAD I SRCHBK
SPA
NO, ISZ SRCHBK
ISZ SRCHBK
CLA
TAD TEMP /RESTORE AC
JMP I SRCHBK
TEMPC,
SRCHOC, 0 /SKIP IF OCTAL DIGIT
CHBLOK
260
10
ISZ SRCHOC
JMP I SRCHOC
SRROCT, 0 /READ AND TYPE OCTAL NUMBER
CHOCT /1ST. CHAR. IN AC. ON ENTRY
JMP I EXITI /ENTERED WITH NON-OCT. CHAR.
AND MASK
DCA TEMPC
TAD M4
DCA TEMPA
DCA I OCNUMI
CLL
ROCTA, TAD I OCNUMI
RAL
RTL
TAD TEMPC
DCA I OCNUMI
RTCHAR
CHOCT
JMP I SRROCT /EXIT ON NON-OCT CHAR.
AND MASK
DCA TEMPC
ISZ TEMPA
JMP ROCTA
JMP ERROR />4 OCT. CHAR'S TYPED
M4, -4
MASK, 0007
OCNUMI, OCNUM
EXITI, EXIT
SRIGSP, 0 /IGNORE SPACES
CHECK
240
RTIGSP
JMP I SRIGSP
SRRTIS, 0 /READ AND TYPE IGNORING SPACES
RTCHAR
CHECK
240
JMP .-3
JMP I SRRTIS
$$$$$$$$$$$$$$$