/ 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 $$$$$$$$$$$$$$$