.TITLE FOCAL / / COPYRIGHT (C) 1975 / DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. / / THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY / ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH / THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS / SOFTWARE, OR ANY OTHER COPIES THEREOF, MAY NOT BE PRO- / VIDED OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON / EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO / THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE / SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC. / / THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE / WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COM- / MITMENT BY DIGITAL EQUIPMENT CORPORATION. / / DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY / OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY / DEC. / .EJECT / EDIT 24 3--30--71 /OPTIMIZE RUN INIT. /USER AREAS EXTERNAL / /EDIT 025 15-JUL-74 E.KATZ CHANGE SIGNON NUMBER / EDIT 026 27 JUN 75 M. HEBENSTREIT XVM CHANGES / EDIT 027 31 JUL 75 M. HEBENSTREIT / EDIT 028 29 AUG 75 M. HEBENSTREIT XVMOFF BUG / /******************************************************************************* / / AS OF JUN 27, 1975 THE ONLY SYSTEM THIS PROGRAM CAN RUN UNDER IS DOS/XVM / / THE ONLY TWO LEGAL ASSEMBLY PARAMETER COMBINATIONS ARE: / 1.) NO ASSEMBLY PARAMETERS SPECIFIED (PAGE MODE) / 2.) %PDP9=0 AND %PDP15=0 (BANK MODE) / /******************************************************************************* / / / /FOCAL FOR THE PDP-9 AND PDP-15 ADVANCED SOFTWARE SYSTEM /ALSO FOR THE PDP9 AND PDP-15 BF MONITOR SYSTEM / /COPYRIGHT 1969,1971 DIGITAL EQUIPMENT CORP., MAYNARD, MASS. 01754 / /DAVE LENEY /2-7-69 / /FOCAL IS A REGISTERED TRADEMARK OF /DIGITAL EQUIPMENT CORPORATION / /DEFINE MULTI=N IF MULTI-USER VERSION WHERE N=2 OR 4 USERS /DEFINE BF=0 IF BACKGROUND-FOREGROUND MONITOR /FOR PDP-9/15 BANK MODE SYSTEM DEFINE: /PDP9=0,PDP15=0 OR %PDP9=0,%PDP15=0 /FOR DPD-9 SYSTEM DEFINE: /PDP9=0 OR %PDP9 /FOR PDP-15 SYSTEM, PDP9 AND PDP15(OR %PDP9 AND %PDP15) NOT DEFINED /DATA COMMANDS IMPLEMENTED FOR SINGLE USER /BELOW %PDP9,%PDP15 AND PDP9,PDP15 ARE MADE EQUIVALENT .IFDEF %PDP9 PDP9=%PDP9 .ENDC .IFDEF %PDP15 PDP15=%PDP15 .ENDC .IFZER MULTI-4 USR4=0 .ENDC / /GLOBAL CALLS TO F4 ARITHMETIC PACKAGE / .GLOBL .AA /EXPONENT .GLOBL .AB /HIGH ORDER MANTISSA .GLOBL .AC /LOW ORDER MANTISSA .GLOBL .AO /LOAD (3 WORDS) .GLOBL .AP /STORE (3 WORDS) .GLOBL .AQ /ADD .GLOBL .AR /SUBTRACT .GLOBL .AS /MULTIPLY .GLOBL .AT /DIVIDE .GLOBL .AX /FIX .GLOBL .BA /NEGATE .GLOBL .AW /FLOAT .GLOBL .CD /NORMALIZE .GLOBL .BH /A**B-POWER .GLOBL DSIN /SINE .GLOBL DCOS /COSINE .GLOBL DATAN /ARCTANGMENT .GLOBL DLOG /LOGARITHM .GLOBL DEXP /EXPONENTIAL .GLOBL DSQRT /SQUARE ROOT .GLOBL .ER /.OTS ERROR (?36) / /.GLOBL REFERENCES FOR EXTERNAL FUNCTIONS / .GLOBL .NEWF /FUNCTION TABLE .GLOBL XPUSHJ /PUSH JUMP .GLOBL XPUSHA /PUSH AC .GLOBL PD2 /PUSH FLOATING .GLOBL PD3 /POP FLOATING .GLOBL UTRA /UNPACK .GLOBL XSPNOR /IGNORE SPACES .GLOBL FUNERR /ERROR IN EXTERNAL FUNCTION .GLOBL EFUN3 /FUNCTION RETURN .GLOBL FINT /FLOATING INTERPRETER .GLOBL CHAR /CHRACTER STORAGE .GLOBL EVAL /EVALUATION ROUTINE .GLOBL LASTV /END OF TEXT/VARIABLES .GLOBL BOTTOM /START OF PUSH-DOWN LIST .GLOBL LINENO /CURRENT LINE .GLOBL FLARG /FLOATING ARGUMENT .GLOBL BUFSTX /POINTER TO 3 WD UNPACK AREA .GLOBL XGETLN /FETCH LINE NUMBER .GLOBL XPOPJ /POP JUMP .GLOBL FETVAR /GET 3,6,OR 9 .SIXBT CHARS .IFDEF MULTI / EXTERNAL GLOBLS FOR USER AREAS ONE AND TWO .GLOBL AREA1,AREA2,FILA1,FILA2,FILB1,FILB2,FILC1,FILC2 .GLOBL BOT1,BOT2,BUF1,BUF2,ENDT1,ENDT2 .GLOBL ENDT1A,ENDT1C,ENDT1D,ENDT2A,ENDT2C,ENDT2D / INTERNAL GLOBLS USED BY USER AREAS ONE AND TWO .GLOBL CTLP1,CTLP2,WAITB1,WAITB2 .IFDEF USR4 / EXTERNAL GLOBLS FOR USER AREAS THREE AND FOUR .GLOBL AREA3,AREA4,FILA3,FILA4,FILB3,FILB4,FILC3 .GLOBL FILC4,BOT3,BOT4,BUF3,BUF4,ENDT3,ENDT4 .GLOBL ENDT3A,ENDT3C,ENDT3D,ENDT4A,ENDT4C,ENDT4D / INTERNAL GLOBLS USED BY USER AREAS THREE AND FOUR .GLOBL CTLP3,CTLP4,WAITB3,WAITB4 .ENDC .ENDC / FPOW=000000 /PSEUDO-FLOATING POINT INSTRUCTIONS. FADD=100000 FSUB=200000 FMPY=300000 FMUL=300000 FDIV=400000 FGET=500000 FPUT=600000 FNOR=700000 FEXT=0 FXIT=0 WORDS=3 DIGITS=11 .SCOM=100 XX=0 .EJECT .IFUND MULTI .IODEV -3,-2,3,5,7,10 TTI=776 TTO=775 BKI=3 BKO=5 AUXIN=7 AUXOUT=10 .ENDC .IFDEF MULTI .IODEV 1,2,3,4 .IFDEF USR4 .IODEV 5,6,7,10 .ENDC TTI=0 TTO=0 BKI=0 BKO=0 TTI1=1 TTO1=1 BKI1=2 BKO1=2 TTI2=3 TTO2=3 BKI2=4 BKO2=4 .IFDEF USR4 TTI3=5 TTO3=5 BKI3=6 BKO3=6 TTI4=7 TTO4=7 BKI4=10 BKO4=10 .ENDC COMEIN=0 COMOUT=0 IMBUFF=0 INBUF=0 OUTBUF=0 .ENDC /AUTO-INDEX REGISTERS AXIN=10 /STORAGE INDEX XRT=11 /EXTRA XR XRT2=12 /EXTRA XR PDLXR=13 /PUSHDOWN LIST INDEX REGISTER. FLTXR=14 /IOBUF-1 XR14 FOR FLOATING POINT X15=15 /FOR COMMON RESTORE X16=16 /FOR COMMON RESTORE / /IN THE MULTI USER SYSTEM 15 AND 16 ARE ALSO USED BY THE SWAP ROUTINES / .EJECT / /THE FOLLOWING BLOCK IS THE ENTIRE IMPURE / AREA FOR EACH FOCAL JOB / .IFDEF MULTI SWPSZE SWPBGN-SWPEND /BLOCK SIZE SWPBGN=. / RESTAR XSBEGN /RESTART ADDRESS FOR THIS JOB CTLP XX /ADDRESS OF ^P SWITCH FOR THIS USER BWAIT XX / FLAC 0 /.AA SAVE 0 /.AB SAVE 0 /.AC SAVE / FRSTSV 0 /FRST SAVE LIST31 0 /LIST3+1 SAVE / AUTOXR 0 /X10 SAVE 0 /X11 SAVE 0 /X12 SAVE 0 /X13 SAVE 0 /X14 SAVE / IMBFSV XX /BUFFER HEADER POINTERS IMBF2S XX INBFSV XX OTBFSV XX .FLINP XX /SUBROUTINE ENTRY POINTERS .XI33 XX .XOUTL XX .INPUT XX .DECON XX .DECNV XX .IMAGR XX .IMAGW XX / XX /RCAL01 XX /RCAL03 XX /WCAL01 XX /WCAL03 XX /WCAL04 XX /LBIN01 XX /LBIN1A XX /LBIN02 XX /LBIN03 XX /LBOUT1 XX /LBOUT2 XX /LBOUT3 XX /LBOUT4 XX /FILE01 XX /FILE02 XX /FILE03 .ENDC / /REENTRANT VARIABLES / BOTTOM XX /TOP OF PUSH-DOWN LIST BUFSTX XX /3 REG AREA BELOW TEXT AND VARIABLES /USED TO CONSTRUCT VARIABLES AND FILE /NAMES(FILE01 AND FILE02 CONTAIN SAME ADDR) ENDT XX /START OF TEXT STARTV XX /LAST LOCATION OF TEXT BUFR XX /NEXT LOCATION IN BUFFER (VARIABLES) LASTCV=STARTV /ADDRESS OF LAST COMMON VARIABLE FRSTCV XX /ADDRESS OF FIRST COMMON VARIABLE LASTV XX /ADDRESS OF LAST VARIABLE COMBUF COMEIN /COMMAND BUFFER START COMBOT COMOUT /AND END IMBUFP IMBUFF+2 /BUFFER DATA POINTERS INBUFP INBUF+2 OTBUFP OUTBUF+2 TEXTP=. /TEXT POINTERS AXOUT XX /OUTPUT INDEX XCTX 0 /UNPACK SWITCH GTEM 0 /UNPACK STORAGE MODBUF 0 /POINTER FOR MODIFY ENDCR 215 /LAST CHAR FOR GETC GETVCT 0 /VARIABLE COUNT SAVEOT 0 /OUTPUT CHAR PUTCNT -1 /OUTPUT COUNTER FOR HEADER PAIR TEMPK 0 /TEMP FOR PACK INSUB 0 /0= GETC; #0 = READC TTIN TTI TTOUT TTO BLKIN BKI BLKOUT BKO LIBRSW 0 /IN LIBRARY MODE .DATIN TTI .DATOUT TTO DATINS 0 /IN DATA MODE SWITCH EX1 0 AC1H 0 AC1L 0 OVER1 0 OVER2 0 OTEMP=OVER1 LTEMP=AC1L HTEMP=AC1H FISW 10 GETP 0 /ASCII STRING POINTER GETCX 0 /CHAR COUNTER (2'S COMP) GET1X 0 /TEMP GET2 0 /TEMP GET3 0 /TEMP PUTP 0 /ASCII STRING POINTER PUTC 0 /CHAR COUNTER PUT6 0 /TEMP SORTCN 0 /NUMBER IN TABLE FROM SORTC LASTOP 0 /LAST OPERATION FOR EVAL EFOP=. /FUNCTION CODE. ATSW 0 /ASK-TYPE CODE. CNTR -20 /DELETE AND ERROR COUNTER(USED BY F.P. ALSO) DECP 4 /NUMBER OF DECIMAL POINTS ADD XX /CHAR. BUF. IN. (DEBUG AIDS.SEE BELOW.) XCTIN XX /PACK SWITCH 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 PC FRSTA /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 T1 0 /TEMPORARY REGISTER - MAIN T2 0 /TEMP REGISTER - FOR NEW INST. ROUTINES. SACH 0 /SEARCH CHAR STORAGE FLARG 0 /DATA TEMPORARY STORAGE 0 0 FLARG2 0 0 0 .IFDEF MULTI SWPEND=. .ENDC / /NON-REENTRANT VARIABLES / BOX 0 /FOR DIGIT PRINT ER2T 0 /ERROR TEMP ERR2CT 0 /ERROR COUNT OP . XX /VARIABLE NAME (.SIXBT) .SIXBT /()=/ RANPT 0 /PUSEDO RANDOM POINTER FRST 0 /TEXT POINTER FRSTA 0 /DUMMY LINE NUMBER .IFUND PDP9 .IFUND PDP15 .SIXBT /C FOCAL XVM V1A000/<77><15> /(MH-026) .ENDC .ENDC .IFDEF PDP9 .IFUND PDP15 .SIXBT /C FOCAL XVM V1A000/<77><15> /(MH-026) .ENDC .ENDC .IFDEF PDP9 .IFDEF PDP15 .SIXBT /C FOCAL XVM V1A000/<77><15> /MJH 28 .ENDC .ENDC SIGN2 0 /TEMP SIGN SCOUNT 0 PLCE=. FCOUNT 0 TEMPO 0 REMAIN 0 DIGIT 0 /DIGIT STORAGE (CURRENT) ISIGN 0 /0=MINUS,-1=PLUS DNUMBR 0 /NUMBER OF DIGITS BEXP 0 SEXP 0 /DECIMAL EXPONENT MODBF1=. JUMP 0 MODBF2=. JUMP2 0 ADDR 0 XY=. /TEMP FLOATING POINT FUNAME 0 /FUNCTION NAME FUNCTR 0 /FUNCTION COUNTER FUNPTR 0 /FUNCTION POINTER ARRAYN 0 /ARRAY NAME .IFDEF MULTI CLAC 0 /SAVE AC REGISTER CLAC1 0 /TEMP STORAGE REGISTERS CLAC4 0 /FOR MULTI USER CASE .ENDC / /CONSTANTS / P13 13 P17 17 C277 277 P3 3 P2 2 C100 100 C77 77 C260 260 M100 -100 C200 200 P177 177 GINC WORDS+2 CFRS FRST /DUMMY LINE ADDRESS FLARGP FLARG /DATA ADDRESS FILEXT .SIXBT /FCL/ CFRSX FLTZER /FLOATING 0 ADDRESS C306 306 C314 314 M137 -137 P337 337 C1=. FLTONE 000001 /FLOATING 1.0 200000 FLTZER 000000 /FLOATING 0.0 000000 000000 P40 40 C140 140 M140 -140 FOCAL9 6002 0 .IFUND PDP9 .IFUND PDP15 .SYSID < .ASCII /FOCAL >,<000/<015>> .ENDC .ENDC .IFDEF PDP9 .IFUND PDP15 .ASCII /FOCAL9 V3A000/<15> /(EK-025) .ENDC .ENDC .IFDEF PDP9 .IFDEF PDP15 .SYSID < .ASCII /BFOCAL >,<000/<015>> .ENDC .ENDC CEX1 EX1-1 RND2 DIGITS+1 BUFST BUFFER-1 C144 144 M144 -144 TEN 000004 /FLOATING 10.0 240000 000000 P43 43 INDRCT 20000 MASK7 17777 C7 7 TABLE JMP* ITABLE OPTABL OPTABS .EJECT / /SUBROUTINE CONVENTIONS / /1)USE AC OR 'CHAR' ON ENTRY / SORTJ / PRINTC /2)USE 'CHAR' ONLY ON ENTRY / PACKC / SORTC / SPNOR / TESTN / TESTC /3)RETURN WITH 'CHAR' IN AC / READC / GETC / PACKC / SPNOR / SORTC / PRINTC / TESTC / INPUT /4)USE AC ONLY ON ENTRY / DECON / .EJECT /NEW INSTRUCTIONS: .DEFIN PUSHJ,A JMS XPUSHJ /RECURSIVE SUBROUTINE CALL A .ENDM .DEFIN POPA LAC* PDLXR /RESTORE AC .ENDM .DEFIN POPJ JMP XPOPJ /SUBROUTINE RETURN .ENDM .DEFIN PUSHA JMS XPUSHA /SAVE AC .ENDM .DEFIN PUSHF,A JMS PD2 /SAVE GROUP OF DATA A .ENDM .DEFIN POPF,A JMS PD3 /RESTORE GROUP A .ENDM .DEFIN GETC JMS UTRA /UNPACK A CHARACTER .ENDM .DEFIN PACKC JMS PACBUF /PACK A CHARACTER .ENDM .DEFIN SORTJ,A,B JMS SORTB /SORT AND BRANCH ON AC OR CHAR A-1 B-A .ENDM .DEFIN SORTJX,A /SORT + BRANCH ON COMMAND JMS XSORTX A-1 .ENDM .DEFIN SORTC,A JMS XSORTC /SORT CHAR A-1 .ENDM .DEFIN PRINTC JMS XOUTL /PRINT AC OR CHAR .ENDM .DEFIN READC JMS XI33 /READ KSR-33/35 INTO CHAR .ENDM .DEFIN PRNTLN JMS XPRNT /PRINT C(LINENO) .ENDM .DEFIN GETLN JMS XGETLN /UNPACK AND FORM A LINENUMBER .ENDM .DEFIN FINDLN JMS XFIND /SEARCH FOR A GIVEN LINE .ENDM .DEFIN ENDLN JMS XENDLN /INSERT LINE POINTERS .ENDM .DEFIN RTL6 JMS XRTL6 /ROTATE LEFT SIX .ENDM .DEFIN SPNOR JMS XSPNOR /IGNORE SPACES .ENDM .DEFIN TESTN JMS XTESTN /PERIOD; OTHER; NUMBER .ENDM .DEFIN TSTLPR JMS LPRTST /SKIP IF 5 13 C254 254 /, 14 C273 273 /; 15 215 /CR 16 C275 275 /= 17 / /CONTROL TABLE FOR ASK/TYPE OPERATIONS / ATLIST JMP TINTR JMP TQUOT JMP TCRLF JMP TCRLF2 JMP TDUMP JMP TASK4 JMP TASK4 JMP PROCES JMP PC1 / ALIST 245 /% - FLOATING FORMAT C242 242 /" - LITERAL 241 /! - CR AND LF 243 /# - CR ONLY 244 /$ - SYMBOL DUMP GLIST 240 /SPACE - END NAMES TLIST 254 /, - END EXPRESSIONS TLISTX 273 /; - END COMMANDS 215 /C.R. - END STRINGS / /DISPATCH TABLES FOR IF AND COMMON STATEMENTS / ILIST JMP IF1 /, JMP PROCES /; JMP PC1 /CR / FLIST2 JMP FLIMIT /, JMP FINFIN /; ERROR 11 /CR / FLIST1 JMP FINCR /, JMP PROCES /; JMP PC1 /CR / CLISTX JMP COMMON-1 /, JMP PROCES /; JMP PC1 /CR / /CONTROL TABLE FOR MODIFY OPERATION / LIST6 225 /^U - KILL LINE C375 375 /ALTMODE - NEXT OCCURANCE OF SEARCH CHAR. 207 /BELL - NEW SEARCH CHAR C212 212 /L.F. - END LINE SAVING REST C377 377 /RUBOUT - DELETE LAST CHAR LIST3=. CCR=. C215 215 /C.R. - END LINE DELETING REST 000 /SEARCH CHAR / SRNLST JMP SBAR /^U JMP SCHAR /F.F. JMP SCONT /BELL JMP SCONTX /L.F. JMP SCRUB /RUBOUT LISTGO JMP SRETN /CR JMP SFOUND /SEARCH CHAR / .EJECT .IFDEF MULTI / /THIS CODE CONTROLS THE MULTI-USER PROCESSING / OF TWO OR FOUR CONCURENT FOCAL USERS. / BUFFER=. MSTART LAC* (.SCOM+2 DAC T1 JMS TWOS TAD* (.SCOM+3 /GET SIZE CLL!RAR /DIVIDE BY TWO OR FOUR .IFDEF USR4 CLL!RAR .ENDC DAC ENDT /AMT FOR EACH /DETERMINE IF BG OR FG IN BF ENVIRONMENT /.SCOM+26 = 0 IF FG, = 1 IF BG LAC* (.SCOM+26 SNA JMP FGBY LAC BG1 .IFDEF USR4 DAC SCANQ /SET PROCESSING LOOP TO BYPASS IDLEC JMP FGBY .ENDC DAC WAIT3 FGBY LAC T1 /GO INITIALIZE REGS DAC* BUF1 DAC* FILA1 DAC* FILB1 DAC* FILC1 TAD (3 DAC* ENDT1 DAC* ENDT1A DAC* ENDT1C DAC* ENDT1D LAW -1 TAD T1 TAD ENDT DAC* BOT1 TAD C1 DAC T1 DAC* BUF2 DAC* FILA2 DAC* FILB2 DAC* FILC2 TAD (3 DAC* ENDT2 DAC* ENDT2A DAC* ENDT2C DAC* ENDT2D LAC (XSBEGN DAC* AREA1 DAC* AREA2 LAW -1 TAD T1 TAD ENDT DAC* BOT2 .IFDEF USR4 TAD C1 DAC T1 DAC* BUF3 DAC* FILA3 DAC* FILB3 DAC* FILC3 TAD (3 DAC* ENDT3 DAC* ENDT3A DAC* ENDT3C DAC* ENDT3D LAW -1 TAD T1 TAD ENDT DAC* BOT3 TAD C1 DAC T1 DAC* BUF4 DAC* FILA4 DAC* FILB4 DAC* FILC4 TAD (3 DAC* ENDT4 DAC* ENDT4A DAC* ENDT4C DAC* ENDT4D LAC (XSBEGN DAC* AREA3 DAC* AREA4 LAW -1 TAD T1 TAD ENDT DAC* BOT4 .ENDC .INIT TTO1,1,CP1+400000 .INIT TTO2,1,CP2+400000 .IFDEF USR4 .INIT TTO3,1,CP3+400000 .INIT TTO4,1,CP4+400000 .ENDC .WRITE TTO1,2,FOCAL9,40 .WRITE TTO2,2,FOCAL9,40 .IFDEF USR4 .WRITE TTO3,2,FOCAL9,40 .WRITE TTO4,2,FOCAL9,40 .ENDC JMP WAIT1 CTLP1 0 CTLP2 0 .IFDEF USR4 CTLP3 0 CTLP4 0 .ENDC CP1 0 ISZ CTLP1 .RLXIT CP1 CP2 0 ISZ CTLP2 .RLXIT CP2 .IFDEF USR4 CP3 0 ISZ CTLP3 .RLXIT CP3 CP4 0 ISZ CTLP4 .RLXIT CP4 .ENDC .EJECT /MAIN PROCESSING LOOP WAIT1 .WAITR TTI1,WAIT2 WAITB1 .WAITR TTI1,WAIT2 LAC AREA1 JMS RUN WAIT2 .WAITR TTI2,WAIT3 WAITB2 .WAITR TTI2,WAIT3 LAC AREA2 JMS RUN .IFUND USR4 WAIT3 NOP /WILL BE JMP WAIT1 IN 2 USER CASE .ENDC .IFDEF USR4 WAIT3 .WAITR TTI3,WAIT4 WAITB3 .WAITR TTI3,WAIT4 LAC AREA3 JMS RUN WAIT4 .WAITR TTI4,SCANQ WAITB4 .WAITR TTI4,SCANQ LAC AREA4 JMS RUN .ENDC SCANQ CAL /NO - GIVE BGD SOME TIME /SCANQ WILL CONT. JMP WAIT1 IN CASE OF 4USER 14 IDLE+700000 -12 CAL+1000 /.IDLEC ROUTINE WILL BYPASS THIS ON 17 /TIMER OVERFLOW CAL+1000 14 IDLE+700000 0 BG1 JMP WAIT1 /GO SEE IF ANYTHING DONE NOW / .EJECT /RUN INITIALIZATION RUN 0 TAD M1 DAC NEWUSR /CHECK FOR SAME USER SAD CURUSR /? JMP RESTAX /YES - NO SWAP LAC (MVSZE /SET TO SAVE INLINE DAC* (16 /TEMPORARIES LAC (BWAIT DAC* (17 LAC NEWUSR TAD P3 /AREA+2 DAC* (15 LAC MVSZE DAC RUNCT RUN1 LAC* 16 /SAVE REGS LOOP DAC RUNTP LAC* RUNTP DAC* 17 LAC* 15 /STORE TEMPS BEFORE SWAP DAC* RUNTP ISZ RUNCT JMP RUN1 LAC CURUSR /SWAP USERS INITIALIZATION DAC* (16 LAC NEWUSR DAC* (17 DAC CURUSR LAC (SWPBGN DAC RUNTP LAC SWPSZE DAC RUNCT RUN2 LAC* RUNTP /NOW DO SWAP DAC* 16 LAC* 17 DAC* RUNTP ISZ RUNTP ISZ RUNCT JMP RUN2 RESTAX CAL 14 TIME+700000 -12 DZM DELAY /NEED EXTRA LEVEL OF INDIRECTION SINCE USER AREAS(PURE) / ARE NOW EXTERNAL LAC* CTLP DAC CLAC1 LAC* CLAC1 SZA JMP RECOVR JMP* RESTAR /GO START UP USER /I/O BUSY OR OUT OF TIME RETURNS HERE IOBUSY 0 LAC .-1 /GET RETURN PC DAC RESTAR .IFDEF BF CAL+1000 /CLEAR OUT CALL FOR TIME 14 TIME+700000 0 .ENDC JMP* RUN / RUNTP 0 RUNCT 0 DELAY 0 / TIME 0 /SET DELAY ON OVERFLOW ISZ DELAY .RLXIT TIME / IDLE 0 /FORCE RETURN TO FGD .RLXIT IDLE / .EJECT / /COMMUNICATION BLOCK / CURUSR SWPBGN-1 /CURRENT USER AREA-1 NEWUSR 0 /NEW USER AREA-1 / /SPECIAL POINTERS FOR SAVE/RESTORE / MVSZE .+1-MVEND FLAC14 XX /.AA FLAC15 XX /.AB FLAC16 XX /.AC FRST LIST3+1 10 11 12 13 14 IMBF01 IMBF02 INBF01 OTBF01 FLINTP XI33 XOUTL INPUT DECON DECONV IMAGER IMAGEW RCAL01 RCAL03 WCAL01 WCAL03 WCAL04 LBIN01 LBIN1A LBIN02 LBIN03 LBOUT1 LBOUT2 LBOUT3 LBOUT4 FILE01 FILE02 FILE03 MVEND=. .ENDC START LAC FRSTCV SAD LASTCV /ANY COMMON? JMP STARTQ /NO - GO RESET POINTERS LAC MOVCOM SZA!CLA LAC C100 DAC T1 LAC FRSTCV TAD M1 TAD T1 DAC* (X15 LAC BUFR /SETUP NEW COMMON START DAC FRSTCV TAD M1 DAC* (X16 STARTL LAC T1 JMS TWOS TAD* (X15 SAD LASTCV /ANY MORE COMMON? JMP STARTC /NO LAC* X15 /YES - MOVE REG DAC* X16 JMP STARTL STARTC LAC* (X16 /SET NEW LAST ADDR JMP STARTB STARTQ LAC BUFR DAC FRSTCV STARTB DAC LASTCV DAC LASTV /AND VARIABLE POINTERS STARTZ ISZ DEBGSW /DISABLE TRACE FOR INPUT DZM MOVCOM LAC COMBOT /PROTECT COMMAND BUFFER DAC* (PDLXR ISZ DMPSW /INIT UNPACK AND TRACE SWITCH DZM LIST3+1 /CLEAR SEARCH CHARACTER FOR INPUT LAC RCAL01 /IS INPUT TTY IN? AND (777 SAD TTIN SKP JMP IBAR /DON'T PRINT * LAC WCAL01 AND (777 SAD TTOUT /MAKE SURE TTY OUT JMP IBARX LAC C252 /IF NOT TTY OUT USE IMAGE MODE JMS IMAGEW JMP IBAR IBARX LAC C252 /ANNOUNCE PRESENCE PRINTC LAC C375 PRINTC IBAR LAC COMBUF /INITIALIZE COMMAND BUFFER. DAC* (AXIN DZM XCTIN LAC CFRSX DAC PC IGNOR READC /READ COMMAND STRING SAD C215 JMP IRETN PACKC /SAVE STRING CHARACTER. JMP IGNOR ///// IRETN PACKC / PACK C.R. ISZ PC LAC COMBUF /INITIALIZE "TEXTP" GONE TAD C1 DAC AXOUT /SETUP CURRENT LINE M1 LAW -1 DAC XCTX GETC /READ FIRST CHARACTER. LAC BOTTOM /INIT PUSH-DOWN-LIST DAC* (PDLXR SPNOR TESTN /DOES THE LINE BEGIN WITH 1-9? ERROR 1 SKP JMP INPUTX /YES DZM DEBGSW /ENABLE TRACE DZM LINENO PUSHJ PROC /PROCESS IMMEDIATE COMMAND. LAC* PC /CHECK NEXT LINE (X-MEM) SNA /END OF PROGRAM? JMP STARTZ /YES DAC PC /SAVE NEW LINE NO. TAD C1 /START NEW LINE JMP GONE /PROCESS OTHER COMMANDS ///// INPUTX GETLN /READ THIS LINE NUMBER LAC NAGSW SMA!CLA /TEST FOR SINGLE LINE ERROR 2 JMS MOVCOM /OFFSET COMMON LAC BUFR /SET POINTERS DAC* (AXIN DZM XCTIN LAC LINENO /SAVE LINE # DAC* AXIN /(X-MEM) SKP!CLA GETC /READ 1ST AFTER LINENO TERMINATOR. PACKC /SAVE SPACE AND OTHERS - RESTORE DATA FIELD SAD C215 /TEST FOR END SKP JMP .-4 PUSHJ DELETE /REMOVE OLD LINE, IF ANY. ENDLN /INSERT NEW LINE JMP START .EJECT /TEXT LINE BUFFER FORMAT* /#1 : POINTER OR ZERO IN LAST /#2 : LINENO /#3 - #N+1 : TEXT /#N : C.R. XGETLN 0 /DEVELOP I.D. - "GETLN" SPNOR /IGNORE LEADING ZEROS AND SPACES. TESTN NOP JMP TESTA DZM INSUB /CALL 'GETC' FROM 'INPUT' FROM 'DECON' DZM* .AB DZM* .AC DZM OVER2 JMS DECON LAC OVER2 RTL6 RAL DAC LINENO AND P177 /GROUP TOO LARGE SZA!CLA ERROR 3 /YES LAC* .AC SZA ERROR 3 /GROUP TOO LARGE TESTN /TEST3 GETC /READ STEP NUMBER. /OTHER TESTN /TEST4 ERROR 5 /DOUBLE PERIODS JMP GEXIT /OTHER CLL /NUMBER *12 RTL TAD SORTCN RAL TAD LINENO DAC LINENO GETC /GET FINAL DIGIT TESTN /TEST5 ERROR 5 /MULTIPLE PERIODS JMP GEXIT /OTHER TAD LINENO DAC LINENO GETC /TEST FOR CORRECT TERMINATOR TESTN /TEST6 - I.E. NOT A NUMBER OR "." SKP JMP GEXIT ERROR 6 /TOO LARGE A LINE NUMBER. TESTA LAC CHAR SAD C242 JMP LBTEXT DZM LINENO SORTC GLIST JMP GEXIT LAW -11 JMS FETVAR LAC* BUFSTX SNA JMP GEXIT SORTJX ALLCM1 ERROR 23 GEXIT LAC LINENO /TEST FOR GROUP NUMBER. AND P177 SZA!CLA!CLL CML TAD LINENO AND P7600 SNA!CLA TAD P2 RAR DAC NAGSW JMP* XGETLN /RANGE OF ACCEPTIBLE LINE NUMBERS = 1.01 TO 99.99 /NAGSW: /GROUP=000000 /LINE=400000 /ALL=000001 XRTL6 0 /ROTATE AC LEFT SIX - "RTL6" CLL RTL RTL RTL JMP* XRTL6 .EJECT /RECURSIVE OPERATE, EXECUTE, OR CALL DO GETLN /EXECUTE ONE LINE, A GROUP,OR ALL LAC PC /SAVE ADDRESS PUSHA /OF CURRENT LINE PUSHF TEXTP /SAVE REST OF THIS LINE DGRP PUSHF NAGSW /SAVE NAGSW; CHAR; AND LINENO. LAC NAGSW /CHECK DATA FROM GETLN. SPA!CLA /SKIP IF GROUP OR ALL JMP ONE /DO ONE LINE FINDLN /INIT FOR GROUP AND SET THISLN JMP TGRP2 DGRP1 PUSHJ PROCES-2 /EXECUTE OBJECT LINE AND SET PC. POPF NAGSW /RESTORE THE DATA LAC* PC /CHECK FOR END OF TEXT (X-MEM) SNA JMP DCONT /ALL DONE TAD C1 DAC PT1 /SAVE POINTER TO LINENO LAC NAGSW /CHECK FOR GROUP SMA!SZA!CLA JMP .+4 /DO ALL TAD* PT1 /TEST GROUP (X-MEM) TSTGRP JMP DCONT /NOT IN GROUP LAC* PT1 /READ NEXT LINE NO. (X-MEM) DAC LINENO JMP DGRP /CONTINUE THE SUBROUTINE ///// ONE FINDLN /FIND THE LINE ERROR 7 PUSHJ PROCES /EXECUTE IT LPROCS=.-1 POPF NAGSW /RESTORE CHAR DCONT POPF TEXTP /RESTORE TEXT POINTERS POPA /RESTORE ADDRESS OF CURRENT LINE. DAC PC JMP PROC /CONTINUE PROCESSING THIS LINE. /////// TGRP2 LAC THISLN /TEST FOR GOOD GROUP NUMBER. DAC* (XRT LAC* XRT TSTGRP ERROR 8 JMP DGRP1 .EJECT /PUSHDOWN LIST CONTROLS XPUSHA 0 /PUSHDOWN THE AC - "PUSHA" DAC T2 /BACKUP POINTER CLA!CMA /AND THEN JMS PCHK /CHECK CORE USAGE LAC T2 /OK DAC* PDLXR /PUSH DOWN LIST POINTER CLA!CMA /BACKUP AGAIN JMS PCHK LAC T2 JMP* XPUSHA PCHK 0 TAD* (PDLXR /INC IN AC DAC* (PDLXR JMS TWOS CLL TAD LASTV SZL!CLA ERROR 9 /STORAGE FILLED BY PUSH-DOWN LIST JMP* PCHK XPUSHJ 0 /RECURSIVE SUBROUTINE CALL - "PUSHJ" LAC* XPUSHJ DAC T2 /SAVE SUBR. ADDR. CLA!CMA JMS PCHK TAD XPUSHJ TAD C1 DAC* PDLXR /SAVE RETURN CLA!CMA JMS PCHK JMP* T2 /TRANSFER CONTROL PD2 0 /SAVE A FLOATING POINT NUMBER - "PUSHF" CLA!CMA /COMPUTE VARIABLE ADDR TAD* PD2 DAC* (XRT ISZ PD2 /FIX RETURN MFLT LAW -WORDS /COMPUTE PUSH. POINTER DAC T2 JMS PCHK LAC* XRT /(X-MEM) DAC* PDLXR ISZ T2 JMP .-3 LAC MFLT /RESET POINTER JMS PCHK JMP* PD2 PD3 0 / RESTORE A FLOATING POINT NUMBER - "POPF" CLA!CMA /GET VAR. ADDR. TAD* PD3 ISZ PD3 DAC* (XRT LAC MFLT DAC T2 LAC* PDLXR /MOVE DAC* XRT ISZ T2 JMP .-3 JMP* PD3 /EXIT ///// MOVCOM 0 /MOVE COMMON AREA LAC FRSTCV SAD LASTCV /ANY COMMON? JMP* MOVCOM /NO DAC MODBUF LAC LASTCV DAC T2 /CURRENT END TAD C100 DAC T1 /NEW END JMS TWOS TAD* (PDLXR SPA /OVERFLOW ERROR 16 MOVUPX LAC* T2 /MOVE BLOCK DAC* T1 LAC T2 /IS IT AT END? SAD MODBUF JMP* MOVCOM /YES - EXIT TAD M1 /NO - BACKUP POINTERS DAC T2 LAC T1 TAD M1 DAC T1 JMP MOVUPX / .EJECT /PRIMARY CONTROL AND TRANSFER GOTO GETLN /READ THE LINE NUMBER REQUESTED FINDLN /LOCATE IT AND RESET TEXTP ERROR 7 /NOT THERE LAC THISLN /SET PC DAC PC PROCES GETC /TEST FOR END OF LINE PROC=. .IFDEF MULTI LAC DELAY SZA JMS IOBUSY .ENDC LAC C273 DAC TLISTX /RESET IN CASE ENTRY FROM COMMON STMT LAC CHAR /FIRST CHARACTER READY = USE PROC SAD C215 PC1 POPJ /EXIT "PROCESS" SORTC GLIST /IGNORE "SPACE",",", AND ";". JMP PROCES .IFUND MULTI LAC DATINS /IN DATA MODE? SZA JMP DAT1 /YES .ENDC LAC LIBRSW RAL LAC CHAR SAD C314 JMP .+3 SZL DATE ERROR 31 .IFUND MULTI JMP DAT2 /CONTINUE DAT1 LAC CHAR /IF IN DATA MODE, MAKE LIBR. COMMANDS SAD C314 /ILLEGAL JMP DATE .ENDC DAT2 LAW -11 JMS FETVAR /GET COMMAND (3 WORDS) SORTC GLIST SKP ERROR 10 SORTJX COMLST /GO DO COMMAND ERROR 10 /ILLEGAL COMMAND .EJECT ///// COMMEN=PC1 /IS CONTINUE OR COMMENT /OUTPUT COMMAND TEXT WRITE GETLN /SET LINENO ISZ DEBGSW /DISABLE TRACE (ALWAYS DURING WRITE) FINDLN /SEARCH FOR LINE NUMBER JMP WTESTG /NOT THERE OR GROUP LAC LINENO SZA!CLA JMP .+4 LAC C215 PRINTC SKP PRNTLN /PRINT LINE NUMBER GETC PRINTC /PRINT TEXT OF A LINE. SAD C215 SKP /SKIP IF END OF LINE JMP .-4 LAC* THISLN /TEST FOR END OF TEXT (X-MEM) WTEST2 SNA JMP WRITED /EXIT;DO NEXT INDIRECT LINC. TAD C1 DAC PT1 /SAVE POINTER TO LINENO OF NEXT (X-MEM) LAC NAGSW SMA!CLA TAD* PT1 /(X-MEM) TSTGRP /TRY NEXT LINENO FOR GROUP. JMP WX WALL LAC* PT1 /SET LINENO (X-MEM) DAC LINENO JMP WRITE+2 /// WTESTG LAC THISLN /INIT GROUP PRINTOUT JMP WTEST2 ///// WX LAC NAGSW SMA!SZA!CLA /SKIP IF NOT ALL JMP WALL WRITED LAC C215 PRINTC POPJ LPOPJ=.-1 .EJECT ///// XTESTC 0 /TEST THE NATURE OF THE NEXT ALPHANUMERIC - "TESTC" SPNOR /IGNORE SPACES AND ZEROS HERE SORTC TERMS /TEST THE VARIABLE TERMINATOR FOR EVAL JMP XTESTX /YES - SORTCN IS SET ISZ XTESTC SAD C306 /TEST FOR "F" JMP XT3 TESTN /TEST FOR . OR 0-9 JMP XTESTX SKP JMP XTESTX ISZ XTESTC XT3 ISZ XTESTC /RETURNS:T;N;F;A XTESTX LAC CHAR JMP* XTESTC XSORTC 0 /SORT CHAR AGAINST TABLE - "SORTC" LAC* XSORTC DAC* (XRT2 /1ST ARG IS LIST-1 LAC* XRT2 SPA /LIST IS ENDED BY A NEGATIVE NUMBER JMP SEXC /2AND EXIT = NOT IN LIST SAD CHAR SKP /COMPARE JMP .-5 LAC* XSORTC /COMPUTE INCREMENT : 0 - N CMA TAD* (XRT2 DAC SORTCN SKP /1ST EXIT = YES SEXC ISZ XSORTC ISZ XSORTC LAC CHAR JMP* XSORTC GRPTST 0 /AC VS LINENO - "TSTGRP" AND P7600 JMS TWOS DAC T2 P7600 LAW 17600 AND LINENO TAD T2 SNA!CLA ISZ GRPTST JMP* GRPTST .EJECT /CONDITIONAL TRANSFER PROCESS. GETC /IF (EXP) A,B,C; IF LAC CHAR SAD C240 JMP IF-1 SAD C250 SKP ERROR 11 /NO SPACE AFTER IF OR ILLEGAL FORMAT. PUSHJ EVAL-1 /EVALUATE EXPRESSION GETC /MOVE PAST ")" M2 LAW -2 DAC T1 LAC FLARG+1 /TEST -,0,+ SPA ISZ T1 /TO -1,-2,-3 SPA!SNA!CLA IF3 ISZ T1 /COUNT COMMAS SKP JMP GOTO /TRANSFER SORTJ TLIST,ILIST /SEARCH TEXT UNTILL ,;C.R. GETC JMP .-4 IF1 GETC /MOVE PAST JMP IF3 .EJECT ///// /LOOP CONTROL STATEMENT SET=. /SUBSET OF "FOR". FOR PUSHJ GETARG /LOOPS, ETC. SPNOR /IGNORE SPACES SAD C275 SKP ERROR 12 /LEFT OF "=" IN ERROR: 'FOR' OR 'SET' LAC PT1 PUSHA /SAVE POINTER TO VARIABLE PUSHJ EVAL-1 /GET INITIAL VALUE EXPRESSION POPA DAC PT1 JMS FINT /INITIALIZE NOW. FGET FLARG FPUT* PT1 FXIT SORTJ TLIST,FLIST1 /TEST LAST CHAR FROM "EVAL" ERROR 13 /EXCESS R-PAR ///// FINCR LAC LPROCS /SET OPERATION DAC FPUSHJ LAC LPOPJ /SET EXIT DAC FPOPJ FINCRX LAC PT1 /SAVE VARIABLE ADDRESS * PUSHA PUSHJ EVAL-1 /EVALUATE THE INCREMENT,IF ANY. SORTJ TLIST,FLIST2 /TEST TERMINATORS ERROR 14 ///// FLIMIT PUSHF FLARG /SAVE THE INCRE. * PUSHJ EVAL-1 /GET THE LIMIT FCONT PUSHF FLARG /SAVE THE LIMIT * PUSHF TEXTP /SAVE TEXT OF OBJECT STATEMENTS PUSHJ PROCES /DO THE OBJECT STATEMENTS FPUSHJ=.-1 POPF TEXTP /RESTORE REMAINING TEXT. POPF FLARG /GET LIMIT POPF FLARG2 /GET INCREMENT POPA /GET VARIABLE ADDRESS DAC PT1 JMS FINT /INCREMENT AND TEST FGET* PT1 /LOAD THE VARIABLE FADD FLARG2 /INCREMENT IT FPUT* PT1 /CHANGE IT FSUB FLARG /TEST IT FXIT GETSGN SMA!SZA!CLA POPJ /END OF LOOP FPOPJ=.-1 LAC PT1 PUSHA /SAVE ADDRESS * PUSHF FLARG2 /SAVE INCREMENT AGAIN * JMP FCONT ///// FINFIN PUSHF FLTONE /SET INCREMENT TO ONE. JMP FCONT .EJECT GETC COMMON LAC STARTV /CHECK FOR LEGALITY SAD LASTV /OF COMMON STATEMENT SKP JMP COMMEN /NOT LEGAL - COMMENT SPNOR /OK SAD C250 /IS IT LEFT PAREN JMP COMARY /YES - PROCESS ARRAY PUSHJ GETARG /NO - NORMAL VARIABLE COMMX SPNOR LAC LASTV /SET END OF COMMON DAC LASTCV LAC CHAR SORTJ TLIST,CLISTX /CHECK FOR TERMINATOR ERROR 37 /FORMAT ERROR COMARY GETC TESTC /CHECK FIRST CHAR NOP NOP ERROR 15 /FORMAT ERROR LAW -3 /GET WHOLE VARIABLE JMS FETVAR /NAME LAC CHAR SAD C254 /MUST BE A COMMA SKP ERROR 37 /FORMAT ERROR LAC* BUFSTX /GET VARIABLE NAME DAC ARRAYN PUSHJ EVAL-1 /SKIP COMMA AND EVALUATE JMS FINT FGET FLARG FPUT XY FXIT LAC LITX /USE X AS COUNTER DAC PT1 LAC C251 /SET TERMINATOR DAC TLISTX LAC (COMDEC /SET OPERATION DAC FPUSHJ LAC (JMP COMEND /SET EXIT DAC FPOPJ JMP FINCRX /GO PROCESS ARRAY DEF COMDEC LAC ARRAYN /GET NAME DAC* BUFSTX JMS* .AO /GET COUNTER LITX XY JMP GS1A COMEND LAC LASTV DAC LASTCV LAC CHAR SAD C251 /LAST PAREN? JMP COMMX /YES ERROR 37 /NO - FORMAT ERROR / .EJECT /INPUT-OUTPUT STATEMENTS ASK SKP!CLA!CMA /REMEMBER WHICH CALL. (-1) FOR ASK TYPE CLA /0 FOR TYPE DAC ATSW TASK DZM DEBGSW /RE-ENABLE THE TRACE CLA SORTJ ALIST,ATLIST /SPECIAL CHARACTER? ISZ ATSW /TEST QUOTE SWITCH JMP TYPE2 PUSHJ GETARG /DO ASK; SETUP PT1 LAC LBIN01 /INPUT FROM TT SAD TTIN SKP JMP ASK2 /DON'T T : LAC LBOUT2 SAD TTOUT SKP JMP ASK2 /DON'T T : LAW 272 /TYPE COLON PRINTC LAC C375 PRINTC ASK2 LAC CHAR PUSHA /SAVE IN-LINE CHARACTER ISZ INSUB /INDICATE 'READC' LAC C215 DAC ENDCR LAC C1 /POINT PAST CHAR JMS FLINTP /READ DATA AND SAVE LAC C215 DAC ENDCR POPA /RE-TEST LAST TERMINATOR DAC CHAR JMP ASK /CONTINUE PROCESSING //// TYPE2 PUSHJ EVAL /DO TYPE JMS FLOUTP /PRINT SORTC GLIST JMP TYPE ERROR 4 ///// TQUOT ISZ DEBGSW /DISABLE TRACE GETC /TYPE LITERALS SAD C242 /" JMP TASK4 SAD C215 /CR JMP PC1 PRINTC JMP TQUOT+1 ////// TCRLF LAC CCR /SLASH=CR,LF. PRINTC TASK4 GETC /MOVE TO NEXT CHARACTER JMP TASK //// TCRLF2 LAC C375 PRINTC LAC C215 JMS IMAGEW LAC C200 JMS IMAGEW JMP TASK4 /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 GETLN /READ FORMAT CONTROL: "%7.03" LAC LINENO AND C77 DAC DECP LAC LINENO RAR RTR RTR RTR AND C77 DAC FISW JMP TASK .EJECT //// /SEARCH ROUTINES MODIFY GETLN /READ LINE NO. FINDLN /LOOK IT UP NOW. ERROR 7 /NOT THERE = BAD COMMAND UNLESS ZERO. JMS MOVCOM /DISPLACE COMMON LAC BUFR /SET POINTERS DAC* (AXIN /FOR INPUT DZM XCTIN LAC LINENO /COPY THE SAME LINE NUMBER. SNA /CHECK FOR ALL ERROR 7 DAC* AXIN /(X-MEM) LAC* (AXIN /SAVE START OF NEW LINE DAC PACKST LAC COMBUF DAC MODBUF /SET MODIFY COMMAND BUFFER SCONT JMS IMAGER /GET SEARCH CHAR SKP SCONTX CLA /CLEAR SEARCH CHAR DAC SACH /SAVE SEARCH CHARACTER ISZ DEBGSW /NO BREAKS. SCHAR LAC SACH DAC LIST3+1 /PUT IN "SORTJ" LIST GETC DAC CHAR /SAVE FOR SORTJ DAC* MODBUF ISZ MODBUF JMS IMAGEW SORTJ LIST3,LISTGO /LOOK FOR MATCH JMP SCHAR ///// SBAR LAW 300 /ECHO @ FOR ^U JMS IMAGEW LAC COMBUF /RESET TO BEGINNING OF BUFFER DAC MODBUF SFOUND DZM LIST3+1 JMS IMAGER /READ FROM KEYBOARD DAC CHAR SORTJ LIST6,SRNLST /CHECK FOR ACTION CHANGE LAC CHAR DAC* MODBUF /PACK CHAR ISZ MODBUF JMP SFOUND /GO GET MORE SRETN LAC C215 DAC* MODBUF /SAVE CR LAC COMBUF DAC MODBUF LAC* MODBUF /FINISH LINE AND SAVE IT DAC CHAR PACKC ISZ MODBUF SAD C215 /END LINE? SKP /YES JMP .-6 LAC C212 JMS IMAGEW PUSHJ DELETE /REPLACE WITH NEW LINE ENDLN JMP START /RESET POINTERS SCRUB LAC MODBUF SAD COMBUF /AT BEGINNING? JMP SFOUND /YES TAD M1 /NO DAC MODBUF LAW 334 /ECHO BACK SLASH JMS IMAGEW JMP SFOUND /GO PROCESS NEXT .EJECT SORTB 0 /SORT AND BRANCH ROUTINE. - "SORTJ" SNA LAC CHAR /ASSUME CHAR IF AC=0 DAC T2 /SAVE SORT ITEM LAC* SORTB /FIRST ARG IS LIST LESS ONE ISZ SORTB /2AND IS INTRA-LIST LENGTH DAC* (XRT2 LAC* XRT2 SPA /**LIST ENDED BY NEGATIVE NUMBER** JMP SEX SAD T2 /FIND ADDRESS SKP JMP .-5 LAC* (XRT2 /MATCH FOUND. TAD* SORTB DAC T2 CLA JMP* T2 SEX ISZ SORTB /MATCH NOT FOUND. CLA!CLL JMP* SORTB /RETURN TO CALLING SEQUENCE. / /SORT AND BRANCH ON COMMAND / XSORTX 0 /"SORTJX" LAC* XSORTX /GET TABLE START DAC* (XRT2 LAC* XRT2 /SET SIZE DAC T2 ANYMAT LAC BUFSTX /GET COMMAND POINTER DAC MODBF1 DZM MODBF2 MORMAT LAC* XRT2 /GET COMMAND TABLE ENTRY SAD* MODBF1 JMP ENDMAT /FULL WORD MATCH DAC SORTB /SAVE FOR END TEST AND (770000 SAD* BUFSTX JMP YESMAT /ONE LETTER MATCH JMP NOTMAT ENDMAT AND C77 /IS IT END OF COMMAND SNA JMP* XRT2 /DISPATCH ISZ MODBF1 ISZ MODBF2 /DISABLE ONE LETTER MATCH JMP MORMAT /TEST REST OF COMMAND LAC* XRT2 SKP YESMAT LAC SORTB /TEST FOR COMMAND END AND C77 SZA JMP YESMAT-2 LAC MODBF2 /ONE LETTER OK SNA JMP* XRT2 /DISPATCH NOTMAT LAC* XRT2 /SKIP REST OF COMMAND AND (700000 SAD (600000 /ENDS WITH JMP SKP JMP .-4 ISZ T2 /ANY MORE IN TABLE JMP ANYMAT /YES ISZ XSORTX /NO - ERROR RETURN JMP* XSORTX / .EJECT /FETCH VARIABLE FROM INPUT FETVAR 0 DAC GETVCT /-3 OR -6 OR -9 LAW -1 /(BUFFER-1 TAD BUFSTX DAC* (AXIN DZM XCTIN /BEGIN PACK OF VARIABLE NAME GETVAP PACKC /PACK CHAR GETC SORTC TERMS /CHECK FOR TERMINATORS JMP GETVAX ISZ GETVCT /HAVE THREE CHARS BEEN USED JMP GETVAP /NO-GO PACK THIS ONE LAW -1 /IGNORE REST DAC GETVCT JMP GETVAP+1 GETVAX ISZ GETVCT SKP!CLA JMP* FETVAR JMS PCK1 /USE NULLS JMP GETVAX /FIND OR ENTER A VARIABLE IN THE LIST. GETARG TESTC /FIRST LETTER OF ARG NOP NOP / FUNCTION OR NUMBER IS NOT AN ARG. ERROR 15 /BAD ARGUEMENT IN 'FOR', 'SET', OR 'ASK' GETVAR LAW -3 JMS FETVAR TSTLPR /LOOK FOR SUBSCRIPT VIA SORTCN JMP GS1 /NOT SUBSCRIPTED BY L-PAR. LAC LASTOP /SAVE LAST OPERATION PUSHA LAC* BUFSTX /SAVE NAME PUSHA PUSHJ EVAL-1 /MOVE PAST L-PAR AND EVALUATE SUBSCRIPT POPA DAC* BUFSTX /RESTORE NAME GETC /MOVE PAST R-PAR POPA DAC LASTOP /RECALL LAST OPERATION GS1A JMS FIX GS1 DAC SUBS /SAVE SUBSCRIPT LAC FRSTCV /SEARCH FOR VARIABLE GS3 DAC PT1 SAD LASTV /TEST FOR END OF LIST JMP GS2 /END SEARCH LAC* PT1 /GET TABLE ENTRY SAD* BUFSTX JMP GFND1 /FOUND XX GS4 LAC PT1 /TRY NEXT ONE TAD GINC JMP GS3 GS2 LAC LASTV /ADD THE VARIABLE TAD P13 /TEST RAN LIMITS CLL JMS TWOS TAD* (PDLXR SNL!CLA ERROR 16 LAC LASTV TAD GINC DAC LASTV LAC* BUFSTX /SAVE NAME DAC* PT1 ISZ PT1 /SAVE SUBSCRIPT LAC SUBS DAC* PT1 ISZ PT1 /SET PT1 JMS FINT FGET FLTZER FPUT* PT1 FXIT POPJ /EXIT //// GFND1 LAC PT1 /FOUND SAME DAC* (XRT /TEST SUBSCRIPTS LAC* XRT JMS TWOS TAD SUBS SZA!CLA JMP GS4 /WRONG SUBSCRIPT ISZ PT1 /SET POINTER TO DATA ISZ PT1 POPJ .EJECT //// ///IGNORE LEADING SPACES - "SPNOR" SUBS=. XSPNOR 0 LAC CHAR SAD C240 SKP JMP* XSPNOR GETC JMP XSPNOR+2 XTESTN 0 /RETURNS: .; OTHER; NUMBER - "TESTN" MPER LAW -256 TAD CHAR SZA!CLA ISZ XTESTN LAW -260 TAD CHAR DAC SORTCN /SAVE VALUE SPA!CLA JMP ZTESTN LAW -271 TAD CHAR SPA!SNA!CLA ISZ XTESTN /IF A NUMBER ZTESTN LAC SORTCN JMP* XTESTN /EXIT FROM A "DO" SUBROUTINE RETURX LAC CFRS /(PC) => 0 TAD C1 /TO PRETEND END OF TEXT DAC PC XPOPJ LAC* PDLXR /RECURSIVE EXIT - "POPJ" DAC T2 CLA JMP* T2 .EJECT /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 DZM LASTOP /EVAUATION CONTROLLER TESTC /TEST CHARACTER AND IGNORE SPACES JMP ETERM1 /TERMINATION JMP ENUM /NUMBER JMP EFUN /FUNCTION PUSHJ GETVAR /FIND OR CREATE VARIABLE;ALSO SET PT1. OPNEXT TESTC /PT1=>ARG JMP ETERMN /T NOP /N-ERROR IN FORMAT NOP /F ERROR 17 /L - MISSING OPERATOR ///// ETERM1 LAC CHAR SAD C275 ERROR 17 PUSHF FLTZER /INITIALIZE RESULT TO ZERO. POPF FLARG LAC FLARGP /SET PT1. DAC PT1 LAC M2 /TEST FOR UNARY OPERATIONS TAD SORTCN SNA JMP ETERM /CREATE DUMMY FOR UNARY MINUS TAD C1 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 ERROR 18 /OPERATOR MISSING BEFORE PAREN ETERM LAC SORTCN /SET FROM "TESTC"-"SORTC" DAC THISOP TAD M11 SMA!CLA /END? DAC THISOP /"THISOP" EQUIV. TO END OF EXP. ETERM2 LAC THISOP /COMPARE PRIORITIES JMS TWOS TAD LASTOP SPA!CLA JMP EPAR /CONTINUE TAD LASTOP /FIND OPERATION FROM TABLE TAD OPTABL DAC FLOP LAC* FLOP DAC FLOP LAC LASTOP SNA!CLA /TEST FOR END OF DATA INTO FLOATING AC. JMP .+3 POPF XX /GET LAST DATA FLAC1=.-1 /.AA JMS FINT FLOP 00 /(FLOPR I PT1)+-*/ FPUT FLARG /SAVE RESULT FXIT LAC FLARGP DAC PT1 LAC THISOP TAD LASTOP /=0? SNA!CLA POPJ /EXIT "EVAL" POPA /GET PRIOR OP DAC LASTOP JMP ETERM2 /COMPARE THIS OP ///// EPAR TSTLPR /TEST FOR SUB-EXPRESSION SKP JMP EPAR2 /GO EVALUATE EXPRESSION LAC LASTOP /CONTINUE READING THE EXPRESSION PUSHA /SAVE "LASTOP". LAC PT1 DAC .+2 PUSHF XX /SAVE LAST ARGUMENT LAC THISOP /MORE TO COME DAC 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 ///// ENUM PUSHF XX /TO PROCESS A NUMBER,SAVE AC FLAC2=.-1 /.AA LAC FLARGP /SET POINTER AS FOR VARIABLE. DAC PT1 DZM INSUB /POINT TO 'GETC' AND USE CHAR CLA /READ NEXT JMS FLINTP /READ TEXT NUMBER => (PT1) POPF XX /RESTORE THE AC FLAC3=.-1 /.AA JMP OPNEXT /CONTINUE ///// EFUN GETC LAW -3 JMS FETVAR /GET FUNCTION NAME LAC SORTCN /SAVE 'SORTCN','LASTOP',AND 'EFOP' PUSHA LAC LASTOP PUSHA LAC* BUFSTX /SAVE FUNCTION NAME PUSHA TSTLPR ERROR 19 /MUST BE FOLLOWED BY PARENS TO SET ARGUMENT PUSHJ EVAL-1 /YES POPA DAC FUNAME /SAVE FUNCTION NAME LAC (FNTABF JMS FUNCHK /IS IT INTERNAL FUNCTION LAC .NEWF JMS FUNCHK /IS IT EXTERNAL FUNCTION ERROR 20 /ILLEGAL FUNCTION NAME FUNCHK 0 /DISPATCH ON FUNCTION NAME DAC FUNPTR /FUNCTION TABLE START LAC* FUNPTR SMA JMP* FUNCHK DAC FUNCTR /FUNCTION TABLE COUNT FUNLOP ISZ FUNPTR /POINTS TO NEXT NAME LAC FUNAME SAD* FUNPTR /RIGHT FUNCTION? JMP FUNFND /YES - GO DISPATCH ISZ FUNPTR /NO - TRY NEXT ISZ FUNCTR /ANY MORE IN TABLE? JMP FUNLOP /YES JMP* FUNCHK /NO - RETURN FUNFND ISZ FUNPTR /TO FUNCTION ADDRESS JMP* FUNPTR /DISPATCH ///// ELPAR TSTLPR ERROR 21 /DOUBLE OPERATORS EPAR2 LAC SORTCN /LEFT PARENS FOUND. PUSHA LAC LASTOP /SAVE DATA PUSHA PUSHJ EVAL-1 /EVALUATE THE EXPRESSION RETURN .EJECT ///// /SOME MINOR FUNCTIONS XINT JMS FIX /INTEGER PART RETURN XSGN JMS* .AO /TAKE SIGN*1 OF FLARG FLTONE LAC FLARG+1 SKP XABS GETSGN /TAKE ABSOLUTE VALUE OF FLAC SPA!CLA /SKIP TO CONTINUE JMS* .BA /NEGATE THE FLOATING AC /CONTINUATION OF FUNCTION CALLS. EFUN3 POPA /RESTORE LAST OPERATION DAC LASTOP JMS* .CD /NORMALIZE FUNCTION RETURN JMS* .AP /SAVE FUNCTION VALUE FLARG LAC FLARGP /SET POINTER DAC PT1 POPA /GET LAST PAREN CODE. TAD P3 JMS TWOS /CHECK FOR PAREN MATCH. TAD SORTCN /(STILL SET FROM THE LAST "EVAL") SZA!CLA /SKIP IF MATCH ERROR 22 /PAREN ERROR GETC /MOVE PAST R-PAR, AND RETURN TO OPNEX. JMP OPNEXT /FUNTION RETURN IS OK LPRTST 0 /SKIP IF LEFT PAREN. - 'TSTLPR' M11 LAW -11 TAD SORTCN SMA!CLA JMP* LPRTST LAW -5 TAD SORTCN SMA!SZA!CLA ISZ LPRTST JMP* LPRTST .EJECT /THE DELETE A LINE ROUTINE DELETE FINDLN /SETS "THISLN" AND "LASTLN". POPJ /ALREADY GONE ISZ DEBGSW /DISABLE TRACE GETC /MEASURE LENGTH SAD C215 SKP!CLA!CMA JMP .-3 TAD AXOUT /SAVE LAST ADDRESS CMA TAD THISLN DAC CNTR /LENGTH < 0 LAC* THISLN /DISCONNECT DAC* LASTLN LAC CFRS /START LIST AT TOP DOK DAC T2 /EXAMINATION ADDRESS LAC* T2 /GET THE NEXT ADDR. SNA /TEST FOR END JMP DONE /YES-WRAP UP ALL. DAC T1 /SAVE NEXT ADDRESS. LAC THISLN /COMPARE LINE POSITIONS CLL JMS TWOS TAD T1 SZL!CLA /SKIP IF THISLN > X TAD CNTR /CHANGE (X) TO ACCOUNT FOR TAD T1 /GARBAGE COLLECTION. DAC* T2 LAC T1 /GET NEXT JMP DOK .EJECT ///// /GARBAGE COLLECTION DONE CLA!CMA /BACKUP L FOR XR TAD THISLN DAC* (XRT LAC CNTR /SETUP END OF HOSE CMA TAD THISLN DAC* (XRT2 LAC CNTR /CORRECT END OF BUFFER POINTER. TAD BUFR DAC BUFR LAC* (AXIN /COMPUTE COUNT CMA TAD* (XRT2 DAC T1 LAC* (AXIN TAD CNTR DAC* (AXIN LAC* XRT2 /SIPHON LOWER PART. DAC* XRT ISZ T1 JMP .-3 JMP DELETE /RESET 'LASTLN','THISLN', AND DATA FIELD. ///// .EJECT ERASE TESTC /TEST THE SECOND WORD, IF ANY. JMP ERVX /ERASE VARIABLES JMP ERL /LINES OR GROUPS ERROR 23 LAW -11 JMS FETVAR SORTJX ALLCM2 ERROR 23 /BAD ARG FOR ERASE. XSBEGN LAC ENDT /ERASE ALL TEXT ** DAC BUFR DZM* CFRS JMP START /POINTERS MAY BE DIFFERENT NOW. ////// ERL GETLN /ERASE LINES. LAC LINENO AND P7600 SNA ERROR 7 LAC BUFR /PROTECT REST OF TEXT. DAC* (AXIN ERG PUSHJ DELETE /EXTRACT ONE LINE ISZ THISLN LAC NAGSW SMA!CLA TAD* THISLN /(X-MEM) TSTGRP /SKIP IF G(AC) = G(LINENO) JMP START LAC* THISLN /(X-MEM) DAC LINENO JMP ERG ///// ERVX LAC STARTV /INIT VARIABLES MAY BE IN THE TEXT DAC LASTV POPJ .EJECT /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 LAC CFRS /INITIALIZE POINTERS TO FIRST LINE DAC LASTLN FINDN DAC THISLN /SAVE THIS ONE DAC* (XRT2 LAC LINENO SPA /MAX 99.99 ERROR 24 JMS TWOS TAD* XRT2 /LINENO=0 WILL ALSO BE FOUND SNA JMP FEND2 /FOUND IT. SMA!CLA JMP FEND3 /PAST IT. TAD THISLN /MOVE POINTERS DAC LASTLN LAC* THISLN SZA JMP FINDN SKP FEND2 ISZ XFIND /2ND EXIT = FOUND FEND3 LAC THISLN TAD P2 DAC AXOUT /SET "TEXTP". LAW -1 DAC XCTX .IFUND MULTI LAC DEBGSW TAD DMPSW SZA!CLA JMP* XFIND LAC SAVEOT SAD C215 SKP SAD C375 JMP .+3 LAC C375 PRINTC LAC IMBUFF+2 SAD C215 JMP .+3 LAC C215 JMS IMAGEW LAC C212 JMS IMAGEW .ENDC JMP* 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 DAC CHAR .IFUND MULTI LAC DEBGSW TAD DMPSW SZA!CLA /PRINT ONLY IF BOTH ARE ZERO. JMP UTRAX LAC SAVEOT SAD C215 SKP SAD C375 JMP .+3 LAC C375 PRINTC LAC CHAR JMS IMAGEW LAC CHAR /FIX FOR TRACE FEATURE...WAD... SAD C215 /IF CR OUTPUT LF SKP JMP UTRAX /NOT A CR. NO LF LAC C212 /OUTPUT LF JMS IMAGEW /...END OF FIX...JUNE 69 UTRAX LAC CHAR .ENDC JMP* UTRA ////// EXTR JMS GET1 CMA JMP UTE /// UTX LAC DEBGSW /TEST FOR TRACE-ENABLED SZA!CLA JMP UTXP6 TAD DMPSW /FLIP THE TRACE FLOP SNA!CLA TAD C1 DAC DMPSW JMP UTRA+1 /GET NEXT CHARACTER INSTEAD. UTXP6 TAD C277 /TRACE DISABLED = RETURN "?" JMP UTQ GET1 0 /UNPACK 6-BITS ISZ XCTX /STARTS=-1 JMP GENDX LAW -3 DAC XCTX LAC* AXOUT /NEXT WORD ISZ AXOUT DAC GTEM GENDX LAC GTEM RTL6 DAC GTEM RAL AND C77 DAC CHAR /SAVE SAD C77 JMP EXTR /EXTENDED LAW -40 TAD CHAR JMP* GET1 .EJECT XENDLN 0 /TERMINATE THE BUFFERED LINE - "ENDLN" LAC* LASTLN /SAVE OLD POINTER DAC* BUFR LAC BUFR DAC* LASTLN LAC ADD SZA DAC* AXIN LAC* (AXIN TAD C1 DAC BUFR JMP* XENDLN XPRNT 0 /PRINT A LINE NUMBER - "PRNTLN" LAC LINENO RTR RTR RTR RAR JMS PRNT LAC PER PRINTC LAC LINENO JMS PRNT JMP* XPRNT ////// PRNT 0 /PRINT TWO DIGITS AND P177 DAC VAL LAC C260 DAC BOX LAC VAL JMP .+3 ISZ BOX XYZ DAC VAL TAD M12 SMA JMP XYZ-1 LAC BOX PRINTC LAC VAL TAD C260 PRINTC JMP* PRNT .EJECT .IFUND MULTI IMBUFF 2003; 0; 0; -1 INBUF .BLOCK 60 .ASCII <15> OUTBUF 1000 .BLOCK 57 .ASCII <15> .ENDC IMAGEW 0 DAC IMAC /STORE AC FOR SORTB DAC* IMBUFP IMBF01=.+2 WCAL03 .WRITE -3,3,IMBUFF,3 .IFUND MULTI .WAIT -3 .ENDC .IFDEF MULTI JMS IOBUSY .ENDC LAC IMAC /RESTORE AC FOR SORTB JMP* IMAGEW IMAC 0 /STORAGE FOR AC IMAGER 0 IMBF02=.+2 RCAL03 .READ -2,3,IMBUFF,3 .IFUND MULTI .WAIT -2 .ENDC .IFDEF MULTI JMS IOBUSY .ENDC LAC* IMBUFP AND P177 XOR C200 JMP* IMAGER .EJECT ///// VAL=. XI33 0 /"READC" LAC ENDCR /WAS LAST INPUT CR SAD C215 SKP /YES JMP XI33NX /NO - GO GET NEXT FROM BUFFER INBF01=.+2 RCAL01 .READ -2,2,INBUF,48 .IFUND MULTI RCAL02 .WAIT -2 .ENDC .IFDEF MULTI JMS IOBUSY .ENDC LAC* INBF01 AND P17 SAD (5 /EOF? JMP RDEOM /YES SAD (6 /EOM? JMP RDEOM /YES LAC INBUFP JMS .GETI /UNPACK INITIALIZATION XI33NX JMS GETENT /UNPACK CHARACTER XOR C200 SAD C200 /IGNORE NULL JMP XI33NX SAD C377 /IGNORE RUBOUTS JMP XI33NX SAD C212 /IGNORE LINE-FEED JMP XI33NX SAD C375 /USE CR FOR ESC LAC C215 DAC ENDCR DAC CHAR JMP* XI33 .EJECT XOUTL 0 /"PRINTC" SNA /USE AC OR CHAR LAC CHAR DAC SAVEOT /SAVE CHAR ISZ PUTCNT /READY TO BUMP WPC? JMP XOUTLQ /NO LAC* OTBF01 /YES SAD (31000 /HAS THE BUFFER OVERFLOWED? JMP XOUTLI /YES - IGNORE CHAR TAD (1000 /NO - UPDATE WPC DAC* OTBF01 LAW -5 DAC PUTCNT /RESET COUNT XOUTLQ LAC* OTBF01 SAD (31000 JMP XOUTLI /BUFFER OVERFLOWED - DONT SAVE CHAR LAC SAVEOT /GET CHAR JMS PUTENT XOUTLI LAC SAVEOT SAD C215 /OUTPUT BUFFER ON CR OR ESC JMP XOUTLX SAD C375 JMP XOUTLX JMP XOUTLZ XOUTLX=. OTBF01=.+2 WCAL01 .WRITE -3,2,OUTBUF,48 LAC OTBUFP JMS .PUTI LAW -1 DAC PUTCNT .IFUND MULTI WCAL02 .WAIT -3 .ENDC .IFDEF MULTI JMS IOBUSY .ENDC LAC (1000 DAC* OTBF01 XOUTLZ LAC CHAR JMP* XOUTL .EJECT .DEC .REPT 37 ISZ ERR2CT .OCT ERR2=. ERRPCX LAC TTOUT /REINIT FOR TT IN CASE IN LIB. MODE JMS SETWCL LAC C277 PRINTC LAC ERR2CT JMS PRNT DZM ERR2CT /CLEAR FOR NEXT ERROR ISZ PC /PRINT LINENO IF INDIRECT COMMAND LAC* PC SNA JMP ERR2T DAC LINENO /SAVE FOR PRINTING LAC C240 PRINTC PRNTLN ERR2T LAC CCR PRINTC JMP RECVR FUNERR DAC ERR2CT /SAVE TWO DIGIT ERROR CODE LAC C277 PRINTC /PRINT DOUBLE ? JMP ERRPCX .IFUND MULTI RECOVR LAC TTOUT /REINIT TT JMS SETWCL DZM LIBRSW DZM DATINS LAC CCR PRINTC .ENDC .IFDEF MULTI RECOVR DZM* CLAC1 /CLAC1 SET IN RESTAX ROUTINE DZM LIBRSW /REINIT LIB. SW DZM DATINS /REINIT DATA SW LAC TTOUT /REINIT TT IN CASE IN LIB. OR DATA MODE JMS SETWCL LAC CCR PRINTC JMS IOBUSY .ENDC WCAL04 .WRITE -3,2,FOCAL9,40 RECVR=. .IFDEF MULTI JMS IOBUSY .ENDC LAC OTBUFP JMS .PUTI LAC C215 DAC ENDCR LAW -1 DAC PUTCNT LAC (1000 DAC* OTBF01 LAC TTIN /RESET CAL FOR NORMAL INPUT JMS SETRCL LAC TTOUT JMS SETWCL JMP STARTZ .EJECT /SET WRITE CAL'S SUBROUTINE SETWCL 0 DAC LBOUT2 DAC LBOUT3 DAC LBOUT4 .IFUND MULTI DAC WCAL02 /.WAIT .ENDC XOR (1000 .IFDEF MULTI DAC CLAC /SAVE AC /NEED EXTRA LEVEL OF INDIRECTION SINCE USER AREAS ARE /EXTERNAL LAC* BWAIT DAC CLAC4 LAC CLAC /RESTORE AC DAC* CLAC4 /PROPER .WAITR .ENDC DAC LBOUT1 /.INIT TAD (1000 DAC WCAL01 /.WRITE JMP* SETWCL /SET READ CAL'S SUBROUTINE SETRCL 0 DAC LBIN01 DAC LBIN02 DAC LBIN03 .IFUND MULTI DAC RCAL02 /.WAIT XOR (2000 .ENDC .IFDEF MULTI DAC CLAC /SAVE AC /NEED EXTRA LEVEL OF INDIRECTION SINCE PURE USER AREAS /ARE EXTERNAL LAC* BWAIT DAC CLAC4 LAC CLAC /RESTORE AC XOR (1000 DAC* CLAC4 /PROPER .WAITR TAD (1000 .ENDC DAC RCAL01 /.READ TAD (1000 DAC LBIN1A JMP* SETRCL / .EJECT PACBUF 0 /PACK A CHARACTER - "PACKC" LAW -277 TAD CHAR SNA /CHANGE 277 TO 337 TAD P40 TAD M100 SNA /TEST FOR RUBOUT. HLT TAD C377 DAC T2 /SAVE INPUT ITEM /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 /340-377 AND 200-237 TR1 LAC T2 /240-337 AND C77 SZA /IGNORE 300 JMS PCK1 LAC T2 SAD C215 JMP .+3 PACBXT LAC CHAR JMP* PACBUF LAC XCTIN SNA!CLA JMP PACBXT JMS PCK1 JMP .-4 ////// ESCA LAC C77 JMS PCK1 JMP TR1 .EJECT PCK1 0 DAC TEMPK LAC XCTIN /=0 TO START TAD (JMP PCKTB DAC .+2 LAC ADD XX PCKTB JMP ROT-1 JMP ROT RTL6 DZM XCTIN TAD TEMPK DAC* AXIN DZM ADD /CLEAR PACKING WORD LAC* (PDLXR /CHECK FOR OVERFLOW (TAD P7600) TO PROTECT (X-MEM) CMA!CLL TAD C1 TAD P13 /RESERVATIONS TAD* (AXIN SNL!CLA JMP* PCK1 ERROR 16 /FULL BUFFER ///// CLA ROT RTL6 TAD TEMPK DAC ADD ISZ XCTIN JMP* PCK1 .EJECT TDUMP LAC FRSTCV /INIT POINTER FOR SYMBOL DUMP. ISZ DMPSW /TURN OFF THE TRACE FOR EXIT DAC PT1 SAD LASTCV JMS TDUMPC SAD LASTV /TEST FOR END OF LIST. POPJ LAC* PT1 DAC OP+1 /(DCA I XOP)-FOR(X-MEM) LAC OP TAD C1 DAC AXOUT LAW -1 DAC XCTX LAW -4 JMS TDUMPX ISZ PT1 LAC* PT1 /READ SUBSCRIPT TO 99 JMS PRNT LAW -2 JMS TDUMPX ISZ PT1 JMS* .AO /PICK UP VALUE PT1+400000 JMS FLOUTP /PRINT VALUE LAC C215 PRINTC LAC GINC TAD M2 TAD PT1 JMP TDUMP+2 /// TDUMPX 0 DAC T1 GETC PRINTC ISZ T1 JMP .-3 JMP* TDUMPX TDUMPC 0 LAC C255 PRINTC LAC C215 PRINTC LAC PT1 JMP* TDUMPC .EJECT /// XRAN LAC* RANPT /RANDOM NUMBER GENERATOR. ISZ RANPT RAL TAD RANPT TAD* PT1 RAL DAC* .AB TAD* RANPT DAC* .AC DZM* .AA LAC RANPT SAD* (.SCOM DZM RANPT RETURN /TWOS COMPLEMENT - CIA TWOS 0 CMA TAD C1 JMP* TWOS .EJECT .IFUND MULTI COMEIN=. BEGIN LAC* (.SCOM+4 /IS XVM MODE ON? AND (1 SNA JMP BEGIN1 /NO -- THEN DON'T TURN IT OFF .XVMOFF /YES -- TURN IT OFF BEGIN1 LAC* (.SCOM+3 DAC BOTTOM LAC* (.SCOM+2 DAC BUFSTX DAC FILE01 DAC FILE02 DAC FILE03 TAD (3 DAC ENDT DAC FRSTCV DAC LASTCV DAC LASTV LAC FILE01 TAD (2 DAC FLAC1 LAC FILEXT DAC* FLAC1 .INIT -3,0,RECOVR .WRITE -3,2,FOCAL9,40 .ENDC .IFDEF MULTI BEGIN=. .XVMOFF .ENDC LAC .AA DAC FLAC1 DAC FLAC2 DAC FLAC3 .IFUND MULTI LAC (OUTBUF+2 JMS .PUTI JMP XSBEGN BUFFER=COMEIN+70 COMOUT=COMEIN+110 .LOC COMOUT 215 /STOPPER .ENDC .IFDEF MULTI DAC FLAC14 TAD (1 DAC FLAC15 TAD (1 DAC FLAC16 JMP MSTART .ENDC .EJECT /LIBRARY(DATA) COMMAND FORMAT: / LIBRARY(DATA) IN FILE / LIBRARY(DATA) OUT FILE / LIBRARY WRITE "ANY COMMAND / LIBRARY WRITE ALL / LIBRARY WRITE XX.00 / LIBRARY WRITE XX.YY / LIBRARY(DATA) KILL / LIBRARY(DATA) CLOSE / DATA=. .IFUND BF LAC (AUXIN) /.DAT SLOT FOR AUX. INPUT DAC .DATIN LAC M1 DAC DATINS /SET DATA MODE SW LAC (AUXOUT) /AUX. OUTPUT SLOT JMP LB1 .ENDC LIBRAR LAC BLKIN /SET SLOTS FOR LIB. MODE DAC .DATIN LAC BLKOUT LB1 DAC .DATOUT SPNOR /IGNORE SPACES SAD C215 /IGNORE COMMAND IF CR POPJ SAD C273 /IGNORE IF; POPJ LAW -11 JMS FETVAR SORTC GLIST SKP ERROR 32 SORTJX LIBCMD ERROR 32 /BAD LIBR CMD ARG / LBIN JMS LBFILE /GET FILE NAME LAC .DATIN //SET INPUT CALS JMS SETRCL LAC BLKIN /SETUP INPUT CAL'S DAC LIBRSW /SIGN BIT 0 .IFDEF MULTI JMS IOBUSY .ENDC LBIN01 .INIT TTI,0,RECOVR .IFDEF MULTI JMS IOBUSY .ENDC LAC FILE03 AND (77777 DAC FILE03 FILE03=.+2 LBIN1A .FSTAT TTI,XX DAC LBFILE LAC FILE03 AND (700000 SNA JMP .+4 LAC LBFILE SNA ERROR 34 .IFDEF MULTI JMS IOBUSY .ENDC FILE01=.+2 LBIN02 .SEEK TTI,XX .IFDEF MULTI JMS IOBUSY .ENDC LAC .DATIN .IFUND BF SAD (AUXIN) POPJ /RETURN .ENDC LAC CFRSX DAC PC LBINLP LAC CHAR SAD C215 POPJ /ALL DONE SAD C273 JMP PROCES /MORE IN COME IN GETC JMP LBINLP+1 RDEOM JMS LBIEND /END LIBR IF OPEN LAC C215 JMP XI33NX+2 HSPX JMS LBIEND /END LIBR IF OPEN JMP LBINLP / LBOUT JMS LBFILE /GET FILE NAME LAC .DATOUT /SETUP OUTPUT CAL'S JMS SETWCL .IFDEF MULTI JMS IOBUSY .ENDC LBOUT1 .INIT TTO,0,RECOVR .IFDEF MULTI JMS IOBUSY .ENDC FILE02=.+2 LBOUT2 .ENTER TTO,XX .IFDEF MULTI JMS IOBUSY .ENDC LAW -1 DAC LIBRSW JMP LBINLP / LBCLOS LAC LIBRSW SNA /SEE IF A FILE IS OPEN ERROR 35 SMA /IF OUTPUT CLOSE FOR OUTPUT JMP LBOUT5 /INPUT. CLOSE FOR INPUT LAC .DATOUT /RESET OUTPUT CALS IN CASE ERR MSG JMS SETWCL /PRINTED .IFDEF MULTI JMS IOBUSY .ENDC LBOUT3 .CLOSE TTO JMP LBOUTZ LBOUT5 JMS LBIEND JMP LBOUTZ LBKILL LAC LIBRSW SMA ERROR 35 LAC .DATOUT /RESET OUT CALS IN CASE ERR MSG JMS SETWCL /PRINTED .IFDEF MULTI JMS IOBUSY .ENDC LBOUT4 .INIT TTO,0,RECOVR LBOUTZ DZM LIBRSW /CLEAR LIBR SWITCH DZM DATINS /CLEAR DATA SW LAC TTOUT /RESET WRITE CAL'S JMS SETWCL JMP LBINLP /GO FINISH CMD / LBWRIT LAC .DATOUT /REINIT FOR LIBR. OR DATA OUT IN CASE ERR MSG. TO TT JMS SETWCL LAC LIBRSW SMA ERROR 35 JMP WRITE LBTEXT LAC LIBRSW SMA ERROR 8 LBTEXX GETC /PUT COMMAND INTO PRINTC /OUTPUT BUFFER SAD C215 /ALL DONE? POPJ /YES JMP LBTEXX /NO-MORE / LBFILE 0 LAC FILE03 TAD (2 DAC LBIEND LAC FILEXT /SETUP 'FCL' AS EXTENSION DAC* LBIEND LAC CHAR LBCON1 SAD C240 JMP LBCON /IF SPACE GET ANOTHER CHAR SAD C215 /IF CR, MISSING FILENAME- ERR 33 JMP LBE33 JMP LBCON2 /IF NOT,GET FILENAME LBCON GETC JMP LBCON1 /RECHECK LBCON2 LAW -6 JMS FETVAR /GET FILE NAME LAC CHAR SAD C215 /CR SKP SAD C273 /; JMP* LBFILE LBE33 ERROR 33 / LBIEND 0 LAC TTIN /RESTORE INPUT JMS SETRCL LAC LIBRSW /IF LIBRARY OPEN, SNA /CLOSE IT JMP* LBIEND LBIN03 .CLOSE TTI DZM LIBRSW /CLEAR SWITCH DZM DATINS /CLEAR DATA SW JMP* LBIEND / .EJECT /FLOATING POINT ARITHMETIC INTERPRETER FOR FOCAL /FLOATING POINT PACKAGE - EXPONENTIAL FEXP GETSGN SMA!CLA JMP .+3 JMS* .BA CLA!CMA DAC SIGN2 /C(SIGN)=-1 IF X<0 JMS* .AP /PUT FLARG JMS* DEXP JMP .+2 FLARG ISZ SIGN2 RETURN JMS FINT FPUT XY FGET FLTONE FDIV XY FEXT RETURN /FLOATING POINT ARC TANGENT ARTN JMS* DATAN JMP .+2 FLARG RETURN /FLOATING LOGARITHM FLOG GETSGN SNA ERROR 25 /ZERO ARGUEMENT FOR LOG SPA!CLA JMS* .BA /NEGATIVE ARGUMENT JMS* .AP /PUT FLARG JMS* DLOG JMP .+2 FLARG RETURN /FLOATING POINT SINE AND COSINE FCOS JMS* DCOS JMP .+2 FLARG RETURN FSIN JMS* DSIN JMP .+2 FLARG RETURN .EJECT /INPUT/OUTPUT ROUTINES FOR THE FOCAL /FLOATING POINT PACKAGE. /IN THE COMMENTS BELOW:- / F = NUMBER OF DIGITS TO BE OUTPUT =FISW / D = NUMBER OF DECIMAL PLACES =DECP / E = DECIMAL EXPONENT =BEXP / P = NUMBER OF PLACES REMAINING TO BE / PRINTED BEFORE DECIMAL POINT TGO 0 DAC SCOUNT /SAVE NUMBER OF DIGITS AVAILABLE - *SET COUNTS* LAC FISW SNA /FLOATING OUTPUT? JMP R6 /YES, ROUND OFF TO 6 PLACES JMS TWOS /NO, COMPUTE FIELD SIZES TAD DECP SPA / F-D > 0 ? JMP .+5 /YES CLA!CMA /NO, TAD FISW DAC DECP /MAKE D = F-1 CLA!CMA TAD BEXP /COMPARE DECIMAL EXPONENT SMA / F-D > E? CLA /NO, ROUND OFF TO .F PLACES TAD FISW /YES SPA / D+E < 0 ? JMP RET1 /YES, NO ROUNDING NEEDED, GO TO PRINT TAD MD /NO, ROUND TO D+E PLACES, SMA /TO A MAXIMUM OF D PLACES CLA R6 TAD RND2 / *ROUND UP * DAC TEMPO /SAVE NUMBER+1 OF PLACES TO ROUND TO TAD BUFST /SET UP BUFFER ADDRESS AT WHICH DAC PLCE /ROUNDING OFF SHOULD START LAC TEMPO JMS TWOS /SET UP COUNT OF MAXIMUM NUMBER DAC TEMPO /OF CARRIES ALLOWABLE LAC (5 /LITTLE EXTRA ON FIRST DIGIT. RET ISZ* PLCE /ADD 1 TO DIGIT AT CURRENT POSITION TAD* PLCE TAD M12 SPA!CLA /CARRY REQUIRED? JMP FPRNT /NO, GO TO OUTPUT DAC* PLCE /YES, MAKE CURRENT DIGIT ZERO ISZ TEMPO /BEGINNING OF BUFFER REACHED? JMP DECR /NO, DECREMENT BUFFER ADDRESS AND REPEAT ISZ* PLCE /YES, SET MANTISSA TO 0.1 RET1 LAC BEXP /COMPENSATE BY INCREM EXPONENT TAD (1 /FIX FOR OUTPUT OF .1 DAC BEXP /...WAD JUNE 69 /FORMERLY ISZ BEXP REPLACED ABOVE THREE INSTRUCTIONS FPRNT LAC FISW /AUTO-INDEX REGISTER ALREADY SET. - *PRINT* SNA / F = 0 ? JMP FLOPX /YES, OUTPUT AS FLOATING NUMBER JMS TWOS /NO, DAC FCOUNT /SET UP COUNT TO PRINT F PLACES TAD BEXP SMA!SZA / E > F ? JMP XXX /YES, PRINT X'S TAD DECP SMA / E < F-D ? CLA /NO, TAKE P = E JMS TWOS /YES, TAKE P = F-D TAD BEXP JMS TWOS DAC TEMPO /SET UP MINUS P BACK LAC BEXP /PRINT DD.DDD TAD TEMPO SNA!CLA / P = E ? JMP DIG /YES, PRINT DIGIT TAD TEMPO /NO, TAD C1 SPA!CLA / P > 1 ? LAW 240-260 /YES, TAKE SPACE; OTHERWISE ZERO IN JMS OUTA /PRINT CHARACTER ISZ TEMPO /P CHARACTERS PRINTED? JMP BACK /NO LAC PER /YES, PRINTC /PRINT DECIMAL POINT JMP BACK ///// DECR CLA!CMA TAD PLCE DAC PLCE CLA JMP RET ///// OUTA 0 JMS OUTDG /PRINT CHARACTER ISZ FCOUNT /F CHARACTERS PRINTED? JMP* OUTA /NO, RETURN JMP* TGO /YES, NUMBER FINSHED ///// DIG CLA!CMA TAD BEXP /REDUCE E, BY 1 DAC BEXP ISZ SCOUNT /ARE ALL SIG. FIGS. USED? JMP DIGP5 /NO CLA!CMA /YES, DAC SCOUNT /RESET COUNT TO -1 CLA JMP IN /AND LEAVE C(AC) = 0 DIGP5 LAC* FLTXR /TAKE NEXT DIGIT FROM BUFFER JMP IN //// /DO FLOATING OUTPUT XXX LAC FISW SKP FLOPX LAC DECP JMS TWOS SNA MD LAW -DIGITS /SET COUNT TO PRINT DAC FCOUNT /6 DIGITS AFTER DECIMAL POINT CLA JMS OUTDG /PRINT "0" LAC PER PRINTC /PRINT "." ISZ TGO /SEND RETURN LAC* FLTXR /TAKE NEXT DIGIT FROM BUFFER JMS OUTA /PRINT IT ISZ SCOUNT /TEST FOR END OF INPUT JMP .-3 /AND REPEAT CLA!CMA DAC SCOUNT /OUTPUT EXTRA ZEROS. CLA JMP .-6 .EJECT /DOUBLE PRECISION DECIMAL-BINARY /INPUT AND CONVERSION FOR + OR - XXX... DECONV 0 DZM* .AB DZM* .AC DZM OVER2 DZM DNUMBR CLA!CMA DAC ISIGN LAW -253 TAD CHAR SNA JMP .+5 /+SIGN; GET NEXT TAD M2 /CHECK - SIGN SZA!CLA JMP .+3 DAC ISIGN JMS INPUT /GET NEXT SAD C240 JMP .-2 /FORMERLY WAS JMP .-4 JMS DECON JMP* DECONV ///// DECON 0 SAD C305 /TEST LEAD CHARACTER FOR TERMINATOR JMP* DECON TESTN JMP* DECON JMP DTST DSAVE DAC DIGIT /YES - SORTCN IN AC ISZ DNUMBR /INDEX NUMBER OF DIGITS JMS MULT10 /REMAIN MUST =0 SINCE OVERFLOW IS CHECKED SZA ERROR 26 /INPUT-OVERFLOW ERROR JMS INPUT JMP DECON+1 /CONTINUE MINUSA=. DTST LAW -301 TAD CHAR SPA!CLA JMP* DECON LAW -333 /LAW -332 CHANGED TO LAW -333 ....WAD....JUNE 69 FOR 0Z BUG TAD CHAR SMA!CLA JMP* DECON LAC CHAR AND C77 JMP DSAVE ///// MULT10 0 /ROUTINE TO MULTIPLY LAC OVER2 /FROM TAD DAC OTEMP LAC* .AC /DOUBLE PRECISION WORD DAC LTEMP /BY TEN (DECIMAL) LAC* .AB /REMAIN=REMAINDER DAC HTEMP DZM REMAIN JMS MULT2 /CALL SUBROUTINE TO JMS MULT2 /MULTIPLY BY TWO JMS DUBLAD /CALL DOUBLE ADD JMS MULT2 LAC DIGIT /ADD LAST DIGIT RECEIVED DAC OTEMP DZM LTEMP DZM HTEMP JMS DUBLAD LAC REMAIN /EXIT WITH REMAINDER JMP* MULT10 /IN AC ///// MULT2 0 /MULTIPLY OVER2, LORD, HORD BY 2 LAC OVER2 CLL!RAL DAC OVER2 LAC* .AC RAL DAC* .AC LAC* .AB RAL DAC* .AB LAC REMAIN RAL DAC REMAIN JMP* MULT2 DUBLAD 0 /TRIPLE PRECISION ADDITION CLA!CLL LAC OVER2 TAD OVER1 DAC OVER2 CLA!RAL TAD* .AC TAD AC1L DAC* .AC CLA!RAL TAD* .AB TAD AC1H DAC* .AB CLA!RAL TAD REMAIN DAC REMAIN JMP* DUBLAD ///// /INPUT FROM TEXT OR KEYBOARD; INPUT 0 /INPUT A CHARACTER LAC INSUB /NON-ZERO FOR KEYBOARD SZA!CLA JMP .+3 GETC JMP* INPUT READC JMP* INPUT .EJECT /FLOATING OUTPUT CONVERSION ROUTINE FLOUTP 0 LAC* .AB /NUMBER>0?? SMA!CLA LAW 240-255 /PRINT DASH OR SPACE TAD SMIN PRINTC LAC* .AB /TAKE ABSOLUTE VALUE SPA!CLA JMS* .BA CLA!CMA /SUBTRACT 1 FROM BINARY EXPONENT TAD* .AA /COMPENSATE AT FGO4 DAC* .AA DZM BEXP /INITIALIZE DECIMAL EXPONENT FGO2 LAC* .AA /IS -4