File EDU20S.PA (PAL assembler source file)

Directory of image this file is from
This file as a plain text file

/EDUCOMP EDU200 BASIC
/VERSION 2.0 AS OF 2/14/74
/THIS VERSION CONTAINS MINI CHARACTER STRINGS










	/AN EDUCOMP SOFTWARE PRODUCT
	/SOFTWARE PRODUCT MANAGER
	/DOUGLAS BERGENGREN

	/COPYRIGHT 1974 BY
	/EDUCOMP CORPORATION
	/298 PARK ROAD
	/WEST HARTFORD, CONNECTICUT  06119

/EDU200 BASIC IS FOR THE PDP-8/E,-8/F, -8/I, -8/L WITH /8K OR MORE MEMORY AND EITHER THE DC02 OR PT08(KL8E ON 8/E&F) OPTION /THE POWER FAIL-AUTO RESTART OPTION ALSO IS SUPPORTED. /SAVING EDU200 BASIC ON DIFFERENT MONITOR SYSTEMS: / /OS/8 MONITOR SYSTEM-- / .R ABSLDR / *PTR:=12001$ / .SAVE SYS BASIC / / .R BASIC / /DISK MONITOR SYSTEM-- / .SAVE BAS0!0-7577;40 / .SAVE BAS1!10000-10377,11000-13777,17000-17377;0 / /TAPE MONITOR SYSTEM-- / .SAVE BAS0!0-7577;30 / .SAVE BAS1!1009p/10377,11000-13777,17000-17377;0 / / .BAS1 / .BAS0 /TO GET THE CONFIGURATOR ONLY (IT IS AN OVERLAY TAPE TO BASIC) /DEFINE "CONFIG" AS 1 IFDEF CONFIG < NOPUNCH >
/DEFINITIONS FIXMRI FJMP=0000 FIXMRI FADD=1000 FIXMRI FSUB=2000 FIXMRI FMPY=3000 FIXMRI FDIV=4000 FIXMRI FGET=5000 FIXMRI FPUT=6000 FINT=JMS I 7 FEXT=0000 FNOR=7000 CAF=6007 BSW=7002 SPL=6102 MTKF=6123 MTPF=6113 MTON=6117 MINT=6115 MINS=6125 MKSF=6111 MKRB=6116 MTSF=6121 MTCF=6122 MTLS=6126 RCRB=6634 RCRD=6674 RTF=6005 L0001=CLL CLA IAC L0002=CLL CLA CML RTL L0003=CLL CLA CML IAC RAL L0004=CLL CLA IAC RTL L0006=CLL CLA CML IAC RTL L7777=CLL CLA CMA L7776=CLL CLA CMA RAL L7775=CLL CLA CMA RTL L3777=CLL CLA CMA RAR L5777=CLL CLA CMA RTR L4000=CLL CLA CML RAR L2000=CLL CLA CML RTR SWAP=10
/PAGE ZERO FIELD 0 PAGE 0 0 CIF 10 /INTERRUPT HANDLER JMP INTR81 USER, 0 /INTERRUPT USER COUNTER SIN, 0 /INTERRUPT TEMPORARY TEMP1, 0 /INTERRUPT TEMP TEMP2, USER0 /INTERRUPT TEMP FPT /FLOATING POINT XREG, 0 /INTERRUPT XREG XREG2, 0 /INTERRUPT XREG XREG3, 0 /GENERAL XREG FLTXR, 0 /FLOATING XREG FLTXR2, 0 /FLOATING XREG STSWAP=. /START OF SWAP PDLXR, TOP /PUSH-DOWN XREG AXIN, 0 /PACKING XREG TEXTP=. /TEXT POINTERS AXOUT, 0 /UNPACK XREG GTEM, 0 /UNPACK SWITCH XCT, 0 /UNPACK SWITCH PC, READY /PROGRAM RESTART ADD, 0 /PACK TEMPORARY XCTIN, 0 /PACK SWITCH SUBS=XCTIN /SUBSCRIPT PT1, 0 /FLOATING POINTER CHAR, 0 /CHARACTER LINEPC, 0 /LINE POINTER LINENO, CIF CDF 10 /LINE NUMBER LASTLN, JMP I .+1 /LAST LINE POINTER MODE=LASTLN SPACSW, TAPEM /0 IS IGNORE SPACES DINPUT, -1 /-1 FOR BREAK ON CR ONLY /0 FOR BREAK ON ANY AND NO ECHO OUTPUT, 0 /0 IS ECHO XIOT, KRB /INPUT IOT XFIELD, 0 /USER FIELD DATAPC, 0 /LINE NUMBER OF DATA STATEMENT CIF CDF 10 /DATA POINTER JMP I .+1 /DATA TEMPORARY DISKM /DATA UNPACK SWITCH 0 /DATA CHARACTER IPTRI, BUFFER /INPUT BUFFER FILL IPTRO, BUFFER /INPUT BUFFER EMPTY IPTR0, BUFFER /START OF BUFFER OPTRI, BUFFER-40 /OUTPUT BUFFER FILL OPTRO, BUFFER-40 /OUTPUT BUFFER EMPTY TELSW, 0 /TTY BUSY SWITCH PACKST, 0 /START OF PACKING PACKND, 0 /POINTER TO END OF PACKING BUFR, LINE1 /NEXT FREE SPACE STARTV=BUFR /START OF VARIABLES LASTV, LINE1 /LAST DEFINED VARIABLE PDLST, TOP /START OF PUSH-DOWN ALINE0, LINE0 /POINTER TO DUMMY LINE COMBUF, BUFCOM /COMMAND BUFFER PRNTC1, 0 /PRINT ZONE COUNT ERLINE, 0 /ERROR LINE FRNDX, 1 /3 WORD 203 /RANDOM INTEGER 5555 ENSWAP=.-1 DECK=XFIELD /USER ON DECK AC0, 0 AC1, 0 AC2, 0 ACX, 0 /FAC (FLOATING POINT ACCUMULATOR) ACH, 0 /HIGH ORDER ACLO, 0 /LOW ORDER OPX, 0 /EXPONENT OF OPERAND OPH, 0 /HIGH ORDER OPERAND OPL, 0 /LOW ORDER OPERAND EVAL1, 0 /UNARY FLAG FOR EXPRESSION EVALUATOR CPACK, XCPACK /POINTER TO PACK ROUTINE FOR STRING FUNCTIONS TM=AC0 EXP=ACX HORD=ACH LORD=ACLO SORTCN, 0 /SORT CONSTANT T1, 0 /THREE TEMPS T2, 0 T3, 0 CNTR, 0 /COUNTER THISOP, 0 /CURRENT OP LASTOP, 0 /LAST OP EFOP=CNTR /FUNCTION OP FLOUTP, FLOUT /FLOATING OUTPUT FLINTP, FLIN /FLOATING INPUT LOOK, USER0-1 /USER BEING RUN OR LOOKED AT LOOKST, USER0 /TO RESET LOOKING FLARGP, FLARG /POINTER TO TEMP FLAC INTEGE, FFIX /FIX THE FLAC ROUTINE FFLAG, 0 /-1 IF OP NOT 0 CCR, 15 /CR C7, 7 /BELL C177, 177 /RUBOUT C137, 137 /BACK ARROW LLSTMD, LSTMOD /POINTER TO LSTMOD IN FIELD 1 14 /FORM FEED CLF, 12 /LINE FEED M100, -100 /CHARACTOR TEST M40, -40 /-BUFFER SIZE M12, -12 /-10 DECIMAL M6, -6 /-MESSAGE LENGTH M4, -4 /CHARACTOR COUNT C40, 40 /BUFFER SIZE C77, 77 /RIGHT MASK CCONT, CONT /POINTER TO EXECUTE NEXT STATEMENT CJUMP, JUMP /POINTER TO JUMP TO LINE NO. IN AC C7700=M100
/NEW INSTRUCTIONS PRINTC=JMS I . /PRINT AC OR CHAR XPRNTC GETC=JMS I . /UNPACK A CHAR XGETC SORTJ=JMS I . /SORT JUMP XSORTJ SORTC=JMS I . /SORT ASORTC, XSORTC PUSHA=JMS I . /SAVE AC XPUSHA PUSHJ=JMS I . /PUSH JUMP XPUSHJ PUSHF=JMS I . /SAVE FLOATING DATA XPUSHF POPA=JMS I . /RESTORE AC XPOPA POPJ=JMP I . /POP JUMP XPOPJ POPF=JMS I . /RESTORE FLOATING DATA XPOPF FLGET=JMS I . /FLOATING GET XFLGET FLPUT=JMS I . /FLOATING PUT XFLPUT PRINTX=JMS I . /DO OUTPUT XOUTL ERROR=JMS I . /ERROR XERROR UDF=JMS I . /USER DATA FIELD AUDF, XUDF RTL6=JMS I . /SIX RAL*S XRTL6 TESTN=JMS I . /TEST NUMERIC XTESTN TESTC=JMS I . /TEST CHAR XTESTC PACKC=JMS I . /PACK A CHAR XPACKC GETLN=JMS I . /GET A LINE NUMBER XGETLN TSTCCR=JMS I . /SKIP IF CR CCRTST TSTCOM=JMS I . /SKIP IF COMMA COMTST TSTALP=JMS I . /SKIP IF LETTER ALPTST COMMAN=JMS I . /DETERMINE COMMAND F0CMAN FIND=JMS I . /FIND A STATEMENT XFIND GETNXT=JMS I . /GET NEXT LINE NXTGET FINDLN=JMS I . /FIND A LINE XFINDL FREE13=JMS I . /FREE 14 OUTPUT SPACES XFREE3 FREE2=JMS I . /FREE 3 OUTPUT SPACES XFREE2 READC=JMS I . /READ A CHAR XREADC TSTEND=JMS I . /TEST FOR END OF LINE ENDTST TSTLPR=JMS I . /SKIP IF L-PAREN LPRTST GETSGN=TAD I FLARGP
/MAINLINE BASIC /WHENEVER THERE IS NOTHING BETTER TO DO OR A JOB WANTS TO /DISMISS ITSELF SO OTHERS CAN TRY THIS ROUTINE IS ENTERED /IT KEEPS LOOKING FOR A JOB WITH BITS 0 AND 1 OFF WHICH /SAYS THAT THE JOB IS NOT WAITING FOR INPUT OR OUTPUT /RESPECTIVELY *177 NULL, ION CDF ISZ I LINTCN /COUNT FOR RANDOMIZE C60, 60 /PROTECT THE ISZ TAD LOOK TAD MLOOKE /CHECK POSITION OF POINTER SPA CLA JMP .+4 /O.K. TO LOOK AT NEXT KL8JMP, TAD LOOKST DCA LOOK /RESET POINTER SKP KL8LFL, ISZ LOOK /LOOK AT NEXT TAD I LOOK /GET STATUS CLL RAL SZL SPA CLA JMP NULL /NO GO TAD I LOOK /GET STATUS IOF /NO INTERRUPTS JMS DECKON /PUT HIM ONDECK TAD PC DCA 0 /RESTART LOCATION L7775 /NUMBER OF COMMANDS BEFORE RETURNING DCA PC ION JMP I 0 /GO TO IT... MLOOKE, -USER7+10 /LAST STATUS WORD : SUBTRACT NUMBER OF USERS
/NEW *PRNTIT* ROUTINE /ENTER WITH A NUMBER BETWEEN 1 AND 2047 IN THE AC. /IT IS PRINTED AS AN UNSIGNED DECIMAL INTEGER. /THIS ROUTINE PRINTS NO SPACES, AND ITS ONLY /ARGUMENT IS THE VALUE PASSED IN THE AC ITPRNT, 0 DCA T1 /SAVE NUMBER DCA FLTXR /SIGNIFICANT DIGITS TAD LSTADR DCA T2 /SUBTRACTION LIST POINTER TAD M4 DCA CNTR /FOUR DIGITS PRNT1, DCA T3 /SET DIGIT TO 0 PRNT2, TAD T1 /GET NUMBER TAD I T2 /SUBTRACT POWER OF TEN SPA /DID IT FIT? JMP PRNT3 /NO, FOUND THIS DIGIT DCA T1 /SAVE NEW NUMBER ISZ T3 /BUMP DIGIT JMP PRNT2 /STILL DOING THIS DIGIT PRNT3, CLA TAD FLTXR /GET SIGNIFIGANCE TESTER TAD T3 /AND DIGIT SNA CLA /BOTH ZERO? JMP PRNT4 /YES: DO NOT PRINT THIS DIGIT TAD T3 /GET DIGIT TAD C60 /CONVERT TO ASCII PRINTC /AND PRINT IT ISZ FLTXR /ALL FURTHER DIGITS ARE SIGNIFICANT PRNT4, ISZ T2 /NEXT POWER OF TEN ISZ CNTR /MORE DIGITS? JMP PRNT1 /YES JMP I ITPRNT /EXIT LSTADR, HERE DECIMAL HERE, -1000 -100 -10 -1 OCTAL
/*ONDECK* ROUTINE /ROUTINE TO PUT A USER "ON DECK" /ENTER WITH HIS NUMBER ON AC BITS 9-11 DECKON, NULL+1 AND C7 /USER NUMBER ONLY DCA SIN /SAVE NEW TAD DECK CIA TAD SIN SNA CLA JMP I DECKON /FAST EXIT TAD DECK JMS DFIND /LOCATE OLD TAD I LXUDF1 DCA XFIELD CDF SWAP TAD I LLSTMD DCA DINPUT CDF TAD I XREG2 CDF SWAP DCA I XREG /SWAP OUT OLD ISZ TEMP2 JMP .-5 TAD SIN JMS DFIND /LOCATE NEW ENTRY1, TAD I XREG CDF DCA I XREG2 /SWAP IN NEW CDF SWAP ISZ TEMP2 JMP .-5 TAD DINPUT DCA I LLSTMD CDF TAD XFIELD DCA I LXUDF1 TAD SIN DCA DECK /NEW USER ONDECK TAD LOOKST TAD DECK DCA TEMP2 /POINT TO STATUS JMP I DECKON DFIND, ENTRY1 ENTRY, CMA DCA TEMP2 TAD LORG /START AT 414 (END OF FUNL2) IN FIELD 1 TAD STARTP /SPACE BETWEEN ISZ TEMP2 JMP .-2 DCA XREG /POINT TO USER TAD L1 DCA XREG2 /POINT TO SWAP AREA TAD L2 DCA TEMP2 /SWAP COUNT JMP I DFIND STARTP, ENSWAP-STSWAP+1 /SPACE BETWEEN LXUDF1, XUDF+1 LORG, ORG-1-ENSWAP+STSWAP-1 L1, STSWAP-1 L2, STSWAP-ENSWAP-1 LINTCN, INTCNT /THIS ROUTINE IS USED BY THE INTERRUPT ROUTINE /IN FIELD 1. F0DCKN, TAD I LOOK /GET USER THAT WAS RUNNING BEFORE INTERRUPT JMS DECKON /PUT HIM ON DECK CIF 10 JMP I .+1 /GO BACK TO FINISH UP INTRP6 /THIS ROUTINE CALLS *GETC* FROM FIELD 1 FOR *COMMAN* F0GETC, GETC CIF CDF 10 JMP I .+1 /CONTINUE WITH THE COMMAND DECODER COM7
/ERROR ROUTINE /HERE IS WHERE ERROR MESSAGES ARE PRINTED /IT IS CALLED BY A DISMISSAL WITH THE PC SET TO /ERRORX AND THE ERROR ADDRESS IN LSTMOD ERRORX, FREE13 /GET ROOM TAD M40 DCA T3 /BUFFER IS 40 LONG L7777 TAD IPTR0 DCA XREG3 /POINT TO I BUFFER UDF DCA I XREG3 /CLEAR BUFFER ISZ T3 JMP .-2 CDF TAD IPTRI DCA IPTRO /NO INPUT IN BUFFER DCA OUTPUT /HAVE ECHO TAD PT1 /GET ERROR CODE SORTC ERRLST-1 TAD SORTCN /GET ERROR NUMBER SZA CLA /ERROR OR CONTROL-C? CLL CMA RTL /ERROR: +2 CMA /CONTROL-C: -1 ISZ SPACSW /KEEP SPACES FOR MESSAGE JMS READY1 /PRINT "CR,STOP" OR "CR,ERROR " TAD SORTCN /GET ERROR NUMBER SZA /PRINT NUMBER ONLY IF NEEDED JMS I PITPNT TAD ERLINE /WHAT LINE WERE WE IN? SPA SNA CLA JMP READY /NONE: IMMEDIATE MODE FREE13 /GET ROOM FOR "IN ####" TAD CLF /GET MESSAGE ADDRESS JMS READY1 /PRINT " IN " TAD ERLINE /LINE NUMBER JMS I PITPNT /PRINT LINE NUMBER
/*READY* ROUTINE /ROUTINE TO PRINT "READY" AND RESET POINTERS /ENTER THE ROUTINE AT START TO OMIT READY MESSAGE READY, FREE13 CLA CLL CML IAC RTL /GET A 6 JMS READY1 /PRINT "CR,READY,CR" START, TAD PDLST DCA PDLXR /RESET PUSH-DOWN L7777 CDF 10 DCA I LLSTMD /SHORT LIST DCA ERLINE /FOR THINGS LIKE ERROR 6 TAD (ERR330 PUSHA /TRAP TOO MANY *RETURN*S PUSHJ PAKLIN /GET COMMAND LINE
/INSERT LINE OR DO COMMAND /AFTER A COMMAND OR LINE IS PACKED INTO THE COMMAND BUFFER /THIS ROUTINE LOOKS AT IT AND EITHER STORES THE LINE OR /GOES TO THE PROPER COMMAND DECODE, TSTEND TESTN JMP START /IF LINE STARTS WITH CR, IGNORE LINE JMP I PINPUTX /COMMAND GETLN /GET LINE NUMBER SRETN, TAD BUFR DCA AXIN /SET TO REPACK DCA XCTIN TAD LINENO UDF DCA I AXIN /SET LINE NUMBER CDF TSTCCR /JUST LINE NUMBER JMP .+3 /NO JMS I PXDELET /DELETE THIS LINE JMP START ISZ SPACSW /KEEP SPACES SKP GETC PACKC /REPACK LINE TSTCCR JMP .-3 JMS I PXDELET /DELETE OLD LINE UDF IOF TAD I LASTLN /POINTER TO NEXT DCA I BUFR /POINT TO NEXT TAD BUFR DCA I LASTLN /OLD POINTS TO NEW TAD ADD SZA DCA I AXIN /FINISH PACKING TO AN EVEN BOUNDARY FINDLN /FIND THE LINE C16, 16 PUSHJ ENDFND /GET LAST COMMAND ON LINE--IS IT *NEXT*? SNA CLA TAD (10 /8 EXTRA FOR *NEXT* IAC TAD AXIN DCA BUFR /NEW FREE POSITION TAD STARTV /RESET VARIABLES AFTER TEXT IS TOUCHED DCA LASTV JMP START /INTERRUPT WILL BE ON IN A LITTLE WHILE PINPUTX, INPUTX PXDELET, XDELET PITPNT, ITPRNT /SUBROUTINE TO WRITE OUT MESSAGES READY1, 0 DCA AXOUT /POINT TO MESSAGE DCA XCT READY2, GETC /GET MESSAGE TAD CHAR TAD M12 SPA CLA JMP I READY1 PRINTC JMP READY2 FIX, 0 /*FIX* FUNCTION TAD FIX DCA I (FFADD /KLUDGE SUBROUTINE LINKAGE TAD (27 /23 DECIMAL, THE MAGIC NUMBER FOR SHIFTING DCA OPX /PUT IT IN THE OP DCA OPH /AND MAKE THE WHOLE THING DCA OPL /A RATHER LARGE ZERO JMP I (FAD1+6 /JUMP INTO FLOATING ADD ROUTINE INT, 0 /*INT* FUNCTION TAD ACH /GET SIGN OF FAC SPA CLA /POSITIVE OR NEGATIVE? JMS I (FFADD /NEGATIVE:ADD -.9999999999 MAGICN /THIS LOC MUST BE < 1000 BECAUSE IT /MUST BE A NOP! JMS FIX /NOW TRUNCATE JMP I INT /AND RETURN, FAC=INT(FAC0) /*FLARG* (FLOATING POINT ARGUMENT TO MANY THINGS) FLARG, 0 0 0 FRNDX0, 0 /EXPONENT OF RANDOM NUMBER 203 /2 WORD RANDOM INTEGER 5555 PAGE KEY, 0 TAD USER JMS I PDECKON /PUT HIM ONDECK TAD XIOT DCA .+1 /SET READ IOT HLT AND C177 /IGNORE PARITY SNA JMP KEYEND /IGNORE 0 AND 200 DCA SIN /SAVE INPUT L7775 TAD SIN SZA CLA JMP KEY7 /NOT CTRL/C ERR004, JMS I PIERROR /IMMEDIATE RECOVERY JMP KEYEND KEY7, CDF 10 TAD I LLSTMD CDF SNA CLA JMP KEY6 TAD SIN SORTC ALT-1 JMP KEY5 TAD SIN TAD M12 SNA CLA JMP KEYEND /IGNORE LINE FEED IF NOT BREAK TAD SIN AND C140 SNA JMP KEY3 /ILLEGAL CHAR TAD M140 SNA CLA JMP KEY3 /ILLEGAL CHAR TAD SIN PRINTX /ECHO THE CHAR JMS KEY4 /STORE THE CHAR TAD IPTRO CIA TAD IPTRI SPA SNA TAD C40 TAD M12 SPA CLA JMP KEYEND ANYINP, L3777 AND I TEMP2 /CLEAR I WAIT DCA I TEMP2 JMP KEYEND M140, -140 LXOUTL2, XOUTL2 PXFREE, XFREE KEY5, L7775 TAD SORTCN CLL RAR SZA CLA JMP .+3 /NO ECHO HERE TAD SIN PRINTX /ECHO BREAK CHAR - CR AND BELL KEY6, JMS KEY4 /STORE CHAR JMP ANYINP /BREAK HERE KEY3, TAD C7 PRINTX /2 BELLS FOR ILLEGAL CHAR TAD C7 PRINTX KEYEND, CIF 10 JMP I KEY KEY4, 0 UDF TAD I IPTRI /ROOM? SZA CLA ERR070, JMS I PIERROR /NO ROOM UDF TAD SIN DCA I IPTRI CDF ISZ IPTRI TAD IPTRI CIA TAD C40 TAD IPTR0 SZA CLA JMP I KEY4 /OK TAD IPTR0 DCA IPTRI /RESET POINTER JMP I KEY4
TTY, 0 TAD USER JMS I PDECKON /PUT HIM ONDECK DCA TELSW /CLEAR BUSY UDF TTY3, TAD I OPTRO /MORE SNA JMP TTY2 /NO JMS I LXOUTL2 /OUTPUT IT UDF DCA I OPTRO /CLEAR BUFFER ISZ OPTRO /BUMP BUFFER TAD OPTRO CIA TAD IPTR0 SZA CLA JMP TTY2 /OK TAD IPTR0 TAD M40 DCA OPTRO /RESET BUFFER TTY2, JMS I PXFREE /ROOM AVAILABLE C140, 140 JMP TTYEND /NOT ENOUGH ROOM L5777 AND I TEMP2 /CLEAR O WAIT DCA I TEMP2 TTYEND, CIF 10 JMP I TTY PDECKON, DECKON PIERROR, IERROR
/THE GREAT 'MAGICN' IS ADDED TO NEGATIVE NUMBERS /IN THE *INT* FUNCTION SO THAT THE *FIX* FUNCTION WILL WORK /ON IT! MAGICN, 0000 /-.99999999999 4000 0003 /KLUDGE! PAGE /*INPUT* STATEMENT INPUT, PUSHF /SAVE POSITION OF DATA DATAPC+1 TAD DATAPC+4 PUSHA TAD CCR /FAKE END OF LINE DCA DATAPC+4 /SO INREAD WILL BE FORCED TO GET MORE INPSET, JMS INREAD /DO THE INPUT LIST JMP INPEND /DONE FREE13 /NEED MORE DATA TAD C77 /ASCII FOR "?" PRINTC /PRINT A QUESTION MARK TAD C40 PRINTC /PRINT THE SPACE AFTER PUSHJ /GET A LINE OF INPUT PAKLIN L7777 /INDICATE REENTRY JMP INPSET /USE NEW DATA INPEND, POPA /RESTORE THE DATA POINTERS DCA DATAPC+4 POPF DATAPC+1 JMP I CCONT /DO NEXT STATEMENT /*READ* STATEMENT READ, JMS INREAD /DO THE READ LIST JMP REAEND /END OF LIST; DONE TAD DATAPC /GET LINE NUMBER OF DATA LIST FIND /FIND ANOTHER DATA STATEMENT 27 /-DATA CODE ERR510, ERROR /OUT OF DATA DCA DATAPC /SAVE NEW LINE NUMBER L7777 /INDICATE REENTRY JMP READ /USE NEW DATA REAEND, TAD ERLINE /RESTORE PROPER LINE NUMBER DCA LINENO JMP I CCONT /DO NEXT STATEMENT /THIS ROUTINE PROCESSES THE VARIABLE LIST OF THE INPUT AND READ /STATEMENTS. INREAD, 0 SZA CLA /REENTRY? JMP INRMOD /YES: GO PROCESS THE DATA INRVAR, PUSHJ /GET A VARIABLE FROM LIST GETVAR PUSHF /SAVE PT1;CHAR;LINEPC PT1 PUSHF /SAVE THE TEXT POINTERS TEXTP PUSHF /TRANSFER DATAPC+1 TO THE TEXT POINTERS DATAPC+1 POPF TEXTP TAD DATAPC+4 DCA CHAR TAD MODE /SAVE MODE WHERE IT WON'T BE DESTROYED BY A *FIND* DCA PT1 TSTEND /MORE DATA AVAILABLE? JMP INRDAT /YES: USE IT ISZ INREAD /SET UP SKIP RETURN JMP I INREAD /EXIT INRDAT, TSTCOM /COMMA SEPARATOR? ERR490, ERROR /NO: DATA TO INPUT OR READ IN IMPROPER FORM GETC /SKIP OVER THE COMMA INRMOD, ISZ PT1 /STRING OR NUMERIC DATA ITEM? JMP INRNUM /NUMERIC PUSHJ /STRING QINP JMP .+3 INRNUM, PUSHJ EVAL TAD CHAR /SAVE DATA TEXT POINTERS AT DATAPC+1 DCA DATAPC+4 PUSHF TEXTP POPF DATAPC+1 POPF /RESTORE STUFF PERTAINING TO VARIABLE LIST TEXTP POPF PT1 FLPUT /SET THE VARIABLE ACX TSTEND /END OF VARIABLE LIST? SKP JMP I INREAD /YES: DONE TSTCOM /COMMA SEPARATOR? ERR500, ERROR /NO: ILLEGAL SYNTAX IN INPUT OR READ GETC /SKIP OVER THE COMMA JMP INRVAR /GO DO THIS VARIABLE
/TEXT INITIALIZATION ROUTINES INPACK, 0 TAD COMBUF DCA AXIN DCA XCTIN TAD COMBUF DCA PACKST TAD LALINE0 DCA PACKND JMP I INPACK OTPACK, 0 TAD COMBUF DCA AXOUT DCA XCT DCA SPACSW TAD LPDLXR DCA PACKND GETC JMP I OTPACK PAKLIN, JMS INPACK READC PACKC TSTCCR JMP .-3 PACKC /FINISH PACKING CR JMS OTPACK POPJ GETMOR, 0 SKP GETC TSTEND JMP .-2 /GO TO TERMINATOR TAD CHAR TAD LM72 /COLON SNA CLA JMP .+3 /MORE TO COME ON THIS LINE GETNXT /THIS LINE FINISHED;FIND ANOTHER JMP I GETMOR /OUT OF TEXT ISZ GETMOR JMP I GETMOR LALINE0, ALINE0 LPDLXR, PDLXR LM72, -72 PAGE
/NEW EXTENDED *IF* COMMAND IF, DCA MODE /INITIALIZE MODE PUSHJ EVAL PUSHF FLARG TAD SORTCN TAD M12 SPA ERR390, ERROR CLL CML RTL DCA IF6 GETC L7777 DCA SORTCN SORTC TERMS+11 GETC TAD SORTCN TAD IF6 SORTC IF4-1 SKP JMP ERR390 TAD SORTCN TAD KIF5 DCA IF6 TAD I IF6 DCA IF6 PUSHJ EVAL POPF FLARG COMMAN 35 /-THEN CODE SZA ERR400, ERROR ISZ MODE /STRING OR NUMERIC COMPARE? JMP IF8 /NUMERIC TAD LACX /DO STRING COMPARE DCA T1 /POINT TO FAC TAD FLARGP DCA T2 /POINT TO FLARG L7775 DCA MODE /COUNT FOR 3 WORDS IFS1, TAD I T2 /THE FOLLOWING GARBAGE CONVERTS CR'S CMA /TO 0, SPACES TO 1, ... ,^ TO 77 AND C77 /SO THAT "A"<"AA". SZA CLA TAD C7700 DCA T3 TAD I T1 CMA AND C77 SZA CLA TAD C7700 TAD I T2 CIA TAD I T1 TAD T3 SZA /THESE TWO CHARS THE SAME? JMP IF6 /NO: THIS IS THE NUMBER ISZ T1 /YES: COMPARE NEXT TWO CHARS ISZ T2 ISZ MODE /COMPARED 6 CHARS YET? JMP IFS1 /NOPE, THEN DO COMPARE IF6, HLT TESTN JMP IF7 JMP I KEX2 JMP I KGOTO IF7, GETNXT JMP I KREADY JMP I KEX1 KEX1, RUN4 KEX2, RUN4+1 KGOTO, GOTO KREADY, READY KIF5, IF5 LFFSUB, FFSUB IF8, JMS I LFFSUB /NUMERIC COMPARE: FLOATING POINT SUBTRACTION FLARG TAD ACH /GET SIGN OF DIFFERENCE IN AC JMP IF6 /GO TEST IT
/*FREE* ROUTINE XFREE, 0 UDF TAD I OPTRI /ANY ROOM CDF SZA CLA JMP I XFREE /NO TAD OPTRI CIA TAD OPTRO SPA SNA TAD C40 CIA /-COUNT IAC SNA JMP I XFREE /ONLY 1 FREE IAC SNA JMP I XFREE /ONLY 2 FREE ISZ XFREE TAD FREEC SPA SNA CLA ISZ XFREE /14 OR MORE FREE JMP I XFREE /*FREE2* AND *FREE13* ROUTINES XFREE2, 0 JMS XFREE /ROOM JMP .+3 /WE MUST WAIT LACX, ACX /A HARMLESS CONSTANT IF ACX<1000 JMP I XFREE2 TAD XFREE2 JMP FREEWT /GET ROOM PXOR, XOR XFREE3, 0 JMS XFREE /ROOM FREEC, 14 SKP /MUST WAIT JMP I XFREE3 TAD XFREE3 FREEWT, DCA PC /SET RESTART TAD I LOOK JMS I PXOR /SET O WAIT AND DISMISS 2000 PAGE
/*LET* AND *FOR* COMMANDS FOR, L7777 LET, DCA FOR1 /SAVE DETERMINATOR PUSHJ /GET VARIABLE GETVAR SNA CLA /WAS FUNCTION!?! TAD CHAR TAD MEQL SZA CLA ERR410, ERROR /NO "=" LET2, TAD LINENO DCA FOR6 /SAVE LINE NUMBER OF LET STMNT PUSHF /SAVE ADD,XCTIN,PT1 ADD PUSHJ /GET VALUE EVAL-1 POPF ADD FLPUT /SET VARIABLE FLARG L7777 /COUNT BACK FOR SAFETY TAD AXOUT DCA FOR5 ISZ FOR1 /WHICH COMMAND? JMP LET1 /LET COMMAND TAD ADD SPA CLA ERR420, ERROR /SUBSCRIPTED COMMAN /GET WORD 33 /-TO SZA CLA JMP FOR2+3 /NOT *TO* TAD PT1 CIA DCA FOR1 /SAVE POINTER PUSHJ /GET LIMIT EVAL PUSHF /SAVE LIMIT FLARG TSTEND JMP FOR2 /GET INCREMENT PUSHF /INCREMENT IS ONE ONE FOR3, TAD LINENO /START LOOKING FROM HERE DOWN SKP FOR4, POPA FIND /FIND A *NEXT* STATEMENT 31 /-NEXT CODE ERR440, ERROR /OUT OF TEXT PUSHA /SAVE FOR RESTART TSTALP JMP FOR4 PUSHJ /GET VARIABLE GETVAR SNA CLA /NO SECOND CHANCE ON FUNCTION TAD PT1 TAD FOR1 SZA CLA JMP FOR4 /LOOP ISZ PDLXR /DUMP RESTART ADDRESS TSTCCR JMP I FOR2-1 /WE MUST CHECK NOW, BEFORE INITIALIZATION, OR WE MIGHT /WIPE OUT HIS PROGRAM [AND THE SYSTEM?] TAD FOR6 UDF DCA I AXOUT /SET TEXT AND LINE POINTERS TAD FOR5 DCA I AXOUT /SET POINTER CDF POPF /GET INCREMENT FLARG TAD AXOUT FLPUT /PUT INCREMENT FLARG POPF /GET LIMIT FLARG L0003 TAD AXOUT FLPUT /SET LIMIT FLARG LET1, TAD FOR6 DCA LINENO /SET LINE POINTER TSTEND ERR450, ERROR /JUNK FINDLN /FIND US AGAIN 0 TAD FOR5 DCA AXOUT /BACK WHERE WE WERE DCA CHAR /GETMOR WILL TAKE CARE OF THIS DCA XCT JMP I CCONT ERR460 /POINTER TO *NEXT* ERROR FOR2, COMMAN 32 /-STEP CODE SZA ERR430, ERROR /NOT STEP PUSHJ /GET INCREMENT EVAL PUSHF /SAVE INCREMENT FLARG TSTEND JMP FOR2+3 /JUNK JMP FOR3 FOR1, 0 FOR5, 0 /AXOUT SAVE REG FOR6, 0 /LINEPC SAVE REG MEQL, -75 /-EQUALS / /NEGATE OPERAND / OPNEG, 0 TAD OPL /GET LOW ORDER CLL CMA IAC /NEGATE AND STORE BACK DCA OPL CML RAL /PROPAGATE CARRY TAD OPH /GET HI ORDER CLL CMA IAC /NEGATE AND STORE BACK DCA OPH JMP I OPNEG /*POPA* ROUTINE XPOPA, 0 UDF TAD I PDLXR CDF JMP I XPOPA PAGE
/*DELETE* ROUTINE XDELET, 0 FINDLN /FIND THE LINE JMP I XDELET /NOT THERE - EXIT ISZ SPACSW GETC TSTCCR /GO TO END OF LINE JMP .-2 TAD AXOUT CMA TAD LINEPC PUSHA /SAVE COUNT TAD LINEPC IAC DCA AXOUT /TO UNPACK DCA XCT PUSHJ ENDFND /GET LAST COMMAND HERE SNA CLA TAD MN10 POPA DCA T3 /CORRECTED COUNT TAD LINEPC CIA TAD ALINE0 SNA CLA JMP I XDELET /NOT LINE0 UDF TAD I LINEPC /GET POINTER DCA I LASTLN /REMOVE LINE TAD ALINE0 XDEL3, DCA T2 /CURRENT LINE TAD I T2 SNA JMP XDEL2 /OUT OF TEXT DCA T1 TAD LINEPC CLL CIA TAD T1 SZL CLA TAD T3 /CORRECT LINE TAD T1 DCA I T2 TAD T1 JMP XDEL3 MN10, -10 PERR, ERR100-2 XDEL2, L7777 TAD LINEPC DCA XREG3 TAD T3 CMA TAD LINEPC DCA AXOUT TAD T3 TAD BUFR DCA BUFR TAD AXIN CMA TAD AXOUT DCA T1 TAD T3 TAD AXIN DCA AXIN TAD I AXOUT DCA I XREG3 /MOVE TEXT ISZ T1 JMP .-3 JMP XDELET+1
/PUSH ROUTINES XPUSHA, 0 DCA T3 L7777 /BACK 1 JMS PCHK TAD T3 UDF DCA I PDLXR /PUSH IT CDF L7777 JMS PCHK /BACK AGAIN JMP I XPUSHA XPUSHJ, 0 TAD I XPUSHJ /GET SEND ADDRESS DCA XPUSHA TAD XPUSHJ /GET RETURN ADDRESS IAC JMP XPUSHA+1 PCHK, 0 TAD PDLXR DCA PDLXR L0002 TAD LASTV CLL CIA TAD PDLXR SNL CLA JMP I PERR JMP I PCHK /*PUSHF* ROUTINE XPUSHF, 0 L7777 TAD I XPUSHF DCA XREG3 /POINT TO DATA L7775 JMS PCHK /BACK 3 L7775 DCA T3 TAD I XREG3 UDF DCA I PDLXR /PUSH DATA CDF ISZ T3 JMP .-5 L7775 JMS PCHK /BACK 3 AGAIN ISZ XPUSHF JMP I XPUSHF /HERE WE TRANSFER CONTROL TO *MANCOM* IN FIELD 1 F0CMAN, 0 CIF 10 JMP I F0CMNP F0CMN1, TAD I F0CMAN ISZ F0CMAN JMP I F0CMAN F0CMNP, MANCOM /*RANDOMIZE* STATEMENT PINTCN, INTCNT RANDOM, TAD FRNDX+1 TAD I PINTCN /RANDOMIZE FRNDX DCA FRNDX+1 /REPLACE JMP I CCONT PAGE
/STRING FUNCTIONS!!! /MID FUNCTION: MID(A$,P,L) MID, 0 JMS SSR1 /TAKE CARE OF 1ST ARG & TEST FOR 2ND PUSHJ /GET SECOND ARG EVAL-1 JMS I INTEGE /CONVERT TO 1 WORD INTEGER IN AC CIA /AC=-AC PUSHA /SAVE SECOND ARGUMENT TSTCOM /IS THIRD ARGUMENT THERE? JMP ERRSAR /NO: MISSING ARG TO STRING FUNCTION PUSHJ /GET 3RD ARG EVAL-1 JMS I INTEGE /AND CONVERT TO 1 WORD INTEGER CMA /AC=-AC-1 DCA T1 /SAVE IN T1 POPA /GET SECOND ARG DCA T2 /STORE IN T2 JMS SSR2 /SET UP PACKING AND UNPACKING ON STACK MID2, GETC /GET NEXT CHAR OF STRING ARG ISZ T2 /SHOULD WE WASTE A CHAR? JMP MID1 /YES MID5, ISZ T1 /END OF RESULT STRING? JMP MID3 /NOT YET MID4, TAD CCR /SET UP TO PACK A CR DCA CHAR MID6, JMS I CPACK /INDICATE END OF RESULT STRING JMS SSR3 /RESTORE TEXT POINTERS & OTHER GARBAGE SFNEND, JMS I (PARTST /CHECK PARENTHESIS MATCH & CLEAN UP STACK ISZ PDLXR /SKIP PAST SAVED MODE L7777 /AC INDICATES STRING MODE JMP I (ENDFUN+2 /GO SET MODE AND FINISH FUNCTION PROCESSING MID3, TSTCCR /END OF RESULT STRING? SKP JMP MID6 /YES, SO END IT JMS I CPACK /PACK CHAR INTO RESULT STRING GETC /GET NEXT CHAR OF ARGUMENT JMP MID5 /GO DECIDE WHAT TO DO WITH IT MID1, TSTCCR /END OF ARG WHILE STILL WASTING CHARS? JMP MID2 /NO, CONTINUE... ERRSOV, ERROR /YES: STRING OVERFLOW /STRING SUBROUTINE 1 SSR1, 0 L7777 PUSHA /END OF STRING MARKER FOR 6 CHAR STRINGS PUSHF /SAVE FIRST ARG ON STACK ACX TSTCOM /IS 2ND ARG THERE? ERRSAR, ERROR /NO: MISSING ARG TO STRING FUNCTION JMP I SSR1 /EXIT /STRING SUBROUTINE 2 SSR2, 0 TAD PDLXR DCA AXIN /SET UP TO PACK ONTO STACK DCA XCTIN /HOUSEKEEPING PUSHF /SAVE TEXT POINTERS TEXTP TAD CHAR PUSHA TAD AXIN /STILL POINTER TO STRING ARG DCA AXOUT /SET UP TO UNPACK FROM STACK DCA XCT /HOUSEKEEPING ISZ SPACSW /KEEP SPACES JMP I SSR2 /EXIT /STRING SUBROUTINE 3 SSR3, 0 JMS I CPACK /PACK AN EXTRA CR JUST TO BE SURE POPA /RESTORE TEXT POINTERS DCA CHAR POPF TEXTP POPF /PUT RESULT OF FUNCTION IN FAC ACX ISZ PDLXR /GET RID OF THE 2 CR'S DCA SPACSW /IGNORE SPACES JMP I SSR3 /EXIT /CONCATENATE FUNCTION: CAT(A$,B$) CAT, 0 JMS SSR1 /TAKE CARE OF STRING ARG PUSHJ /GET 2ND STRING ARG EVAL-1 POPF /CLEAR STACK FLARG PUSHF /PUSH STUFF ONTO STACK ACX L7777 /2 CR'S PUSHA /ON STACK PUSHF /STACK CONTAINS: ARG1,CR CR,ARG2,CR CR FLARG JMS SSR2 /SAVE TEXT, SET UP PACKING & UNPACKING SKP /NO PACKC FIRST TIME THRU JMS I CPACK /PACK CHAR INTO RESULT STRING GETC /GET NEXT CHAR OF FIRST STRING ARG TSTCCR /END OF 1ST ARG? JMP .-3 /GO PACK & CONTINUE TAD PDLXR TAD (10 /CALCULATE ADDR OF 2ND STRING ARG DCA AXOUT /SET UP TO UNPACK IT DCA XCT GETC /GET NEXT CHAR OF 2ND STRING ARG JMS I CPACK /PACK CHAR INTO RESULT STRING TSTCCR /END OF 2ND ARG? JMP .-3 /NO: CONTINUE TRANSFERRING 2ND ARG JMS SSR3 /RESTORE TEXT L0004 /CLEAN UP STACK TAD PDLXR DCA PDLXR JMP SFNEND /GO DO SPECIAL STRING FUNCTION END /LENGTH FUNCTION: LEN(A$) LEN, 0 TAD (ACX-1 DCA FLTXR /POINTER TO ARGUMENT TAD M6 DCA MODE /MULTIPURPOSE COUNTER LEN1, CLL IAC TAD C77 /L & AC = 00100 TAD I FLTXR SZL /LINK=1 IF LEFT HALF WAS 77 (A CR) JMP LEN2 /END OF STRING, DONE COUNTING ISZ MODE /COUNT CHARACTOR IAC /IF RIGHT HALF OF AC WAS 77, IS NOW 00. AND C77 /LOOK AT RIGHT HALF OF AC ONLY SNA CLA /WAS CHAR A CR? JMP LEN2 /YES ISZ MODE /NO: COUNT THE CHARACTOR JMP LEN1 /NOT YET AT MAXIMUM, CONTINUE LEN2, L0006 /OFFSET TO PROPERLY ADJUST CHAR COUNT TAD MODE /AC=LENGTH OF STRING ARGUMENT JMS I (FFLOAT /CONVERT TO FLOATING POINT JMP I LEN /EXIT
PAGE /*EDIT* COMMAND EDIT, GETLN /GET LINE NUMBER TSTCCR SKP /JUNK FINDLN /FIND THE LINE ERR001, ERROR /NOT THERE ISZ SPACSW JMS I CINPACK /SET TO PACK IT MODF2, CDF 10 DCA I LLSTMD /READ SILENTLY READC MODF3, TAD CHAR CDF 10 DCA I LLSTMD /SET SEARCH CHARACTOR MODF1, FREE2 GETC PRINTC /PRINT LINE UNTIL... SORTJ F1CCR-1 MODL1-F1CCR PACKC /KEEP PACKING JMP MODF1 MODF4, PACKC /PACK IT READC /GET CHARS SORTJ /CHECK THEM F1CCR-1 MODL2-F1CCR JMP MODF4 MODF5, PACKC /PACK THE CR PACKC JMS I COTPACK /SET TO UNPACK IT JMP I CSRETN /*DELETE* COMMAND DELET, JMS GETLIM /GET LIMITS TAD BUFR DCA AXIN /PROTECT TEXT JMS GETLIN /GET A LINE JMP I CREADY /WE ARE DONE JMS I CXDELET /DELETE IT TAD LASTLN DCA LINEPC /RESTORE POINTERS JMP .-5 /LOOP
/*LIST* COMMAND LIST, JMS GETLIM /GET LIMITS ISZ SPACSW /KEEP SPACES TAD M100 DCA PT1 TAD OUTPUT SNA CLA JMP LLIST3-3 /NORMAL MODE DCA OUTPUT /WE WILL OUTPUT FOR A WHILE LLIST5, FREE2 CLA CLL CML RAR PRINTC /DO L/T ISZ PT1 JMP LLIST5 FREE2 TAD CCR PRINTC LLIST3, JMS GETLIN /GET A LINE JMP LLIST4 /WE ARE DONE FREE13 TAD LINENO JMS I CITPRNT /PRINT THE NUMBER TAD C40 PRINTC GETC FREE2 PRINTC /PRINT THE LINE TSTCCR JMP .-4 /UNTIL A CR JMP LLIST3 /LOOP LLIST4, TAD PT1 /DID WE PUNCH TRAILER?? SZA CLA JMP I CREADY /NORMAL SO EXIT TAD M100 DCA PT1 /DO IT AGAIN, TURN ECHO OFF LLIST6, FREE2 CLA CLL CML RAR PRINTC ISZ PT1 JMP LLIST6 JMP I CTAPE GETLIN, 0 GETNXT /GET NEXT LINE JMP I GETLIN /OUT OF TEXT POPA DCA T3 /GET LIMIT TAD T3 PUSHA /SAVE LIMIT TAD LINENO CIA TAD T3 SMA CLA ISZ GETLIN /OK JMP I GETLIN GETLIM, 0 TSTCCR JMP LIMGT1 /NOT ALL DCA LASTLN /START AT 0 L3777 JMP LIMGT3 LIMGT1, GETLN /GET A LINE NUMBER TAD LINENO DCA LASTLN /AND SAVE IT TSTCOM JMP LIMGT2 /ONLY ONE LINE GETC GETLN /GET LINE NUMBER TAD LINENO LIMGT3, PUSHA /UPPER LIMIT TAD LASTLN DCA LINENO /LOWER LIMIT TSTCCR JMP ERR001 /JUNK LIMGT4, FINDLN /FIND THE LINE CITPRNT, ITPRNT /OK NOT TO FIND IT TAD LASTLN DCA LINEPC /AND GO BACK ONE JMP I GETLIM LIMGT2, TAD LASTLN /1ST = 2ND JMP LIMGT3 CREADY, READY CXDELET, XDELET CTAPE, TAPE CINPACK, INPACK COTPACK, OTPACK CSRETN,SRETN
/*NEXT* COMMAND NEXT, PUSHJ /GET VARIABLE GETVAR SNA CLA /WAS FUNCTION? TSTCCR /*NEXT* !MUST! BE LAST ON LINE ERR460, ERROR JMS I (FFGET FLARG UDF TAD I AXOUT SNA ERR470, ERROR /NEXT NOT INITIALIZED DCA T2 TAD I AXOUT CDF DCA RUN9 /SAVE TEXT POINTER TO FOR STMNT TAD AXOUT FLGET /GET INCREMENT OPX TAD OPH NEXT3, SMA CLA TAD C50 /POSITIVE INCREMENT TAD NEXT3 /NEGATIVE INCREMENT DCA NEXT1 /SET LIMIT TEST INSTRUCTION JMS I (FFADD OPX FLPUT /SET VARIABLE ACX L0003 TAD AXOUT FLGET /GET LIMIT FLARG JMS I (FFSUB FLARG TAD ACH NEXT1, HLT /SKIP IF DONE JMP NEXT2 /NOT DONE L7777 TAD AXOUT DCA T1 UDF DCA I T1 /NOT INITIALIZED NOW CDF JMP CONT NEXT2, TAD T2 DCA LINENO FINDLN C50, 50 TAD RUN9 /GET TEXT POINTER TO FOR STMNT DCA AXOUT DCA XCT DCA CHAR JMP CONT
/NEW *RUN* COMMAND RUN, TAD STARTV DCA LASTV /RESET VARIABLES PUSHF /INITIALIZE RANDOM NUMBER FRNDX0 POPF FRNDX RUN1, FIND /FIND A NEXT TO UNINITIALIZE 31 /-NEXT CODE JMP RUN3 /NO MORE NEXT'S PUSHA /SAVE FOR NEXT FIND JMS RUN9 /DISMISS NOW SO AS TO NOT HOG THE CPU RUN2, PUSHJ GETVAR /THIS IS THE VARIABLE AFTER THE NEXT SNA CLA /FUNCTION? TSTCCR /ANYTHING AFTER NEXT STATEMENT? JMP ERR460 /MUST BE VARIABLE AND END OF LINE UDF /USER'S DATA FIELD DCA I AXOUT /UNINITIALIZE NEXT STATEMENT POPA /FOR FIND: SEARCH FROM THIS PLACE JMP RUN1 RUN3, TAD ALINE0 DCA LINEPC /BEGIN AT THE BEGINNING RESTOR, DCA DATAPC TAD CCR DCA DATAPC+4 CONT, JMS I (GETMOR /GET NEXT STMNT ON LINE JMP I (READY /WHOOPS-OUT OF TEXT RUN4, GETC COMMAN /GET KEYWORD CODE 11 /-BOUNDARY BETWEEN COOMANDS AND STATEMENTS SMA /COMMAND OR STATEMENT? ERR520, ERROR /COMMAND: NOT ALLOWED IN DEFERRED MODE TAD (COMGOL+41-11 /CALCULATE ADDRESS OF ADDRESS ... RUN5, DCA T1 /SAVE ADDRESS CDF SWAP /CHANGE TO DATA FIELD OF DISPATCH LIST TAD I T1 /GET ADDRESS OF CORRECT ROUTINE CDF /CHANGE DATA FIELD BACK DCA PT1 /SAVE ADDRESS TAD LINENO DCA ERLINE /SAVE CURRENT LINE NUMBER IN CASE IT CHANGES ISZ PC /HAVE WE DONE TWO COMMANDS WITHOUT DISMISSING? JMP I PT1 /NO: GO TO IT! JMS RUN9 /YES: DISMISS SO OTHERS CAN RUN JMP I PT1 /NOW GO TO IT. /*GOTO* COMMAND GOTO, GETLN /GET THE LINE NUMBER TSTEND /END OF THE STATEMENT? ERR270, ERROR /NO: JUNK /GO TO HERE IF PROGRAM IS SUPPOSED TO JUMP /LINE NUMBER TO TRANSFER TO IS IN LINENO. JUMP, FINDLN /FIND THE LINE TO GO TO ERR380, ERROR /NOT THERE: ERROR JMP RUN4 /THERE, SO GO DO IT RUN9, 0 /SUBROUTINE TO DISMISS TAD RUN9 /GET RETURN ADDRESS DCA PC /SAVE FOR RESTART JMP NULL /DISMISS INPUTX, TAD COMBUF /GET ADDRESS OF A ZERO WORD IN AC DCA LINEPC /STICK IN LINEPC SO IMMEDIATE MODE WILL STOP /WHEN DONE CMA /GET A -1 IN THE AC DCA LINENO /ALSO MAKE LINENO ILLEGAL COMMAN /GET KEYWORD CODE COMGOL+41 /ALL IS LEGAL IN IMMEDIATE MODE, SO MAY /AS WELL FIGURE ADDRESS NOW. JMP RUN5 /GO DO IT / /NEGATE FAC / FFNEG, 0 TAD ACLO /GET LOW ORDER FAC CLL CMA IAC /NEGATE IT DCA ACLO /STORE BACK CML RAL /ADJUST OVERFLOW BIT AND TAD ACH /PROPAGATE CARRY-GET HI ORD CLL CMA IAC /NEGATE IT DCA ACH /STORE BACK JMP I FFNEG
PAGE /EXPRESSION EVALUATOR ECALL, 0 TAD SORTCN PUSHA TAD LASTOP PUSHA TAD EFOP PUSHA TAD ECALL PUSHA /RETURN ADDRESS GETC EVAL, DCA LASTOP /0 IS END TAD EVAL1 PUSHA /SAVE EVAL1 DCA EVAL1 /0 EVAL1 TESTC JMP ETERM1 /INITIAL TERMINATOR JMP ENUM /NUMBER JMP EVAR /VARIABLE JMP I (EVALQ /CHECK FOR STRING CONSTANT ETERM1, TAD (FLZERO DCA PT1 /0 DATA L7776 TAD SORTCN SNA JMP ETERM /MINUS IAC SNA CLA JMP ARGNXT /PLUS ELPAR, TSTLPR JMP EVAL2 /CHECK UNARY EPAR2, JMS ECALL /RECURSIVE CALL ISZ PDLXR JMP I (ENDFUN-2 /END AS FUNCTION ENUM, TAD FLARGP DCA PT1 /DATA TO FLARG JMS I FLINTP /GET VALUE OPNEXT, ISZ EVAL1 JMP .+6 /NO UNARY FINT FGET I (FLZERO FSUB I PT1 FPUT I PT1 FEXT DCA EVAL1 TESTC JMP ETERMN /TERMINATOR CM10, -10 /CONSTANT 0 DCA SORTCN /ALL ELSE IS END ETERMN, TSTLPR SKP ERR120, ERROR /EXCESS L-PARENS ETERM, TAD SORTCN DCA THISOP /SET OP TAD THISOP TAD CM10 SMA CLA DCA THISOP /END ETERM2, TAD THISOP CIA TAD LASTOP /PRIORITIES SPA CLA JMP EPAR /NO GO YET TAD LASTOP TAD (OPTABL DCA CNTR TAD I CNTR DCA FLOP /SET OP TAD LASTOP SZA CLA POPF /GET DATA ACX FINT FLOP, FJMP I (FUPARR /FLOATING OP FPUT I FLARGP /SAVE DATA FEXT TAD FLARGP DCA PT1 /POINT TO DATA TAD THISOP TAD LASTOP SNA CLA JMP EVAL3 /DONE POPA DCA LASTOP /NEW OP JMP ETERM2 EPAR, TSTLPR SKP JMP EPAR2 /DO RECURSIVE TAD LASTOP PUSHA TAD PT1 DCA .+2 PUSHF /SAVE DATA 0 TAD THISOP DCA LASTOP ARGNXT, GETC TESTC JMP ELPAR /T JMP ENUM /N JMP EVAR /V JMP I (EVALQ /OTHER-MIGHT BE STRING CONSTANT EVAR, PUSHJ /GET VARIABLE GETVAR SZA JMP I (FUNCT3 /FUNCTION TAD FLARGP DCA PT1 /POINT TO DATA JMP OPNEXT EVAL2, L7776 TAD SORTCN /IS IT + OR -? SMA SZA ERR110, ERROR /NO - DOUBLE OPS OR EX L-PARENS SZA CLA JMP ARGNXT /WAS + TAD EVAL1 CMA DCA EVAL1 /FLIP EVAL1 JMP ARGNXT EVAL3, POPA DCA EVAL1 /RESTORE EVAL1 POPJ /EXIT
PAGE /USER FUNCTION PROCESSING FUNCT6, PUSHA /SAVE CHARACTER DCA EFOP ISZ EFOP PUSHF /SAVE ARGS FLARG TSTCOM JMP .+6 /NO MORE ARGS JMS I (ECALL /GET NEXT POPA ISZ PDLXR ISZ PDLXR JMP .-12 TAD LASTV DCA SUBS /SAVE END OF VARIABLES TAD EFOP FUNC10, DCA T2 L2000 TAD T2 DCA ADD /CREATE ILLEGAL NAME PUSHJ /LOOK IT UP - WILL DEFINE LOOKUP POPF FLARG FLPUT /SET ARGUMENT FLARG L7777 TAD T2 SZA JMP FUNC10 /MORE ARGUMENTS L4000 POPA CIA DCA FUNC17 /-CHAR OF FUNCTION PUSHF TEXTP TAD SORTCN PUSHA JMP I (FUNC18 /GO SAVE REST FUNC11, POPA FIND /FIND A *DEF* 23 /-DEF CODE ERR170, ERROR /OUT OF TEXT PUSHA /FOR RESTART COMMAN /GET WORD 22 /-FN CODE SZA CLA JMP FUNC11 TAD CHAR TAD FUNC17 SZA CLA JMP FUNC11 /NOT PROPER FUNCTION ISZ PDLXR POPA DCA LINEPC TAD ERLINE PUSHA /SAVE CALLING LINE TAD LINENO DCA ERLINE /CALL THIS OUT LINE GETC SORTC TERMS-1 SKP ERR180, ERROR /NO L-PAREN TSTLPR JMP .-2 TAD SORTCN PUSHA GETC L2000 DCA T1 TAD LASTV DCA PT1 /POINT TO ARGUMENTS FUNC14, TSTALP JMP .-13 /ILLEGAL VARIABLE TAD CHAR AND C37 RTL6 RAR DCA T2 /SAVE NAME GETC TESTN C37, 37 JMP FUNC13 /NOT NUMBER TAD SORTCN CLL IAC RAL TAD T2 DCA T2 GETC FUNC13, ISZ T1 /SET ILLEGAL NAME UDF TAD I PT1 CIA TAD T1 SZA CLA ERR200, ERROR /WRONG NUMBER OF ARGUMENTS TAD T2 DCA I PT1 /SET TEMPORARY NAME CDF TAD M4 TAD PT1 DCA PT1 /POINT TO NEXT TSTCOM JMP FUNC12 /NO MORE GETC JMP FUNC14 FUNC17=FFLAG FUNC12, ISZ T1 UDF TAD I PT1 CDF CIA TAD T1 SNA CLA JMP FUNC13+6 /SHOULD NOT AGREE SORTC TERMS-1 SKP JMP FUNC14-12 /NO PAREN L7776 TAD SORTCN CIA POPA SZA CLA JMP FUNC14-12 /NO MATCH JMP I (FUNC16
PAGE /*PRINT* COMMAND PRINT5, GETC /SKIP OVER THE ";" OR "," CMA /AC=-1, INDICATING ";" OR "," PRINT, DCA PT1 /SET FLAG PT1 WITH AC SORTJ /CHECK ; , ' : CR " PRINL-1 PRINL1-PRINL TAD PT1 /TAB,CHR$,OR EXPRESSION SMA SZA CLA /CHECK 3-WAY FLAG ERR350, ERROR /SYNTAX ERROR FREE13 /FREE 13 SPACES IN OUTPUT BUFFER TAD (LISTCH-LIST43 /SET UP TO SEARCH SPECIAL LIST COMMAN /TEST IF CHR$ OR TAB 40 /-TAB CODE SZA /TAB? JMP PRINT2 /NO: GO CHECK OTHER POSSIBILITIES JMS PRINT8 /EVALUATE ARGUMENT DCA PT1 /SAVE ARGUMENT PRIN11, TAD PT1 /GET ARG TAD (-110 /TAKE ARG MOD 72 DECIMAL SMA /REDUCED ENOUGH YET? JMP .-2 /NO CLL CMA IAC TAD PRNTC1 /COMPARE WITH CURRENT POSITION SNA /THERE ALREADY? JMP PRIN12 /YES: ALL DONE SO GO DCA ADD /SAVE COUNT SNL /GONE PAST ALREADY? JMP PRIN13 /NO: GO SPACE AHEAD TAD CCR /ASCII FOR A CARRIAGE RETURN IOF /AN INTERRUPT WOULD MESS THINGS UP JMS I (XOUTL2 /GO PRINT CR WITH NO LINE FEED ION /OK TO INTERRUPT NOW TAD (-110 /-72 DECIMAL DCA PRNTC1 /INDICATE BEGINNING OF LINE JMP PRIN11 /DO TAB AGAIN PRIN13, FREE2 /TO AVOID OUTPUT OVERFLOW TAD C40 /ASCII FOR SPACE PRINTC /PRINT THE SPACE ISZ ADD /PRINT ANOTHER? JMP .-4 /YES PRIN12, IAC /AC INDICATES WE JUST DID EXPRESSION JMP PRINT /GO PROCESS REST OF STATEMENT PRINT2, SMA CLA /CHR$? JMP PRINT3 /NO: MUST BE EXPRESSION JMS PRINT8 /EVALUATE ARG TO CHR$ IOF /CAN'T HANDLE INTERRUPTS NOW JMS I (XOUTL2 /SNEAK IN THE CHARACTOR ION /INTERRUPTS OK JMP PRIN12 /DONE PRINT3, DCA MODE /CLEAR STRING MODE FLAG PUSHJ /GET EXPRESSION EVAL ISZ MODE /STRING OR NUMERIC? JMP PRIN33 /NUMERIC L7777 /AC CONTAINS 2 CR'S IN PACKED FORMAT PUSHA /PUT END OF STRING MARK ON STACK PUSHF /PUT STRING ON STACK ACX JMS I (SSR2 /SAVE TEXT POINTERS, UNPACK FROM STACK SKP PRINTC /PRINT STRING CHARACTOR GETC /GET STRING CHARACTOR TSTCCR /END OF STRING? JMP .-3 /NO: CONTINUE PRINTING IT JMS I (SSR3 /RESTORE TEXT, CLEAN UP STACK JMP PRIN12 /DONE WITH STRING EXPRESSION PRIN33, TAD PRNTC1 /GET LOCATION ON TTY LINE TAD (16 /CHECK SPACES LEFT SPA SNA CLA /WILL IT FIT? JMP PRIN34 /YES TAD CCR /NO: MAKE IT FIT PRINTC /PRINT CR PRIN34, JMS I FLOUTP /GO PRINT THE FLOATING POINT NUMBER FREE2 /MAKE ROOM IN OUTPUT BUFFER TAD C40 /ASCII FOR SPACE PRINTC /PRINT THE SPACE AFTER THE NUMBER TSTCOM /A FOOLISH TEST IN CASE NUMBER WAS VERY LONG JMP PRIN12 /WASN'T COMMA ANYWAY PRIN41, L0002 /JUST A CUTE OFFSET TAD PRNTC1 /TTY LOC TAD (16 SPA JMP .-2 SNA CLA /AT START OF PRINT ZONE? JMP PRINT5 /YES: NOW PROCEED AS IF SEMICOLON PRINT4, FREE2 TAD C40 PRINTC /PRINT SPACE JMP PRIN41 /NOW CHECK FOR START OF PRINT ZONE PRINT6, ISZ SPACSW /KEEP SPACES GETC /GET NEXT CHARACTOR DCA SPACSW /IGNORE SPACES SORTJ /CHECK CR " PRINLB-1 PRINL2-PRINLB FREE2 /GET SPACE PRINTC /PRINT THE LITERAL JMP PRINT6 /GO DO NEXT CHARACTOR PRIN61, GETC /SKIP OVER THE " JMP PRINT /DONE WITH LITERAL PRINT7, TAD PT1 /GET THE FLAG SPA CLA /GO TO NEW LINE BEFORE EXITING? JMP I CCONT /NO: DONE WITH PRINT STATEMENT PRIN71, FREE2 /GET ROOM TAD CCR /ASCII FOR CR PRINTC /PRINT THE CR JMP I CCONT /DONE WITH PRINT STATEMENT PRINT8, 0 /SUBROUTINE TO EVALUATE TAB AND CHR$ ARGS SORTC /SET UP SORTCN FOR TSTLPR TERMS-1 TSTLPR ERR340, ERROR /NO LEFT PARENTHESIS FOR TAB OR CHR$ JMS I (ECALL /EVALUATE EXPRESSION RECURSIVELY ISZ PDLXR /DUMP EFOP JMS I (PARTST /CHECK PARENTHESIS MATCH, CLEAN UP STACK JMS I INTEGE /CONVERT FAC TO 1 WORD INTEGER JMP I PRINT8 /EXIT, AC=ARG
PAGE XOUTL2, 0 CDF 10 DCA XREG3 /SAVE CHAR TAD OUTPUT SZA CLA JMP XOUTL4 /NO ECHO TAD TELSW /BUSY SZA CLA JMP XOUTL5 /YES TAD (10 TAD XIOT DCA XOUTL6 /SET OUTPUT IOT TAD DECK CLL CML CMA DCA T3 SKP RAR ISZ T3 JMP .-2 MTON /TURN ON PROPER USER CLA TAD XREG3 TAD (200 /TURN THE @?#$%&' 8TH BIT ON!! XOUTL6, HLT DCA TELSW /SET BUSY TAD I (AUSER MTON /ALL ON AGAIN L0001 MINT /WITH INTERRUPTS CLA JMP XOUTL4 XOUTL5, UDF TAD I OPTRI /ROOM SZA CLA ERR080, JMS IERROR /NO ROOM UDF TAD XREG3 DCA I OPTRI /FILL BUFFER ISZ OPTRI /BUMP BUFFER TAD OPTRI CIA TAD IPTR0 SZA CLA JMP XOUTL4 /OK TAD IPTR0 TAD M40 DCA OPTRI /RESET BUFFER XOUTL4, CDF JMP I XOUTL2
/*FINDLN* ROUTINE XFINDL, 0 TAD LINENO SPA CLA JMP XFNDL3 UDF TAD ALINE0 DCA LASTLN TAD ALINE0 XFNDL1, DCA LINEPC /CURRENT LINE TAD LINEPC DCA XREG3 TAD LINENO CIA TAD I XREG3 SNA JMP XFNDL2-1 /FOUND LINE SMA CLA JMP XFNDL2 /WENT BEYOND TAD LINEPC DCA LASTLN TAD I LINEPC SZA JMP XFNDL1 /LOOP SKP /OUT OF TEXT ISZ XFINDL /FOUND LINE XFNDL2, TAD LINEPC IAC DCA AXOUT /SET TO UNPACK DCA XCT CDF JMP I XFINDL XFNDL3, ISZ XFINDL JMP .-3
/ERROR ENTERING ROUTINES XERROR, 0 IOF CLA IERRO1, CDF TAD (NULL DCA IERROR IERRO2, TAD XERROR CLL RAR /FORM ERROR CODE DCA PT1 L3777 AND I TEMP2 /CLEAR I WAIT DCA I TEMP2 TAD (ERRORX DCA PC /SET FOR RESTART JMP I IERROR IERROR, 0 L7777 TAD M40 TAD IPTR0 DCA XREG3 TAD M40 DCA T3 /BUFFER COUNT UDF DCA I XREG3 /CLEAR BUFFER ISZ T3 JMP .-2 CDF TAD OPTRI DCA OPTRO TAD IERROR DCA XERROR TAD LOOK CIA TAD TEMP2 SNA CLA JMP IERRO1 /RUNNING JMP IERRO2 /NOT RUNNING
/*UDF* ROUTINE XUDF, 0 CDF 10 /BECOMES CDF TO USER'S FIELD JMP I XUDF ERR330, ERROR /TOO MANY *RETURN*S
PAGE /*PACKC* ROUTINE XPACKC, 0 JMS XCPACK /PACK THE CHARACTOR TAD I PACKND TAD M12 CLL CIA TAD AXIN SZL CLA ERR060, ERROR /TOO FAR XPACK5, JMP I XPACKC XCPACK, 0 /BASIC UNCOMPLICATED PACK ROUTINE SORTJ /CHECK FOR CR,BELL,RUBOUT,_,ALTMODE,@ XPAKL1-1 XPAKL2-XPAKL1 TAD CHAR /CONVERT TO SIXBIT TAD M40 XPACK4, ISZ XCTIN JMP XPACK1 /NO PARTIAL TAD ADD /FORM WORD UDF DCA I AXIN /PACK IT CDF DCA ADD /RESET PARTIAL JUST TO BE SAFE JMP I XCPACK XPACK2, TAD (37 XPACK3, TAD C40 JMP XPACK4 XPACK1, RTL6 DCA ADD /SAVE PARTIAL L7777 DCA XCTIN /INDICATE PARTIAL JMP I XCPACK XPACK7, ISZ XCTIN /PARTIAL HERE JMP XPACK8 /NO XPACK9, DCA ADD TAD C137 PRINTC /PRINT BACK ARROW JMP I XPACKC XPACK8, TAD PACKST CIA TAD AXIN SNA CLA JMP I XPACKC /ALL GONE ANY HOW TAD AXIN DCA T3 L7777 DCA XCTIN /INDICATE PARTIAL L7777 TAD AXIN DCA AXIN /PUT IT BACK ONE UDF TAD I T3 /GET OLD AND C7700 JMP XPACK9 XPPCK1, PUSHF /SAVE TEXT POINTERS TEXTP TAD XPACKC PUSHA /SAVE ADDRESS IF DISMISSED FREE13 TAD CCR JMS I (READY1 /PRINT "$ DELETED,CR" POPA DCA XPACKC /RESTORE ADDRESS TAD PACKST DCA AXIN POPF TEXTP DCA CHAR JMP XPACK1+3
/*READC* ROUTINE XREADC, 0 UDF TAD I IPTRO /GET CHAR DCA CHAR /SET CHARACTER DCA I IPTRO /CLEAR BUFFER CDF TAD CHAR SNA CLA /WAS THERE A CHARACTER JMP XREAD1 /NO - WAIT ISZ IPTRO /BUMP BUFFER TAD IPTRO CIA TAD C40 TAD IPTR0 SZA CLA JMP .+3 /OK TAD IPTR0 DCA IPTRO /RESET BUFFER JMP I XREADC XREAD1, L7777 TAD XREADC DCA PC /SET TO REDO ROUTINE TAD I LOOK JMS I (XOR 4000 /I WAIT AND DISMISS
/*TSTLPR* ROUTINE LPRTST, 0 TAD SORTCN TAD M6 SPA CLA JMP I LPRTST /NOT L-PAREN TAD SORTCN TAD (-10 SPA CLA ISZ LPRTST /L-PAREN JMP I LPRTST
USER0, 0 USER1, 1 USER2, 2 USER3, 3 USER4, 4 USER5, 5 USER6, 6 USER7, 7 /CONTINUATION OF USER FUNCTION PROCCESSING FUNC18, TAD SUBS PUSHA TAD LINEPC PUSHA JMP I .+1 FUNC11+1
PAGE /*POPF* ROUTINE XPOPF, 0 L7777 TAD I XPOPF DCA XREG3 /POINT TO DATA AREA L7775 DCA T3 UDF TAD I PDLXR CDF DCA I XREG3 /MOVE DATA ISZ T3 JMP .-5 ISZ XPOPF JMP I XPOPF
/*TESTN* ROUTINE XTESTN, 0 TAD CHAR TAD (-60 DCA SORTCN /SAVE BINARY DIGIT L0002 TAD SORTCN SNA JMP I XTESTN /PERIOD ISZ XTESTN TAD (-13 SMA SZA CLA JMP I XTESTN /GREATER THAN 71 TAD SORTCN SMA CLA ISZ XTESTN /DIGIT JMP I XTESTN
/*GETC* ROUTINE XGETC, 0 ISZ XCT JMP XGET1 /NO PARTIAL TAD GTEM /GET PARTIAL XGET2, AND C77 /AND OFF JUNK TAD C40 /CORRECT TO ASCII DCA CHAR SORTJ /CHECK SPECIALS XGETL1-1 XGETL2-XGETL1 JMP I XGETC XGET1, UDF TAD I AXOUT /GET NEXT CDF DCA GTEM /SAVE PARTIAL L7777 DCA XCT /INDICATE PARTIAL TAD GTEM RTL6 RAL JMP XGET2 XGET3, TAD SPACSW /SPACE TEST SZA CLA JMP I XGETC /KEEP SPACES JMP XGETC+1 /IGNORE SPACES XGET4, TAD C7 /BELL XGET6, DCA CHAR JMP I XGETC XGET5, TAD CCR /CR JMP XGET6 /CONTINUATION OF RANDOM NUMBER GENERATOR RND1, TAD FRNDX+1 DCA FRNDX L3777 AND FRNDX DCA ACH TAD ACX DCA FRNDX+2 DCA ACX JMS I (FFNOR JMP I (RND2 /GO BACK TO EXIT
/*GETNXT* ROUTINE NXTGET, 0 UDF TAD I LINEPC /POINTER TO NEXT SNA JMP .+10 /OUT OF TEXT DCA LINEPC /NEW POINTER TAD LINEPC DCA AXOUT DCA XCT /SET TO UNPACK TAD I AXOUT /GET LINE NUMBER DCA LINENO ISZ NXTGET CDF JMP I NXTGET
/*FIND* ROUTINE XFIND, 0 DCA LINENO FINDLN SKP /NO TEXT XFIND1, JMS I (GETMOR /GET THE NEXT STATEMENT JMP XFIND2 /OUT OF TEXT GETC COMMAN 0000 TAD I XFIND /CORRECT COMMAND SZA CLA JMP XFIND1 /NO - LOOP ISZ XFIND TAD LINENO /FOR RESTART XFIND2, ISZ XFIND JMP I XFIND XPRNTC, 0 IOF PRINTX ION JMP I XPRNTC
/*RETURN* AND *POPJ* RETURN, TSTEND ERR320, ERROR XPOPJ, DCA XREG3 /SAVE AC UDF TAD I PDLXR CDF DCA T3 /RETURN ADDRESS TAD XREG3 /GET AC JMP I T3
/*OR* ROUTINE XOR, 0 DCA T3 TAD I XOR CMA AND T3 TAD I XOR DCA I LOOK JMP NULL
PAGE /CHARACTER TEST ROUTINES COMTST, 0 TAD (-54 /-COMMA TAD CHAR SNA CLA ISZ COMTST /FOUND IT JMP I COMTST CCRTST, 0 TAD CCRTST DCA COMTST TAD (-15 /-CR JMP COMTST+2 ENDTST, 0 TAD (-72 /-COLON TAD CHAR SZA TAD (-47+72 /TEST FOR APOSTROPHE SNA CLA IAC TAD ENDTST JMP CCRTST+2
ALPTST, 0 TAD CHAR TAD M100 SPA SNA CLA JMP I ALPTST /LESS THAN *A* TAD CHAR TAD (-132 SPA SNA CLA ISZ ALPTST /LETTER JMP I ALPTST
/*TESTC* ROUTINE XTESTC, 0 SORTC TERMS-1 JMP I XTESTC /TERMINATOR ISZ XTESTC TESTN JMP I XTESTC SKP JMP I XTESTC ISZ XTESTC TSTALP ISZ XTESTC /OTHER JMP I XTESTC /LETTER
/NEW *GOSUB* STATEMENT /IT IS NOW LEGAL TO HAVE STATEMENTS ON THE LINE AFTER GOSUB GOSUB, TAD AXOUT /LOCATION IN THE LINE PUSHA TAD LINENO /CURRENT LINE NUMBER PUSHA TAD CGOSB1 /POINTER TO GOSUB1 PUSHA JMP I (GOTO /NOW JUMP TO *GOTO* STATEMENT TO TRANSFER CONTROL /THE FOLLOWING ROUTINE DOES THE RETURN FROM A BASIC SUBROUTINE GOSUB1, POPA /GET LINE NUMBER OF CALLING *GOSUB* STATEMENT DCA LINENO /STORE FOR *FINDLN* FINDLN /FIND THE LINE CGOSB1, GOSUB1 /SHOULD NEVER RETURN TO HERE POPA /GET LOC. OF GOSUB IN LINE DCA AXOUT /STORE FOR THE TEXT UNPACKING ROUTINE GETC JMP I CCONT /GO EXECUTE STATEMENT AFTER GOSUB
/*NEW* AND *BYE* AND *SCRATCH* COMMANDS BYE, TSTCCR ERR002, ERROR /JUNK UDF DCA I ALINE0 /NO TEXT CDF L0002 TAD ALINE0 DCA BUFR /FREE UP TEXT SPACE END, TAD STARTV DCA LASTV JMP I (READY
/*ON* COMMAND ON, PUSHJ /GET VALUE EVAL COMMAN 37 /-GOTO SZA CLA ERR300, ERROR /NOT GOTO JMS I INTEGE CIA DCA T1 DCA T2 ON1, GETLN /GET A LINE NUMBER ISZ T1 JMP .+3 /NOT THIS ONE TAD LINENO DCA T2 TSTCOM JMP .+3 /TRY FOR CR GETC JMP ON1 TSTEND JMP ERR300 /JUNK TAD T2 SNA JMP I CCONT DCA LINENO JMP I CJUMP
OPTABL, FGET I PT1 FADD I PT1 FSUB I PT1 FMPY I PT1 FDIV I PT1 FJMP 0
/THIS WAS NECESSARY TO ALLOW *NEXT* ON THE SAME LINE WITH OTHER /THINGS (IT FINDS THE BEGINNING OF THE LAST STAEMENT ON A LINE) POPF FLARG ENDFND, DCA SPACSW PUSHF TEXTP GETC TSTEND JMP .-2 TSTCCR JMP ENDFND-2 /NOT LAST STATEMENT--TRY THE NEXT ONE POPF TEXTP GETC COMMAN 31 /-NEXT CODE POPJ
PAGE /GET A VARIABLE OR FUNCTION ROUTINE /EXIT WITH AC NON-ZERO IF FUNCTION /AC IS LIST POINTER UNLESS /AC IS NEGATIVE, THEN AC IS CHAR FOR USER FUNCTION GETVAR, TSTALP ERR220, ERROR /MUST BE LETTER TAD CHAR TAD M100 RTL6 RAR DCA ADD /SAVE FOR NAME GETC TESTC JMP SUBT /T - TEST FOR SUBSCRIPT JMP .+3 /N - ADD TO NAME JMP I FUNCTI /TRY FOR FUNCTION JMP GVS1 /O - TEST FOR STRING TESTN JMP LOOKUP /WAS A "." MDOLR, 200-"$ /SHOULD NEVER RETURN HERE TAD SORTCN /GET BINARY DIGIT VALUE CLL IAC RAL /MAKE NONZERO AND SHIFT INTO FIELD TAD ADD /FORM NEW NAME DCA ADD /STORE BACK GETC /SKIP OVER THE DIGIT GVS1, TAD CHAR TAD MDOLR /CHECK FOR STRING SZA CLA /STRING? JMP GVS2 /NO: CHECK FOR SUBSCRIPT L7777 /YES DCA MODE /SET STRING MODE ISZ ADD /ALSO INDICATE STRING IN ADD GETC /SKIP OVER THE "$" GVS2, SORTC TERMS-1 JMP SUBT LOOKUP, UDF TAD LASTV GS1, DCA PT1 /POINT TO VARIABLES TAD STARTV CIA TAD PT1 SNA CLA JMP GS2 /NOT FOUND AT ALL TAD I PT1 /GET NAME CLL CIA TAD ADD SNA JMP I GFND1I /FOUND NAME SNL CIA /POSITIVE DIFFERENCE CLL RTL /AC WILL BE 0 IF DIFFERENCE WAS 2000 SNA CLA ERR130, ERROR /ERROR - A(I) AND A(I,I) CANNOT EXIST TOGETHER TAD I PT1 SPA CLA L7777 /BACK 1 FOR SUBSCRIPT GS4, TAD M4 TAD PT1 JMP GS1 /LOOP GS2, TAD C7 TAD LASTV /ROOM LEFT CLL CIA TAD PDLXR SZL CLA JMP .+4 TAD STARTV DCA LASTV /KILL EM-OVFLOW ERR100, ERROR /NO ROOM L0004 TAD LASTV DCA PT1 /POINT TO NEW SPACE TAD ADD SMA CLA JMP GPUT1 TAD SUBS DCA I PT1 /SET SUBSCRIPT ISZ PT1 GPUT1, TAD ADD DCA I PT1 /SET NAME CDF TAD PT1 PUSHA L0001 TAD LASTV DCA PT1 /POINT TO NEW DATA SPACE POPA DCA LASTV /NEW LIMIT L0001 /SET UP FOR 0.0 OR NULL STRING AND ADD CIA TAD FLZROI DCA GPUT2 FLPUT /INITIALIZE GPUT2, FLZERO /BECOMES FLZERO OR FLZERO-1 JMP I GS5I FLZROI, FLZERO GFND1I, GFND1 SUB2I, SUB2 GS5I, GS5 PARTSI, PARTST FUNCTI, FUNCT ECALLI, ECALL SUBT, TSTLPR JMP LOOKUP /NOT SUBSCRIPTED TAD ADD DCA EFOP JMS I ECALLI /GET SUBSCRIPT L4000 POPA DCA ADD /SAVE NAME JMS I INTEGE SPA SUB1, ERROR /TOO BIG OR NEGATIVE ERR230=SUB1 DCA SUBS /SET SUBSCRIPT TSTCOM JMP I SUB2I /ONLY ONE SUBSCRIPT PUSHF /SAVE ADD,SUBS ADD PUSHJ /GET SECOND SUBSCRIPT EVAL-1 POPF ADD JMS I INTEGE DCA AC2 TAD AC2 AND C7700 SZA CLA JMP SUB1 /TOO BIG TAD SUBS AND C7700 SZA CLA JMP I SUB1I /TOO BIG TAD SUBS RTL6 TAD AC2 /FORM DOUBLE SUBSCRIPT DCA SUBS L2000 TAD ADD DCA ADD /INDICATE 2 SUBSCRIPTS SUB2, JMS I LITS JMP I LKUPI LKUPI, LOOKUP SUB1I, SUB1 PGS4, GS4 GFND1, TAD ADD SMA CLA JMP GFND2 /NO SUBSCRIPT L7777 TAD PT1 DCA PT1 TAD I PT1 /GET SUBSCRIPT CIA TAD SUBS SZA CLA JMP I PGS4 /WRONG SUBSCRIPT GFND2, CDF L7775 TAD PT1 DCA PT1 /POINT TO DATA GS5, FLGET /GET VARIABLE FLARG POPJ
FUNCT, TAD CHAR AND F37 TAD ADD SORTC FUNL1-1 SKP JMP I LKUPI /NOT A FUNCTION TAD SORTCN SNA CLA JMP FUNCT4 /USER FUNCTION PUSHF TEXTP TAD CHAR PUSHA GETC TAD CHAR DCA PT1 POPA DCA CHAR POPF TEXTP TAD SORTCN TAD LFUNL2 DCA T3 CDF SWAP TAD I T3 /GET CORRECT CODE CDF TAD PT1 SZA CLA JMP I LKUPI /WAS NOT A FUNCTION TAD SORTCN PUSHA /SAVE CONSTANT GETC FUNCT5, GETC SORTC TERMS-1 F37, 37 TSTLPR ERR240, ERROR /NO L-PAREN POPA IAC /FUNCTION CODE POPJ LFUNL2, FUNL2-1 FUNCT4, GETC TSTALP ERR250, ERROR /NOT LETTER L3777 TAD CHAR PUSHA /SAVE CHAR OF USER FUNCTION JMP FUNCT5
/*SORTJ* ROUTINE XSORTJ, 0 SNA TAD CHAR /USE CHAR IF AC IS 0 CIA DCA T3 TAD I XSORTJ DCA XREG3 /SET TO LIST ISZ XSORTJ CDF 10 TAD I XREG3 SPA JMP XSORT1 /END OF LIST TAD T3 SZA CLA JMP .-5 /NO GO - LOOP TAD XREG3 CDF TAD I XSORTJ DCA XSORTJ CDF 10 TAD I XSORTJ /GET ADDRESS DCA XSORTJ XSORT1, CLL CLA ISZ XSORTJ CDF JMP I XSORTJ
/*RTL6* ROUTINE XRTL6, 0 CLL RTL RTL RTL JMP I XRTL6
/END OF A FUNCTION JMS I LITS JMP .+4 ENDFUN, JMS I LITS POPA DCA MODE JMS I LITS+1 FLARG JMP I LITS+2 LITS, PARTST FFPUT EVAR+4
PAGE /PAREN TEST ROUTINE PARTST, 0 POPA DCA LASTOP /SAVED BY *ECALL* L7776 TAD SORTCN CIA POPA /CHECK MATCH SZA CLA ERR260, ERROR /NO MATCH GETC JMP I PARTST
/NEW *SGN* FUNCTION SGN, 0 TAD ACH SNA /NON ZERO? JMP I SGN /NO: ANSWER ALREADY IN FAC SO EXIT NOW SPA CLA /POSITIVE? IAC /NO: TURN SIGN BIT ON CLL CML RTR /TURN FIRST MANTISSA BIT ON DCA ACH /SET HIGH ORDER FAC DCA ACLO /CLEAR LOW ORDER FAC IAC DCA ACX /SET EXPONENT TO 1 JMP I SGN /FAC=SGN(FAC0) /NEW FUPARR ROUTINE /THIS ROUTINE IS WHAT DOES EXPONENTIALS (X^Y) IN EXPRESSIONS. /IF ABS(Y)<=16 AND FRACTION(Y)=0, THE POWER IS RAISED BY /REPEATED MULTIPLICATIONS OR DIVISION. /OTHERWISE, FAC=X^Y=EXP(LOG(X)*Y) FUPARR, FEXT /EXIT FROM THE @!?!#% INTERPRETER TAD I PT1 /GET BINARY EXPONENT OF POWER CLL CML CMA /LINK=1 AND AC=-AC-1 TAD C7 SPA SNA SZL CLA /IN RANGE 1<=AC<=5? JMP POWF+2 /NO: RAISE POWER BY LOGS JMS I FUPPUT /SAVE OLD FAC IN FTEMP1 FTEMP1 TAD PT1 /GET ADDRESS OF EXPONENT JMS I (FFGET /GET EXPONENT IN FAC FUPPUT, FFPUT /A HARMLESS POINTER JMS I (FRACT /NUM=FIX(FAC0); FAC=FRACTION(FAC0) TAD ACH SZA CLA /IS POWER INTEGRAL? JMP POWF /NO: RAISE POWER BY LOGS JMS I (FFGET /SET FAC=1 ONE TAD I (NUM /GET POWER SNA /ZERO? JMP POWEXI /YES: ANSWER ALREADY IN FAC SMA CIA DCA T1 TAD I (NUM SPA CLA /MULTIPLY OR DIVIDE? TAD FUPDIV /DIVIDE TAD (FFMPY DCA T2 /STORE ADDRESS OF APPROPRIATE ROUTINE JMS I T2 /MULTIPLY OR DIVIDE BY BASE FTEMP1 ISZ T1 /DONE YET? JMP .-3 /NO JMP POWEXI POWF, JMS I (FFGET /GET THE BASE INTO THE FAC FTEMP1 JMS I (LOG /HERE IS WHERE WE RAISE POWERS BY LOGS TAD PT1 JMS I (FFMPY FUPDIV, FFDIV-FFMPY /A HARMLESS CONSTANT JMS I (EXPON /FAC=FAC0^PT1=EXP(LOG(FAC0)*PT1) POWEXI, FINT /ENTER INTERPRETER FJMP I (FLOP+1 /REENTER EXPRESSION EVALUATOR
TAPE, L0001 KKEY, DCA PT1 /SAVE CONSTANT FOR OUTPUT TSTCCR ERR003, ERROR /JUNK JMS I (RUN9 /DISMISS US NOW TAD TELSW SZA CLA JMP .-3 /STILL BUSY - WAIT TAD PT1 DCA OUTPUT /SET OUTPUT JMP I (READY
FUNC16, GETC TAD CHAR TAD (-75 /-EQUALS SZA CLA ERR210, ERROR PUSHJ EVAL-1 TSTEND JMP .-4 POPA DCA ERLINE POPA DCA LASTV POPA DCA SORTCN POPF TEXTP JMP I (ENDFUN
XFLGET, 0 SZA JMP XFLGT2 L7777 TAD PT1 XFLGT2, DCA FLTXR L7777 TAD I XFLGET DCA FLTXR2 L7775 DCA T3 UDF TAD I FLTXR /MOVE FLOATING DATUM DOWN CDF DCA I FLTXR2 ISZ T3 JMP .-5 ISZ XFLGET JMP I XFLGET
PAGE EVALQ, TAD CHAR TAD (200-"" SZA CLA ERRBEX, ERROR TAD (ENDFUN+3 PUSHA QINP, PUSHF FLZERO-1 TAD PDLXR DCA AXIN DCA XCTIN DCA ADD ISZ SPACSW L7777 DCA MODE L0006 QINP6, CMA DCA T1 QINP1, TAD CHAR TAD (200-"" SZA CLA JMP QINP2 TAD MODE DCA SPACSW GETC ISZ MODE JMP QINPT JMP QINP1 QINP2, TSTCOM JMP QINP3 TAD MODE SZA CLA JMP QINPT QINP3, TSTCCR JMP QINP4 QINPT, TAD ADD ISZ XCTIN TAD C7700 TAD C77 UDF ISZ T1 DCA I AXIN CDF L7777 DCA MODE DCA SPACSW POPF ACX POPJ QINP4, ISZ T1 JMP QINP5 GETC JMP QINP6 QINP5, JMS I CPACK GETC JMP QINP1 LINPUT, PUSHJ GETVAR SNA CLA TSTEND ERR280, ERROR /SYNTAX, I GUESS, IN LINPUT PUSHF TEXTP TAD CHAR PUSHA TAD ADD RAL STL RAR PUSHA PUSHJ PAKLIN TAD AXIN CIA TAD COMBUF DCA T1 TAD T1 STL RAL TAD XCTIN CMA JMS I (FFLOAT POPA DCA ADD DCA SUBS PUSHJ LOOKUP FLPUT ACX TAD COMBUF DCA AXIN LNP1, ISZ SUBS PUSHJ LOOKUP L7775 DCA T2 UDF LNP3, TAD I AXIN DCA I PT1 ISZ T1 JMP LNP2 POPA DCA CHAR POPF TEXTP JMP I CCONT LNP2, ISZ PT1 ISZ T2 JMP LNP3 CDF JMP LNP1 /RANDOM NUMBER GENERATOR /NOTE: THIS "RANDOM NUMBER GENERATOR" WAS WRITTEN /WITHOUT AN ALGORITHM, SO IT IS NOTHING VERY /SPECIAL. IF ANYONE FEELS LIKE CHANGING IT, BE MY GUEST. RND, 0 TAD FRNDX+1 CLL RAL TAD FRNDX+2 DCA ACX TAD FRNDX+1 RAL TAD FRNDX+1 TAD FRNDX+2 DCA ACLO TAD FRNDX RAL TAD FRNDX JMP I (RND1 /JUMP TO REST OF FUNCTION RND2, JMP I RND /RETURN HERE TO EXIT
PAGE
/23-BIT EXTENDED FUNCTIONS
/******SINE****** FSIN, 0 JMS NHNDLE /IF X<0,NEGATE X AND SET NFLAG JMS I FMPYL /X*2/PI TOVPI JMS FRACT /SAVE X IN TEMP1,THE INTEGER PART OF X IN NUM,AND GET FRACTIONAL PART IN FAC L0003 /GET INTEGER PART OF (2/PI)*X AND NUM /ISOLATE BITS 10,11 TAD JMPI DCA .+1 /MAKE JUMP TO ARGUMENT REDUCING ROUTINE JMP . /AND ADJUST ARG ACCORDING TO QUADRANT OF X JMPI, JMP I .+1 POLYSN /X IN QUAD1,SIN(X)=SIN(X) QUAD2 /X IN QUAD2,SIN(X)=SIN(1-X) QUAD3 /X IN QUAD3,SIN(X)=SIN(-X) QUAD4 /X IN QUAD4,SIN(X)=SIN(X-1) QUAD2, JMS I FSUBL /X-1 ONE QUAD3, JMS I FNEGL /1-X OR -X JMP POLYSN QUAD4, JMS I FSUBL /X-1 ONE POLYSN, JMS I FPUTL /SAVE X FTEMP1 JMS I FMPYL /U=X**2 ACX JMS I FPUTL /SAVE U FTEMP2 JMS I FMPYL /A7*U SINA7 JMS I FADDL /A5+A7*U SINA5 JMS I FMPYL /A5*U+A7*U**2 FTEMP2 JMS I FADDL /A3+A5(U)+A7(U**2) SINA3 JMS I FMPYL /A3(U)+A5(U**2)+A7(U**3) FTEMP2 JMS I FADDL /A1+A3(U)+A5(U**2)+A7(U**3) SINA1 JMS I FMPYL /A1(X)+A3(X**3)+A5(X**5)+A7(X**7) FTEMP1 JMS NCHK /IF NFLAG IS SET,SET SIN(X)=-SIN(X) JMP I FSIN /FAC=SIN(X) /******COSINE****** /USES SIN ROUTINE TO CALCULATE COS(X) COS, 0 JMS I FADDL /COS(X)=SIN(PI/2+X) PIOV2 JMS FSIN JMP I COS /RETURN FGETL, FFGET FADDL, FFADD FMPYL, FFMPY FPUTL, FFPUT FDIVL, FFDIV FNEGL, FFNEG FSUBL, FFSUB FIXL, FFIX FLOATL, FFLOAT FDIV1L, FFDIV1 FTEMP1, 0 0 0 FTEMP2, 0 /TWO TEMP STORAGE BLOCKS FOR FUNCTIONS 0 0 ONE, 1 /1 2000 0
/ROUTINE TO SEPERATE THE INTEGER AND FRACTIONAL PARTS OF FAC /ORIGINAL FAC IS SAVED IN FTEMP1,THE INTEGER PORTION OF FAC IS /SAVED AT NUM,AND THE FRACTIONAL FORTION OF THE FAC IS LEFT IN THE FAC FRACT, 0 JMS I FPUTL /SAVE X OPX JMS I FIXL /INTEGER PORTION OF X DCA NUM /SAVE FIXED PORTION OF X TAD NUM /GET IT BACK JMS I FLOATL /FAC=FLOAT(FIX(X)) JMS I FNEGL /FAC=X-INT(X)=FRACTION (X) JMS I FADDL OPX JMP I FRACT /RETURN /ROUTINE TO CHECK IF FAC<0; IF IT IS,FAC IS NEGATED AND NFLAG IS /SET TO 1 NHNDLE, 0 TAD HORD /FETCH HIGH ORDER MANTISSA SMA CLA /IS IT <0? JMP NFLGST /NO-CLEAR NFLAG JMS I FNEGL /YES-NEGATE FAC IAC /AND SET NFLAG NFLGST, DCA NFLAG JMP I NHNDLE /ROUTINE TO NEGATE FAC IF NFLAG IS NOT =0 NCHK, 0 /LOC ALSO USED FOR TEMP STORAGE TAD NFLAG SZA CLA /IS NFLAG=0? JMS I FNEGL /NO-NEGATE FAC JMP I NCHK /YES-RETURN NUM=NCHK
/******EXPONENTIAL****** EXPON, 0 /LOC USED FOR TEMP STORAGE BY SIN,ARCTAN JMS I FMPYL /Y=XLOG2(E) LOG2E JMS FRACT /GET FRACTIONAL PART OF Y JMS I FMPYL /(FRACTION(Y))*(LN2/2) LN2OV2 JMS I FPUTL /SAVE Y FTEMP1 JMS I FMPYL /Y**2 ACX JMS I FADDL /B1+Y**2 EXPB1 JMS I FDIV1L /A1/(B1+Y**2) EXPA1 JMS I FADDL /A0+A1/(B1+Y**2) EXPA0 JMS I FSUBL /A0-Y+A1/(B1+Y**2) FTEMP1 JMS I FPUTL /SAVE FTEMP2 JMS I FGETL /GET Y FTEMP1 ISZ EXP /MULT. BY 2=2Y NOP JMS I FDIVL /2Y/(A0-Y+A1/(B1+Y**2)) FTEMP2 JMS I FADDL /1+2Y/(AO-Y+A1/(B1+Y**2)) ONE JMS I FMPYL /[1+2Y/(A0-Y+A1/(B1+Y**2))]**2=EXP(Y) ACX TAD NUM TAD EXP /EXP(X)=(2**N)(EXPY) DCA EXP JMP I EXPON /FAC=EXPON(X) NFLAG=EXPON /CONSTANT THAT WOULDN'T FIT ELSEWHERE TOVPI, 0 /.6366198 2427 6302
PAGE /******ARC TANGENT****** ATN, 0 JMS I NHNDLL /IF X<0,SET NFLAG AND NEGATE JMS I FPUTM /SAVE X FTEMP1 JMS I FSUBM /X-1 ONE TAD HORD /GET HI MANTISSA SPA CLA /WAS X>1? JMP ARGPOL /NO-CLEAR GT1FLG JMS I FGETM /YES-ATAN(X)=PI/2-ATAN(1/X) ONE JMS I FDIVM /1/X FTEMP1 JMS I FPUTM FTEMP1 IAC /SET GT1FLG ARGPOL, DCA GT1FLG JMS I FGETM /GET X OR 1/X FTEMP1 JMS I FMPYM /Y**2 ACX JMS I FPUTM /SAVE FTEMP2 JMS I FADDM /Y**2+B3 ATANB3 JMS I FDIV1M /A3/(Y**2+B3) ATANA3 JMS I FADDM /B2+A3/(Y**2+B3) ATANB2 JMS I FADDM /Y**2+B2+A3/(Y**2+B3) FTEMP2 JMS I FDIV1M /A2/(Y**2+B2+A3/(Y**2+B3)) ATANA2 JMS I FADDM /B1+A2/(Y**2+B2+A3/(Y**2+B3)) ATANB1 JMS I FADDM /Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3)) FTEMP2 JMS I FDIV1M /A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3))) ATANA1 JMS I FADDM /B0+A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3))) ATANB0 JMS I FMPYM /ATAN(Y)=X*(B0+A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3)))) FTEMP1 TAD GT1FLG /WAS X>1? SNA CLA JMP NGT /NO-TEST IF X<0? JMS I FNEGM /ATAN(X)=PI/2-ATAN(1/X) JMS I FADDM PIOV2 NGT, JMS I NCHKL /IF NFLAG SET,NEGATE FAC JMP I ATN /FAC=ATAN(X) NHNDLL, NHNDLE NCHKL, NCHK
/******NAPERIAN LOGARITHM****** GTFLG=ATN LOG, 0 TAD HORD SPA SNA /X<0 OR X=0? ERR010, ERROR /LOG OF A NEGATIVE NUMBER CLL RTL SNA /NO-HORD=2000? TAD EXP /YES-EXP=1? CMA IAC IAC SNA TAD LORD /YES-LORD=0? SZA CLA JMP POLYNL /NO-ARG IS LEGAL AND NOT 1 DCA EXP DCA LORD LTRPRT, DCA HORD JMP I LOG /YES-LOG(1)=0 POLYNL, TAD EXP DCA GTFLG /SAVE EXPONENT FOR LATER DCA EXP /ISOLATE MANTISSA IN FAC JMS I FPUTM /SAVE F FTEMP1 JMS I FADDM /F+SQR(.5) SQRP5 JMS I FPUTM /SAVE FTEMP2 JMS I FGETM FTEMP1 JMS I FSUBM /F-SQR(.5) SQRP5 JMS I FDIVM /Z=F+SQR(.5)/F-SQR(.5) FTEMP2 JMS I FPUTM FTEMP1 JMS I FMPYM /Z**2 ACX JMS I FPUTM FTEMP2 JMS I FMPYM /C5(Z**2) LOGC5 JMS I FADDM /C3+C5(Z**2) LOGC3 JMS I FMPYM /C3(Z**2)+C5(Z**4) FTEMP2 JMS I FADDM /C1+C3(Z**2)+C5(Z**4) LOGC1 JMS I FMPYM /C1(Z)+C3(Z**3)+C5(Z**5) FTEMP1 JMS I FSUBM /C1(Z)+C3(Z**3)+C5(Z**5)-1/2=LOG2(F) ONEHAF JMS I FPUTM /SAVE LOG2(F) FTEMP2 TAD GTFLG /I JMS I FLOATM JMS I FADDM /I+LOG2(F) FTEMP2 JMS I FMPYM /[I+LOG2(F)]*LOGE(2)=LOGE(X) LN2 JMP I LOG /FAC=LN(X) GT1FLG=LOG FPUTM, FFPUT FMPYM, FFMPY FADDM, FFADD FDIVM, FFDIV FDIV1M, FFDIV1 FSUBM, FFSUB FNEGM, FFNEG FLOATM, FFLOAT FGETM, FFGET
/CONSTANTS USED BY VARIOUS FUNCTIONS SINA1, 1 /1.5707949 3110 3747 SINA3, 0 /-.64592098 5325 1167 SINA5, 7775 /.07948766 2426 2466 SINA7, 7771 /-.004362476 5610 3164 PIOV2, 1 /1.5707963 3110 3756 LOG2E, 1 /1.442695 2705 2434 LN2OV2, 7777 /.34657359 2613 4415 EXPB1, 6 /60.090191 3602 7054 EXPA1, 12 /-601.80427 5514 3104 EXPA0, 4 /12.015017 3001 7301 ATANB0, 7776 /.17465544 2626 6157 ATANA1, 2 /3.7092563 3553 1071 ATANB1, 3 /6.762139 3303 670 ATANA2, 3 /-7.10676 4344 5267 ATANB2, 2 /3.3163354 3241 7554 ATANA3, 7777 /-.26476862 5703 4040 ATANB3, 1 /1.44863154 2713 3140 SQRP5, 0 /.7071068 2650 1170 ONEHAF, 0 /.5 2000 0 7777 /"" (NULL STRING) FLZERO, 0 /0.0 0 LOGC5, 0 /.59897865 2312 5525 /******FLOATING POINT INTERPRETER****** FPT, 0 FPNEXT, TAD I FPT /GET NEXT FLTG. PT. INSTR. DCA OPX /STORE IN A TEMPORARY TAD OPX /GET IT BACK AND PICK OFF AND C177 /THE ADDRESS DCA OPH /STORE THAT AWAY TAD OPX /PICK OFF THE PAGE BIT AND K200 /AND MAKE A 7600 IF CURRENT PAGE CMA IAC /OR 0 IF PAGE 0 AND FPT /THIS SETS UP HI ORDER 5 BITS OF ADDR ISZ FPT /INCREMENT FLTG. P.C. TAD OPH /ADD IN LOW ORDER 7 BITS OF ADDR DCA OPH /THIS IS FINAL ADDR. UNLESS INDIRECT TAD OPX /NOE DECODE THE OP CODE CLL RTL RTL AND C7 /PICK OFF THE OP CODE TAD CTABLE /CALCULATE SUBROUTINE ADDRESS DCA OPX TAD I OPX DCA OPX /AND STORE IN A TEMPORARY SNL /LINK HOLDS INDIRECT BIT TAD OPH /DIRECT ADDRESSING SZL TAD I OPH /INDIRECT ADDRESSING JMS I OPX /DO OPERATION JMP FPNEXT /ONLY FFNOR RETURNS TO HERE JMP FPNEXT /GO DO NEXT INSTRUCTION CTABLE, TABLE K200, 200 FFJMP, 0 /FLOATING JUMP ROUTINE SNA /EXIT INTERPRETER? JMP I FPT /YES-EXIT DCA FPT /CHANGE FLTG. P.C. JMP FPNEXT /EXECUTE THAT INSTRUCTION /******FIX****** /ROUTINE TO FIX ANY FLOATING NUMBER IN FAC BETWEEN -2047 AND +2047 TO /A TWELVE BIT INTEGER AND LEAVE RESULT IN AC FFIX, 0 CLA TAD EXP /FETCH EXPONENT SZA SMA /IS NUMBER <1? JMP .+3 /NO-CONTINUE ON FTRPRT, CLA JMP I FFIX /YES-EXIT WITH 0 IN AC TAD M13 /SET BINARY POINT AT 11 SNA /PLACES TO RIGHT OF CURRENT POINT? JMP FIXDNE /NO-NUMBER IS ALREADY FIXED THEN SMA /YES-IS NUMBER TOO LARGE TO FIX? ERR040, ERROR /YES-OVERFLOW ERROR DCA EXP /NO-SET SCALE COUNT FIXLP, CLL /0 IN LINK TAD HORD /GET HIGH MANTISSA SPA /IS IT <0? CML /YES-PUT A 1 IN LINK RAR /SCALE RIGHT DCA HORD /SAVE ISZ EXP /DONE YET? JMP FIXLP /NO FIXDNE, TAD HORD /YES-ANSWER IN AC JMP I FFIX /RETURN M13, -13 /-11 DECIMAL C13, 13 /11 DECIMAL /******FLOAT****** /ROUTINE TO FLOAT ANY INTEGER IN AC INTO FAC FFLOAT, 0 DCA HORD /SAVE # TO BE FLOATED DCA LORD /CLEAR LOW MANTISSA TAD C13 /11(10) INTO EXPONENT DCA EXP JMS I FNORL /NORMALIZE JMP I FFLOAT /RETURN FNORL, FFNOR /LINK TO NORMALIZE ROUTINE LOGC3, 0 /.9614706 3661 566
/******FLOATING POINT INTERPRETER DISPATCH TABLE****** TABLE, FFJMP /0 FFADD /1 FFSUB /2 FFMPY /3 FFDIV /4 FFGET /5 FFPUT /6 FFNOR /7 LN2, 0 /.6931472 2613 4415 / /INVERSE FLOATING DIVIDE /FSWITCH=1 /THIS IS OP/FAC / FFDIV1, 0 SNA /WHICH MODE OF CALL? TAD I FFDIV1 /CALLED BY USER-GET ADDR. JMS I ARGETL /PICK UP OPERAND TAD ACLO /SWAP THE FAC AND OPERAND DCA OPL /THERE IS A POINTER TO OPL TAD I AC2 /IN AC2 LEFT FROM ARGET SUBR. DCA ACLO TAD ACX /MIGHT AS WELL SUBTRACT THE CLL CMA IAC /EXPONENTS HERE (SAVES A WORD) TAD OPX /THEN ZERO OPX SO WILL NOT DCA ACX /MESS UP WHEN ITS DONE AGAIN DCA OPX /LATER (SEE DIV. ROUTINE) TAD ACH DCA AC2 /NOW SWAP HIGH ORDER MANTISSAS TAD OPH DCA ACH TAD AC2 DCA OPH TAD FFDIV1 /NOW KLUDGE UP SUBROUTINE LINKAGE DCA I FFDP TAD KFD1 DCA I MDSETP JMP I MD1P /GO SET UP AND DIVIDE MD1P, MD1 ARGETL, ARGET MDSETP, MDSET FFDP, FFDIV KFD1, FFD1
AN1=T1 AN2=FFDIV1 /FLOATING SQUARE ROOT /USES A HARDWARE TYPE ALGORITHM FOR BINARY SQUARE ROOTS /REF: THE LOGIC OF COMPUTER ARITHMETIC-IVAN FLORES-P 409 / FROOT, 0 CLA CLL CML RTR /SET RESULT TO 2000;0000 DCA AN1 DCA AN2 TAD KM22 /SET COUNTER FOR DEVELOPING 22 BITS OF ERESULT DCA AC2 /ALREADY HAVE 1 TAD ACH SNA JMP I FROOT /ZERO FAC-NORMALIZED!-RETN. SAME SPA CLA ERR020, ERROR /ATTEMPT TO TAKE SQUARE ROOT OF A NEGATIVE NUMBER TAD ACX /GET EXPONENT OF FAC SPA /IF NEGATIVE-MUST PROPAGATE SIGN CML RAR /DIVIDE EXP. BY 2 DCA ACX /STORE IT BACK SZL /INCREMENT EXP. IF ORIGINAL EXP ISZ ACX /WAS ODD NOP SNL /DO A PRE-SHIFT FOR EVEN EXPONENTS JMS I AL1K /SO FIRST BIT PAIR IS 10 NOT 01 CLA CLL CMA RAL /SET COUNTER FOR DETECTING A DCA ZCNT /ZERO REMAINDER CLA CLL CML RTR /SET UP POSITION OF TRIAL BIT RTR /FOR FIRST PASS THRU LOOP DCA OPH DCA OPL TAD K6000 /GET A FAST FIRST BIT-WE KNOW TAD ACH /THIS WILL WORK SINCE # IS NORMALIZED DCA ACH /IF # IS A POWER OF TWO, AND A PERFECT TAD ACH /SQUARE-WE ARE DONE HERE! SNA /WELL IS IT? TAD ACLO /COULD BE-CHECK LOW ORDER SNA CLA JMP DONE /WHOOPPEE-WE WIN BIG. JMP LOP01 /NOPE-LOOP DON'T SHIFT FIRST TIME SLOOP, TAD OPH /SHIFT TRIAL BIT 1 PLACE CLL RAR /TO THE RIGHT DCA OPH /AND STORE BACK TAD OPL RAR DCA OPL JMS I AL1K /SHIFT FAC LEFT 1 PLACE LOP01, TAD OPL /ADD TRIAL BIT TO`ANSWER TAD AN2 /SO FAR CLL CMA IAC /NEGATE IT TAD ACLO /AND ADD TO FAC (REMAINDER SO FAR) SNA /IS RESULT ZERO? ISZ ZCNT /YES-INCREMENT COUNTER DCA TM /STORE RESULT IN TEMPORARY
CML RAL /ADD CARRY TO HIGH ORDER FOR SUBTRACT TAD OPH /ADD TRIAL BIT TAD AN1 /ADD RESULT SO FAR (HI ORDER) CLL CMA IAC /AND SUBTRACT FROM HI ORDER FAC TAD ACH SNL /RESULT NEGATIVE? JMP GON /YES-NEXT RESULT BIT IS 0 SZA /NO-IS HI ORDER RESULT=0? JMP LOP02 /NO-GO ON ISZ ZCNT /YES-WAS LOW ORDER =0? JMP .+3 /NO-GO ON CMA /YES-REM.=0-SET COUNTER SO DCA AC2 /LOOKS LIKE WE'RE DONE LOP02, DCA ACH /STORE HIGH ORDER REM. IN FAC TAD TM /STORE LO ORDER REM. IN FAC DCA ACLO TAD OPL /TRIAL BIT SHIFTED LEFT 1 IS CLL RAL /RESULT BIT-ADD IT TO ROOT DEVELOPED TAD AN2 /SO FAR DCA AN2 TAD OPH RAL TAD AN1 DCA AN1 GON, CLA CLL CMA RAL /RESET COUNTER FOR ZERO REM. DCA ZCNT ISZ AC2 /DONE ALL 23 RESULT BITS? JMP SLOOP /NO-GO ON DONE, TAD AN1 /YES-STORE ANSWER IN FAC DCA ACH /ITS NORMALIZED ALREADY TAD AN2 DCA ACLO JMP I FROOT /AND RETURN K6000, 6000 ZCNT, 0 AL1K, AL1 KM22, -22
LOGC1, 2 /2.8853913 2705 2440 /FLOATING MULTIPLY-DOES 2 24X12 BIT MULTIPLIES FFMPY, 0 SNA /WHICH MODE OF CALL? TAD I FFMPY /CALLED BY USER-GET OPERAND ADDR. JMS I MDSETK /SET UP FOR MPY-OPX IN AC ON RETN. TAD ACX /DO EXPONENT ADDITION DCA ACX /STORE FINAL EXPONENT DCA DV24 /ZERO TEM STORAGE FOR MPY ROUTINE DCA AC2 TAD ACH /IS FAC=0? SNA CLA DCA ACX /YES-ZERO EXPONENT JMS MP24 /NO-MULTIPLY FAC BY LOW ORDER OPR. TAD OPH /NOW MULTIPLY FAC BY HI ORDER MULTIPLIER DCA OPL JMS MP24 TAD AC2 /STORE RESULT BACK IN FAC RTZRO, DCA ACLO /LOW ORDER TAD DV24 /HIGH ORDER DCA ACH TAD ACH /DO WE NEED TO NORMALIZE? RAL SMA CLA JMP SHLFT /YES-DO IT FAST MDONE, DCA AC1 /NO-ZERO OVERFLOW WD(DO I NEED THIS???) ISZ FFMPY /BUMP RETURN POINTER ISZ TM /SHOULD RESULT BE NEGATIVE? JMP I FFMPY /NOPE-RETN. JMS I FFNEGR /YES-NEGATE IT JMP I FFMPY /RETURN SHLFT, CMA /SUBTRACT 1 FROM EXP. TAD ACX DCA ACX JMS I AL1PTR /SHIFT FAC LEFT 1 BIT JMP MDONE+1 /DONE. AL1PTR, AL1 / /24 BIT BY 12 BIT MULTIPLY. MULTIPLIER IS IN OPL /MULTIPLICAND IS IN ACH AND ACLO /RESULT LEFT IN DV24,AC2, AND AC1 MP24, 0 TAD KKM12 /SET UP 12 BIT COUNTER DCA OPX TAD OPL /IS MULTIPLIER=0? SZA JMP MPLP1 /NO-GO ON DCA AC1 /YES-INSURE RESULT=0 JMP I MP24 /RETURN MPLP, TAD OPL /SHIFT A BIT OUT OF LOW ORDER MPLP1, RAR /OF MULTIPLIER AND INTO LINK DCA OPL SNL /WAS IT A 1? JMP MPLP2 /NO-0-JUST SHIFT PARTIAL PRODUCT
CLL /YES-ADD MULTIPLICAND TO PARTIAL PRODUCT TAD AC2 TAD ACLO /LOW ORDER DCA AC2 RAL /PROPAGATE CARRY TAD ACH /HI ORDER MPLP2, TAD DV24 RAR /NOW SHIFT PARTIAL PROD. RIGHT 1 BIT DCA DV24 TAD AC2 RAR DCA AC2 RAR /1 BIT OF OVERFLOW TO AC1 DCA AC1 ISZ OPX /DONE ALL 12 MULTIPLIER BITS? JMP MPLP /NO-GO ON JMP I MP24 /YES-RETURN / /PART OF DIVIDE ROUTINE-FFDIV MUST BE AT LOC. 6722 MP12L, DCA OPL /STORE BACK MULTIPLIET TAD AC2 /GET PRODUCT SO FAR SNL /WAS MULTIPLIER BIT A 1? JMP .+3 /NO-JUST SHIFT THE PARTIAL PRODUCT CLL /YES-CLEAR LINK AND ADD MULTIPLICAND TAD ACLO /TO PARTIAL PRODUCT RAR /SHIFT PARTIAL PRODUCT-THIS IS HI ORDER DCA AC2 /RESULT-STORE BACK DVLP1, TAD OPL /SHIFT A BIT OUT OF MULTIPLIER RAR /AND A BIT OR RESLT. INTO IT (LO ORD. PROD.) ISZ FFMPY /DONE ALL BITS? JMP MP12L /NO-LOOP BACK CLL CMA IAC /YES-LOW ORDER PROD. OF QUOT. X OPL IN AC DCA ACLO /NEGATE AND STORE CML RAL /PROPAGATE CARRY JMP I FD1P /GO ON FD1P, FD1 /POINTER TO REST OF DIVIDE ROUTINE / /FLOATING DIVIDE ROUTINE /USES THE METHOD OF TRIAL DIVISION BY HI ORDER FFDIV, 0 /(USED AS A TEM. BY I/O ROUTINES) SNA /WHICH MODE OF CALL? TAD I FFDIV /CALLED BY USER-GET ARG. ADDR. JMS I MDSETK /GO SET UP FOR DIVIDE-OPX IN AC ON RETN. FFD1, CMA IAC /NEGATE EXP. OF OPERAND TAD ACX /ADD EXP OF FAC DCA ACX /STORE AS FINAL EXPONENT TAD OPH /NEGATE HI ORDER OP. FOR USE CLL CMA IAC /AS DIVISOR DCA OPH JMS DV24 /CALL DIV.--(ACH+ACLO)/OPH TAD ACLO /SAVE QUOT. FOR LATER DCA AC1 TAD KM13 /SET COUNTER FOR 12 BIT MULTIPLY DCA FFMPY /TO MULTIPLY QUOT. OF DIV. BY JMP DVLP1 /LOW ORDER OF OPERAND (OPL)
/ /END OF FLOATING DIVIDE-FUDGE SOME /STUFF THEN JUMP INTO MULTIPLY / FDDON, TAD FFDIV /STORE RETN. ADDR. IN MULT ROUTINE DCA FFMPY JMP MDONE /GO CLEAN UP / /DIVIDE ROUTINE--24 BITS IN ACH,ACLO ARE DIVIDED BY 12 BITS /IN OPH. OPH IS ASSUMEN NEGATIVE AND .GT. ACH IN ABSOLUTE VALUE /ELSE-DIVIDE OVERFLOW--WE RETURN NORMALLY WITH QUOTIENT /IN ACLO AND REM. IN ACH. (AC2=0 ON RETN.) / DV24, 0 TAD ACH /CHECK THAT DIVISOR IS .GT. DIVIDEND TAD OPH /DIVISOR IN OPH (NEGATIVE) SZL CLA /IS IT? ERR030, ERROR /NO-DIVIDE OVERFLOW TAD KM13 /YES-SET UP 12 BIT LOOP DCA AC2 JMP DV1 /GO BEGIN DIVIDE DV2, TAD ACH /CONTINUE SHIFT OF FAC LEFT RAL DCA ACH /RESTORE HI ORDER TAD ACH /NOW SUBTRACT DIVISOR FROM HI ORDER TAD OPH /DIVIDEND SZL /GOOD SUBTRACT? DCA ACH /YES-RESTORE HI DIVIDEND CLA /NO-DON'T RESTORE--OPH.GT.ACH DV1, TAD ACLO /SHIFT FAC LEFT 1 BIT-ALSO SHIFT RAL /1 BIT OF QUOT. INTO LOW ORD OF ACLO DCA ACLO ISZ AC2 /DONE 12 BITS OF QUOT? JMP DV2 /NO-GO ON JMP I DV24 /YES-RETN W/AC2=0 FFNEGR, FFNEG MDSETK, MDSET KKM12, -14 KM13, -15
PAGE / /FLOATING ADD / FFADD, 0 SNA /WHICH MODE FO CALL? TAD I FFADD /CALLED BY USER-GET ADDR. OF OPR. JMS I ARGETP /PICK UP OPERAND ISZ FFADD /BUMP RETURN FAD1, TAD OPH /IS OPERAND = 0 SNA CLA JMP I FFADD /YES-DONE TAD ACH /NO-IS FAC=0? SNA CLA JMP DOADD /YES-DO ADD TAD ACX /NO-DO EXPONENT CALCULATION CLL CMA IAC TAD OPX SMA SZA /WHICH EXP. GREATER? JMP FACR /OPERANDS-SHIFT FAC CMA IAC /FAC'S-SHIFT OPERAND=DIFFRNCE+1 JMS OPSR JMS ACSR /SHIFT FAC ONE PLACE RIGHT DOADD, TAD OPX /TRANSFER OPX TO ACX DCA ACX /(CONVENIANT MAINLY IF FAC=0) JMS OADD /DO THE ADDITION JMS I FNORP /NORMALIZE RESULT JMP I FFADD /RETURN FACR, JMS ACSR /SHIFT FAC = DIFF.+1 JMS OPSR /SHIFT OPR. 1 PLACE JMP DOADD /DO ADDITION / /OPERAND SHIFT RIGHT-ENTER WITH POSITIVE COUNT-1 /IN AC OPSR, 0 CLL CMA /- (COUNT+1) TO SHIFT COUNTER DCA AC0 DCA AC2 /ZERO OVERFLOW BIT LOP2, TAD OPH /GET THE HIGH ORDER OPERAND SMA /IS THE OPERAND NEGATIVE? JMP OPSR1 /NO: NO SPECIAL PROCESSING /IN ORDER TO CORRECTLY SHIFT A NEGATIVE NUMBER RIGHT /ONE MUST BE ADDED TO IT AND THEN THE LOGICAL SHIFT /PROPAGATING THE SIGN BIT WILL WORK CLA CML RAR /MAKE 4000, LINK WAS ASSUMED TO BE 0! TAD AC2 /ADD OVERFLOW BIT DCA AC2 /AND STORE BACK RAL /APPROPRIATELY POSITION CARRY TAD OPL /AND ADD THE LOW ORDER OPERAND DCA OPL /STORE BACK RAL /AGAIN POSITION CARRY TAD OPH /ADD HIGH ORDER CML /LINK WAS COMPLEMENT OF SIGN BIT OPSR1, RAR /SHIFT IT RIGHT, PROPAGATING SIGN DCA OPH /STORE BACK TAD OPL RAR DCA OPL /STORE LO ORDER BACK RAR /SAVE 1 BIT OF OVERFLOW DCA AC2 /IN AC2 ISZ OPX /INCREMENT EXPONENT NOP /ISZ MAY SKIP, SO THIS BUFFERS IT ISZ AC0 /DONE ALL SHIFTS? JMP LOP2 /NO-LOOP JMP I OPSR /YES-RETN.
/ /SHIFT FAC LEFT 1 BIT / AL1, 0 TAD AC1 /GET OVERFLOW BIT CLL RAL /SHIFT LEFT DCA AC1 /STORE BACK TAD ACLO /GET LOW ORDER MANTISSA RAL /SHIFT LEFT DCA ACLO /STORE BACK TAD ACH /GET HI ORDER RAL DCA ACH /STORE BACK JMP I AL1 /RETN. / /SHIFT FAC RIGHT-ENTER WITH COUNT-1 IN AC (POSITIVE) / ACSR, 0 CLL CMA /AC CONTAINS COUNT-1 DCA AC0 /STORE COUNT DCA AC1 /CLEAR FAC'S OVERFLOW BIT LOP1, TAD ACH SMA JMP ACSR1 CLA CML RAR /IF FAC<0, TAD AC1 /ADD 1 TO FAC DCA AC1 RAL TAD ACLO DCA ACLO RAL TAD ACH CML /PROPAGATE SIGN BIT CORRECTLY ACSR1, RAR /SHIFT RIGHT 1, PROPAGATING SIGN DCA ACH /STORE BACK TAD ACLO /GET LOW ORDER RAR /SHIFT IT DCA ACLO /STORE BACK RAR DCA AC1 /SAVE 1 BIT OF OVERFLOW ISZ AC0 /DONE? JMP LOP1 /NO-LOOP JMP I ACSR /YES-RETN-AC=L=0 / /FLOATING SUBTRACT / FFSUB, 0 SNA /WHICH MODE OF CALL? TAD I FFSUB /CALLED BY USER-GET ADDR. OF OP JMS I ARGETP /PICK UO THE OP. JMS I POPNEG /NEGATE OPERAND TAD FFSUB /JMP INTO FLTG. ADD SUB0, DCA FFADD /AFTER SETTING UP RETURN JMP FAD1-1 ARGETP, ARGET POPNEG, OPNEG *.+1 /SO PAGE BOUNDARY WILL FALL IN THE RIGHT PLACE.
/ /ADD OPERAND TO FAC / OADD, 0 CLL TAD AC2 /ADD OVERFLOW WORDS TAD AC1 DCA AC1 RAL /ROTATE CARRY TAD OPL /ADD LOW ORDER MANTISSAS TAD ACLO DCA ACLO RAL TAD OPH /ADD HI ORDER MANTISSAS TAD ACH DCA ACH JMP I OADD /RETN. FNORP, FFNOR / /CONTINUATION OF ROUTINE TO ADJUST QUOT. OF FIRST DIV. /ROUTINE STARTS AT DVOP2. / DV24L, DV24 /ROUTINE TO DO A 24X12 BIT DIVIDE DVOP2, SNA /IS IT ZERO? DCA ACLO /YES-MAKE WHOLE THING ZERO DCA ACH JMS I DV24L /DIVIDE EXTENDED REM. BY HI DIVISOR TAD ACLO /NEGATE THE RESULT CLL CMA IAC DCA ACLO SNL /IF QUOT. IS NON-ZERO, SUBTRACT CMA /ONE FROM HIGH ORDER QUOT. /******FALL THROUGH PAGE BOUNDARY****** /******'CMA' HAD BETTER BE LAST ON PAGE!****** JMP DVL1 /GO TO IT / /CONTINUATION OF FLOATING DIVIDE ROUTINE / FD1, TAD AC2 /NEGATE HI ORDER PRODUCT CLL CMA IAC TAD ACH /COMPARE WITH REMAINDER OF FIRST DIVIDE SNL JMP DVOPS /GREATER THAN REM.-ADJUST QUOT. OF 1ST DIV. CLL /OK-DO (REM-(Q*OPL))/OPH DCA ACH /FIRST STORE ADJUSTED PRODUCT JMS I DV24P /DIVIDE BY OPH (HIGH ORDER OPERAND) DVL1, TAD AC1 /GET QUOT. OF FIRST DIV. SMA /IF HIGH ORDER BIT SET-MUST SHIFT 1 RIGHT JMP FD /NO-IT'S NORMALIZED-DONE CLL RAR /MUST SHIFT RIGHT 1 DCA ACH /STORE IN FAC TAD ACLO /SHIFT LOW ORDER RIGHT RAR DCA ACLO /STORE BACK ISZ ACX /BUMP EXPONENT NOP TAD ACH FD, DCA ACH /STORE HIGH ORDER RESULT JMP I FDDONP /GO LEAVE DIVIDE FDDONP, FDDON /END OF FLTG. DIV. ROUTINE DV24P, DV24 /ROUTINE TO DO A 24X12 BIT DIVIDE / /MDSET-SETS UP SIGNS FOR MULTIPLY AND DIVIDE /ALSO SHIFTS OPERAND ONE BIT TO THE LEFT. /EXIT WITH EXPONENT OF OPERAND IN AC FOR EXPONENT /CALCULATION-CALLED WITH ADDRESS OF OPERAND IN AC. / MDSET, 0 JMS ARGET /GET ARGUMENT MD1, CLA CLL CMA RAL /SET SIGN CHECK TO -2 DCA TM TAD OPH /IS OPERAND NEGATIVE? SMA CLA JMP .+3 /NO JMS I OPNEGP /YES-NEGATE IT ISZ TM /BUMP SIGN CHECK TAD OPL /AND SHIFT LEFT ONE BIT CLL RAL DCA OPL TAD OPH RAL DCA OPH DCA AC1 /CLR. OVERFLOW WORD OF FAC TAD ACH /IS FAC NEGATIVE SMA CLA JMP LEV /NO-GO ON JMS I FFNEGK /YES-NEGATE IT ISZ TM /BUMP SIGN CHECK NOP /MAY SKIP LEV, TAD OPX /EXIT WITH OPERAND EXPONENT IN AC JMP I MDSET FFNEGK, FFNEG OPNEGP, OPNEG
/ /ARGUMENT PICK UP ROUTINE-ENTER WITH DATA FIELD SET TO EITHER /FLTG. DATA FIELD OR FLTG. INSTR. FIELD. /ADDRESS OF OPERAND IS IN THE AC ON ENTRY. /ON RETURN, THE`AC IS CLEAR / ARGET, 0 DCA AC2 /STORE ADDRESS OF OPERAND TAD I AC2 /PICK UP EXPONENT DCA OPX ISZ AC2 /MOVE POINTER TO HI MANTISSA WD TAD I AC2 /PICK IT UP DCA OPH /STORE ISZ AC2 /MOVE PTR. TO LO MANTISSA WD. TAD I AC2 /PICK IT UP DCA OPL /STORE IT JMP I ARGET /RETURN
DVOP2P, DVOP2 / /ROUTINE TO NORMALIZE THE FAC / FFNOR, 0 TAD ACH /GET THE HI ORDER MANTISSA SNA /ZERO? TAD ACLO /YES-HOW ABOUT LOW? SNA TAD AC1 /LOW=0, IS OVRFLO BIT ON? SNA CLA JMP ZEXP /#=0-ZERO EXPONENT NORMLP, CLA CLL CML RTR /NOT 0-MAKE A 2000 IN AC TAD ACH /ADD HI ORDER MANTISSA SZA /HI ORDER = 6000 JMP .+3 /NO-CHECK LEFT MOST DIGIT TAD ACLO /YES-6000 OK IF LOW=0 SZA CLA SPA CLA /2,3,4,5,ARE LEGAL LEFT MOST DIGS. JMP FFNORR /FOR NORMALIZED #-(+2000=4,5,6,7) CLL CML CMA /-1 TAD ACX /SUBTR. 1 FROM EXPONENT DCA ACX JMS I AL1P /SHIFT FAC LEFT ONE JMP NORMLP /GO BACK AND SEE IF NORMALIZED ZEXP, DCA ACX FFNORR, DCA AC1 /DONE W/NORMALIZE-CLEAR AC1 JMP I FFNOR /RETURN AL1P, AL1 / /FLOATING GET / FFGET, 0 SNA /WHICH MODE OF CALL TAD I FFGET /CALLED BY USER-GET ADDR. OF OP JMS ARGET /PICK UP OPERAND TAD OPX DCA ACX /LOAD THE OPERAND INTO FAC TAD OPL DCA ACLO TAD OPH DCA ACH ISZ FFGET JMP I FFGET /RETN. TO CALL +2 / /FLOATING PUT / FFPUT, 0 SNA /WHICH MODE OF CALL? TAD I FFPUT /CALLED BY USER-GET OPR. ADDR DCA FFGET /STORE IN A TEMP TAD ACX /GET FAC AND STORE IT DCA I FFGET /AT SPECIFI{qD ADDRESS ISZ FFGET TAD ACH DCA I FFGET ISZ FFGET TAD ACLO DCA I FFGET ISZ FFPUT /BUMP RETN. JMP I FFPUT /RETN. TO CALL+2
/ /ROUTINE TO ADJUST QUOTINET OF FIRST DIVIDE (MAYBE) WHEN THE /REMAINDER OF THE FIRST DIVIDE IS LESS THAN QUOT*OPL /USED BY FLTG. DIVIDE ROUTINE / DVOPS, CMA IAC /NEGATE AND STORE REVISED REMAINDER DCA ACH CLL TAD OPH TAD ACH /WATCH FOR OVERFLOW SNL JMP DVOP1 /OVERFLOW-DON'T ADJUST QUOT. OF 1ST DIV. DCA ACH /NO OVERFLOW-STORE NEW REM. CMA /SUBTRACT 1 FROM QUOT OF TAD AC1 /FIRST DIVIDE DCA AC1 DVOP1, CLA CLL TAD ACH /GET HI ORD OF REMAINDER JMP I DVOP2P /GO ON
PAGE /*FLIN* (FLOATING POINT INPUT) ROUTINE /THIS ROUTINE ASSEMBLES A FLOATING POINT NUMBER IN THE FAC. /THE NUMBER IS READ AS ASCII TEXT BY THE UNPACK ROUTINE. FLIN, 0 CLA CMA DCA FLAG DCA E DCA DFLG DCA ACX DCA ACH DCA ACLO FLIN1, TESTN JMP FLIN3 JMP FLIN4 JMS I (FFMPY /DIGIT TEN JMS I KFFPUT FTEMP1 TAD SORTCN JMS I (FFLOAT JMS I (FFADD FTEMP1 ISZ E CMA DCA DFLG FLIN2, GETC JMP FLIN1 FLIN3, ISZ FLAG JMP FLIN4 DCA E JMP FLIN2 FLIN4, ISZ DFLG ERR150, ERROR TAD CHAR TAD (-105 SZA CLA JMP SHIFT GETC TAD CHAR TAD (-56 DCA DFLG TAD DFLG CLL CMA RTR SNA CLA GETC JMS GETNUM TAD OPX ISZ DFLG CIA SHIFT, ISZ FLAG TAD E SNA JMP GIVE CLL SMA CML CIA DCA E SZL TAD (FFDIV-FFMPY TAD (FFMPY DCA DFLG FLIN5, JMS I DFLG TEN ISZ E JMP FLIN5 GIVE, TAD PT1 JMS I KFFPUT KFFPUT, FFPUT JMP I FLIN E, 0 /NEXT 3 LOCS USED AS TEMPS DFLG, 0 /BY *TAN* FUNCTION GETNUM, 0 DCA OPX TESTN NOP ERR370, ERROR GETN1, TAD OPX CLL RAL SPA SZL JMP ERR370 RAL TAD OPX SPA SZL JMP ERR370 RAL TAD SORTCN SPA SZL JMP ERR370 DCA OPX GETC TESTN NOP JMP I GETNUM JMP GETN1 /*GETLN* ROUTINE /READS A DECIMAL LINE NUMBER INTO LINENO THROUGH THE /TEXT UNPACKING ROUTINES XGETLN, 0 JMS GETNUM TAD OPX SNA JMP ERR370 DCA LINENO JMP I XGETLN TEN, 4 /10.0 2400 0 /*TAN* FUNCTION TAN, 0 /ALSO USED AS TEMP BY *FLIN* JMS I KFFPUT /SAVE AWAY THE ARG FLARG JMS I (COS /FAC=COS(ARG) JMS I KFFPUT /SAVE THAT TOO E /IN TEMP STORAGE JMS I (FFGET /GET BACK ORIGINAL ARG FLARG JMS I (FSIN /AND TAKE ITS SINE JMS I (FFDIV /FAC=SIN(ARG)/COS(ARG) E JMP I TAN /EXIT WITH FAC=TAN(ARG) FLAG=TAN
PAGE /*FLOUT* (FLOATING POINT OUTPUT) ROUTINE /PRINTS THE NUMBER IN THE FAC AS WELL AS IT CAN. DEXP=T1 /3 ASSIGNMENTS SIG=T2 FLOUT, 0 TAD ACH SPA CLA TAD CCR TAD C40 PRINTC TAD ACH SZA CLA JMP .+4 TAD K60 PRINTC JMP I FLOUT JMS I (ABS TAD ACX /ROUNDING DCA OPX DCA OPH TAD ACX SPA CIA CLL RAR CLL RAR TAD (3 DCA OPL TAD (.+3 DCA I (FFADD JMP I (DOADD-2 DCA DEXP FLOUT1, CLA CLL CMA RTL TAD ACX SPA SNA CLA JMP FLOUT2 JMS I (FFDIV TEN ISZ DEXP JMP FLOUT1 FLOT2A, JMS I (FFMPY TEN CMA TAD DEXP DCA DEXP FLOUT2, TAD ACX SPA SNA CLA JMP FLOT2A JMS I (FFPUT FTEMP1 TAD M6 DCA RONDUP SIGNIF, JMS I (FRACT JMS I (FFMPY TEN TAD I (NUM SZA CLA DCA SIG ISZ SIG ISZ RONDUP JMP SIGNIF JMS I (FFGET FTEMP1 TAD DEXP IAC CLL CMA CML TAD C7 SMA SZA SNL CLA JMP BIG TAD DEXP DCA RONDUP BIG1, DCA DEXP JMS PICKC CLL CMA BIG, TAD DEXP SMA JMP BIG1 LITTLE, TAD M6 TAD SIG DCA SIG SNL JMP PREXP TAD (56 PRINTC LITL2, JMS PICKC TAD SIG SPA CLA JMP LITL2 PREXP, TAD RONDUP SNA CLA JMP I FLOUT TAD (105 PRINTC TAD RONDUP SMA JMP PRXP1 CIA DCA RONDUP TAD (55 PRINTC TAD RONDUP PRXP1, JMS I (ITPRNT JMP I FLOUT PICKC, 0 JMS I (FRACT TAD I (NUM TAD K60 PRINTC JMS I (FFMPY TEN ISZ SIG K60, 60 /A HARMLESS CONSTANT THAT ALSO BUFFERS THE ISZ JMP I PICKC RONDUP, 0
IFDEF CONFIG < PAGE ENPUNCH > FIELD 1 *6000 F0P37, NOPUNCH *7600 /THIS WILL BE MOVED LATER ENPUNCH JMP 7756 /FOR A MONITOR SYSTEM /*FLPUT* ROUTINE XFLPUT, 0 SZA JMP XFLPT2 XFLPT1, L7777 TAD PT1 XFLPT2, DCA FLTXR L7777 TAD I XFLPUT DCA FLTXR2 L7775 DCA T3 TAD I FLTXR2 UDF DCA I FLTXR CDF ISZ T3 JMP .-5 ISZ XFLPUT JMP I XFLPUT /*SORTC* ROUTINE XSORTC, 0 SNA TAD CHAR CIA DCA T3 TAD I XSORTC DCA XREG3 CDF 10 TAD I XREG3 CDF SPA JMP XSORT3 TAD T3 SZA CLA JMP .-7 TAD I XSORTC CMA TAD XREG3 DCA SORTCN SKP XSORT3, ISZ XSORTC ISZ XSORTC CLL CLA JMP I XSORTC /*PRINTX* ROUTINE XOUTL, 0 SNA TAD CHAR JMS I KKR TAD XREG3 TAD KK1 SNA JMP XOUTL1 TAD KK2 CLL CML IAC TAD C77 SMA SNL CLA ISZ PRNTC1 JMP I XOUTL TAD CCR JMS I KKR XOUTL1, TAD CLF JMS I KKR TAD KK3 DCA PRNTC1 JMP I XOUTL KKR, XOUTL2 KK1, -15 KK2, 15-140 KK3, -110
FUNCT3, DCA EFOP TAD MODE PUSHA JMS I IECALL POPA SPA JMP I FUNC6I TAD FUNJMS DCA .+1 0 JMP I ENDFNI ENDFNI, ENDFUN IECALL, ECALL FUNC6I, FUNCT6 FUNJMS, JMS I FUNL3-2 FUNL3, FSIN COS ATN EXPON LOG ABS FROOT SGN INT RND FIX TAN LEN MID CAT ABS=NHNDLE IF5, SMA SZA CLA SPA CLA SNA CLA SMA CLA SPA SNA CLA SZA CLA INTCNT, 0
*6377-24 KL8LOD, NOPUNCH *7777-24 ENPUNCH /THE KL8FIX ROUTINE TURNS ON THE KEYBOARD INTERRUPT FOR /THE KL8-E TTYS IN CASE STATIC ELECTRICITY TURNED IT OFF. /IF THE COMPUTER IS A PDP-8/L, THIS ROUTINE /IS NOT USED. OTHERWISE, THE INITIALIZER LOADS IT INTO THE /END OF FIELD 1. KL8FIX, TAD KL8TAD /GET TAD INSTRUCTION DCA KL8TLS /STICK IT INTO THE PROGRAM TAD MUSER /GET THE MINUS NUMBER OF USERS DCA KL8CTR /SET UP COUNTER KL8LP, CLL CLA CMA RTL /AC & L = 17775 KL8KIE, 6035 /KIE-ENABLE KEYBOARD INTERRUPT (AC11=1) RTL /AC=-11 KL8TLS, HLT /ADD TLS; AC=TLS-11=KIE DCA KL8KIE /SET NEW KIE INSTRUCTION ISZ KL8TLS /SET UP TO ADD NEXT USER'S TLS INSTR. ISZ KL8CTR /MORE KEYBOARDS TO TURN ON? JMP KL8LP /YES: GO DO IT TAD KL8US0 /NO DCA I KL8LK /RESET USER STATUS POINTER IN FLD 0 CIF JMP I KL8RET /CONTINUE WITH THE SCHEDULER IN FLD 0 KL8CTR, 0 /COUNT # OF USERS TO BE TURNED ON KL8TAD, TAD INTRPL /TAD INSTRUCTION TO REFERENCE TLS LIST KL8US0, USER0 /POINTER TO USER STATUS LIST KL8LK, LOOK /POINTER TO POINTER TO USER STATUS KL8RET, KL8LFL+1 /PLACE IN SCHEDULER TO RETURN TO
PAGE 0 /USER FIELD DEFINITIONS 7763 /CR,S -1 6457 /TO 6040 /P@ 7745 /CR,E 2 6262 /RR 5762 /OR 0040 /SPACE,@ 7762 /CR,R 6 4541 /EA 4471 /DY 7740 /CR,@ 0051 /SPACE,I 12 5600 /N,SPACE 4000 /@ 0444 /$D 4554 /EL 4564 /ET 4544 /ED 7740 /CR,@ CONEND=. COMGOL, LET /LET OR UNKNOWN -41 PRINT /PRINT -40 GOTO /GO TO -37 IF /IF -36 GOTO /THEN -35 FOR /FOR -34 ERR520 /TO -33 ERR520 /STEP -32 NEXT /NEXT -31 INPUT /INPUT -30 CONT /DATA -27 READ /READ -26 GOSUB /GOSUB -25 RETURN /RETURN -24 CONT /DEF -23 ERR520 /FN -22 ON /ON -21 CONT /REM -20 LINPUT /LINPUT -17 RESTOR /RESTORE -16 CONT /DIM -15 RANDOM /RANDOM -14 READY /STOP -13 END /END -12 COMGO1, LIST /LIST -11 RUN /RUN -10 EDIT /EDIT -7 DELET /DELETE -6 BYE /SCRATCH -5 BYE /NEW -4 BYE /BYE -3 KKEY /KEY -2 TAPE /TAPE -1 AUSER, 0 /0 FOR 1 USER,4000 FOR 2,6000 FOR 3,ECT. MUSER, -1 /- NUMBER OF USERS /TEMPORARY STORAGE DURING INTERRURPS SAVAC, USRLST /SAVED AC SAVF, 0 /SAVED FLAGS SAVRES, 0 /SAVED RESTART LOCATION SAVT3, 0 /SAVED T3 SXREG3, 0 /SAVED XREG3 SSRTCN, 0 /SAVED SORTCN SAXUDF, 0 /SAVED UDF ADDRESS SSORTC, 0 /SAVED SORTC ADDRESS SXFREE, 0 /SAVED XFREE ADDRESS AND SUBROUTINE HEAD INTRPL, TLS /USER 0 TLS IOT MTLS /USER 1 TLS IOT MTLS /USER 2 TLS IOT MTLS /USER 3 TLS IOT MTLS /USER 4 TLS IOT MTLS /USER 5 TLS IOT MTLS /USER 6 TLS IOT MTLS /USER 7 TLS IOT JMP I INTRPL-1 /EXIT FROM SUBR. OF USER TLS'S /THESE DEFS ARE SO THE INITIALIZER CAN USE SOME HANDY /PAGE ZERO LOCATIONS USRPTR=SAVAC CORPTR=SAVF USRPT2=SAVRES CORPT2=SAVT3 BEGUSR=MUSER CURFLD=AUSER BEGDEV=SXREG3 USRCTR=SSRTCN SS=SAXUDF BEGCOR=SSORTC KLTOP=SXFREE /INTERRUPT HANDLER INTR81, DCA SAVAC /SAVE AC /JUST IN CASE THERE IS A CARD READER, RCRB /(6634) READ CARD READER TO CLEAR FLAG RCRD /(6674) ALSO CLEAR CARD DONE FLAG CLA RAR /WIPE OUT GARBAGE IN AC AND GET LINK INTO AC0 RIB /GET USER FIELD INFO INTO AC DCA SAVF /SAVE AS FLAGS TAD I (0 /GET RESTART LOC DCA SAVRES /AND SAVE SPL /POWER FAILURE INTERRUPT? JMP I (INTR82 /NO: CHECK USER TTY'S DCA I (0 /YES: SET UP RESTART SEQUENCE TAD (JMP INTRRV DCA I (2 /FIELD 0;*0;AND 0;CIF 10;JMP INTRRV HLT /NOW JUST STOP AND WAIT FOR THE END /POWER UP RECOVERY SEQUENCE INTRRV, CAF /CLEAR ALL ON RECOVERY TAD AUSER MTON /PDP-8/L: TURN ON ALL USERS L0001 MINT /PDP-8/L: ENABLE INTERRUPTS CLA /WIPE OUT GARBAGE IN AC TAD (212 /ASCII FOR LINE FEED NOP /BECOMES TLS IF PDP-8/L JMS INTRPL-1 /SEND LF TO ALL (BECOMES MTLS IF PDP-8/L) CLA /WIPE OUT THE 212 INTRV2, TSF /DELAY UNTIL CONSOLE TTY IS FINISHED JMP INTRV1 /BUT WE MUST BE READY FOR ANOTHER FAILURE TAD (JMP INTR81 /INTR81 IS NORMAL INTERRUPT PROCESSOR DCA I (2 /RESTORE NORMAL INTERRUPT SEQUENCE TAD SAVF /PREPARE TO RESUME EDU200 RTF /RESTORE LINK,CORE FIELD INFORMATION CLA TAD SAVAC /RESTORE AC JMP I SAVRES /RESUME TIMESHARING INTRV1, SPL /ANOTHER POWER FAILURE? JMP INTRV2 /NO: CONTINUE DELAYING HLT /YES: JUST GIVE UP AGAIN NOW PAGE
/USER TTY INTERRUPT HANDLER INTR82, TAD I (T3 /SAVE ANYTHING INTERRUPT ROUTINE CHANGES DCA SAVT3 /SAVE T3 TAD I (XREG3 DCA SXREG3 /SAVE XREG3 TAD I (SORTCN DCA SSRTCN /SAVE SORTCN TAD I (XUDF DCA SAXUDF /SAVE UDF ADDRESS TAD I (XSORTC DCA SSORTC /SAVE SORTC ADDRESS TAD I (XFREE DCA SXFREE /SAVE XFREE ADDRESS DCA I (USER /START AT USER 0 DCA I (TEMP1 /NO TTY'S TO TURN ON AT FIRST TAD (TAD INTRPL DCA INTRP1 /SET LIST REFERENCE INSTRUCTION INTRP1, HLT /GET TLS IOT TAD (-15 DCA INTRP2 /SET KSF IOT TAD INTRP2 TAD C10 DCA INTRP3 /KSF IOT +10 = TSF IOT TAD INTRP3 IAC DCA INTRP4 /TSF IOT + 1 = TCF IOT TAD I (TEMP1 MTON /IF PDP-8/L, TURN ON PROPER USER CLA /CLEAR GARBAGE INTRP2, HLT /KEYBOARD INTERRUPT? JMP .+3 /NO CIF /KEY ROUTINE IS IN FIELD 0 JMS I (KEY /READ TTY TAD I (TEMP1 MTON /TURN THE USER ON AGAIN CLL RAR /SHIFT FOR NEXT USER SNA /FIRST TIME THROUGH? L4000 /YES: GET TTY #1 BIT DCA I (TEMP1 INTRP3, HLT /TELEPRINTER INTERRUPT? JMP .+4 /NO INTRP4, HLT /CLEAR ITS FLAG CIF /SERVICE ROUTINE IS IN FIELD 0 JMS I (TTY /DO TTY OUTPUT ISZ I (USER /NEXT USER ISZ INTRP1 /SET TO GET NEXT USER'S TLS IOT TAD I (USER TAD MUSER /MINUS THE NUMBER OF USERS SZA CLA /ARE WE DONE? JMP INTRP1 /NO INTRP5, TAD AUSER /BIT PATTERN FOR ALL USERS MTON /TURN ALL USERS ON AGAIN L0001 MINT /WITH INTERRUPTS CLA CIF CDF /PUT RUNNING USER "ON DECK" JMP I (F0DCKN INTRP6, TAD SAVT3 /RESTORE ALL THOSE SAVED THINGS DCA I (T3 TAD SXREG3 DCA I (XREG3 TAD SSRTCN DCA I (SORTCN TAD SAXUDF DCA I (XUDF TAD SSORTC DCA I (XSORTC TAD SXFREE DCA I (XFREE ISZ I (INTCNT /COUNT INTERRUPTS FOR RANDOMIZE STATEMENT C10, 10 /A HARMLESS CONSTANT THAT BUFFERS THE ISZ TAD SAVF RTF /RESTORE LINK, CORE FIELD INFORMATION CLA TAD SAVAC JMP I SAVRES /RESUME EDU200 PAGE
/KEYWORD DECODER (*COMMAN* ROUTINE) MANCOM, TAD LIST1 /START OF KEYWORD LIST DCA KLU6 /POINTER TO KEYWORD LIST TAD (-41 /-NUMBER OF KEYWORDS DCA KLU1 /KEYWORD NUMBER COUNTER TAD I (AXOUT /SAVE TEXT POINTERS QUICKLY DCA KLU2 /SAVED AXOUT TAD I (GTEM DCA KLU3 /SAVED GTEM TAD I (XCT DCA KLU4 /SAVE XCT TAD I (CHAR DCA KLU5 /SAVED CHAR COM1, TAD KLU6 /GET KEYWORD LIST POINTER DCA KLU /POINT TO KEYWORD TEXT CDF 10 /THE KEYWORD LIST IS IN FIELD 1 TAD I KLU6 /GET POINTER TO NEXT KEYWORD DCA KLU6 /SAVE IN KEYWORD POINTER COM5, ISZ KLU /POINT TO NEXT 2 CHARS TAD I KLU /GET THE 2 CHARS DCA KLU8 /SAVE THEM L7777 DCA KLU7 /INDICATE PARTIAL CHAR IN KLU8 TAD KLU8 /GET THE 2 CHARS RTR /SHIFT THE LEFT HAND ONE INTO POSITION RTR RTR JMP COM6 /GO USE IT COM2, CIF CDF 0 /GETC ROUTINE IS IN FIELD 0 JMP I (F0GETC /JMP TO FLD0 ROUTINE THAT CALLS GETC COM7, ISZ KLU7 /IS THERE A PARTIAL CHAR IN KLU8? JMP COM5 /NO: GET ONE, THEN TAD KLU8 /YES: GET IT COM6, AND (77 /CHOP OFF THE LEFT HAND GARBAGE SNA /END OF KEYWORD? JMP COM4 /YES: KEYWORD FOUND TAD (40 /ADJUST TO ASCII CIA CDF 0 TAD I (CHAR /CHARACTOR FROM PROGRAM TEXT SNA CLA /MATCH? JMP COM2 /YES: TEST NEXT TWO CHARACTORS TAD KLU2 /NO: RESTORE TEXT POINTERS TO INITIAL STATE DCA I (AXOUT TAD KLU3 DCA I (GTEM TAD KLU4 DCA I (XCT TAD KLU5 DCA I (CHAR ISZ KLU1 /INCREMENT KEYWORD COUNTER JMP COM1 /THERE ARE MORE KEYWORDS TO TRY TAD (-41 /NUMBER FOR UNKNOWN KEYWORD COM4, TAD KLU1 /GET KEYWORD NUMBER CIF CDF 0 /FOR RETURN TO FIELD 0 JMP I (F0CMN1 /RETURN TO FIELD 0 KLU, 0 /KEYWORD TEXT UNPACK POINTER KLU1, 0 /KEYWORD NUMBER CONTER KLU2, 0 /SAVED AXOUT KLU3, 0 /SAVED GTEM KLU4, 0 /SAVED XCT KLU5, 0 /SAVED CHAR KLU6, 0 /POINTER TO NEXT KEYWORD KLU7, 0 /KEYWORD TEXT UNPACK FLAG KLU8, 0 /KEYWORD TEXT UNPACK PARTIAL CHARACTOR /USED BY THE GETC ROUTINE XGETL2, XGET5-1 /CR XGET4-1 /BELL XGET3-1 /SPACE /USED BY THE EDIT COMMAND MODL2, MODF5-1 /CR MODF2-1 /BELL MODF4-1 /RUBOUT MODF4-1 /BACK ARROW MODF1+2-1 /SEARCH CHARACTOR MODF1-1 /FORM FEED MODF3-1 /LINE FEED ALT, 176 /3 CODES FOR ALTMODE 175 33 F1CCR, 15 /CR 7 /BELL 177 /RUBOUT 137 /BACK ARROW LSTMOD, -1 /LIST TERMINATOR OR SEARCH CHAR FOR EDIT 14 /FORM FEED 12 /LINE FEED /LIST OF THIRD LETTERS OF THE FUNCTION NAMES FUNL2, -116 /SIN -123 /COS -116 /ATN -120 /EXP -107 /LOG -123 /ABS -122 /SQR -116 /SGN -124 /INT -104 /RND -130 /FIX -116 /TAN -116 /LEN -104 /MID -124 /CAT /PART OF THE KEYWORD LIST LIST1, LIST43 /POINTER TO START OF LIST 6441 /TA 6045 /PE 0000 /SPACE,SPACE /SPECIAL KEYWORD LIST LISTCH, LISTTA 4350 /CH LIST0, 6204 /R$ 0000 /SPACE,SPACE LISTTA, LIST0 6441 /TA 4200 /B,SPACE PAGE
/KEYWORD LIST LIST43, LIST40 /LINK TO NEXT KEYWORD 5445 /LE 6400 /T,SPACE LIST40, LIST37 6062 /PR 5156 /IN 6400 /T,SPACE LIST37, LIST36 4757 /GO 6457 /TO 0000 /SPACE,SPACE LIST36, LIST35 5146 /IF 0000 /SPACE,SPACE LIST35, LIST34 6450 /TH 4556 /EN 0000 /SPACE,SPACE LIST34, LIST33 4657 /FO 6200 /R,SPACE LIST33, LIST32 6457 /TO 0000 /SPACE,SPACE LIST32, LIST31 6364 /ST 4560 /EP 0000 /SPACE,SPACE LIST31, LIST30 5645 /NE 7064 /XT 0000 /SPACE,SPACE LIST30, LIST27 5156 /IN 6065 /PU 6400 /T,SPACE LIST27, LIST26 4441 /DA 6441 /TA 0000 /SPACE,SPACE LIST26, LIST25 6245 /RE 4144 /AD 0000 /SPACE,SPACE LIST25, LIST24 4757 /GO 6365 /SU 4200 /B,SPACE LIST24, LIST23 6245 /RE 6465 /TU 6256 /RN 0000 /SPACE,SPACE LIST23, LIST22 4445 /DE 4600 /F,SPACE LIST22, LIST21 4656 /FN 0000 /SPACE,SPACE LIST21, LIST20 5756 /ON 0000 /SPACE,SPACE LIST20, LIST17 6245 /RE 5500 /M,SPACE LIST17, LIST16 5451 /LI 5660 /NP 6564 /UT 0000 /SPACE,SPACE LIST16, LIST15 6245 /RE 6364 /ST 5762 /OR 4500 /E,SPACE LIST15, LIST14 4451 /DI 5500 /M,SPACE LIST14, LIST13 6241 /RA 5644 /ND 5755 /OM 0000 /SPACE,SPACE LIST13, LIST12 6364 /ST 5760 /OP 0000 /SPACE,SPACE LIST12, LIST11 4556 /EN 4400 /D,SPACE LIST11, LIST10 5451 /LI 6364 /ST 0000 /SPACE,SPACE LIST10, LIST7 6265 /RU 5600 /N,SPACE LIST7, LIST6 4544 /ED 5164 /IT 0000 /SPACE,SPACE LIST6, LIST5 4445 /DE 5445 /LE 6445 /TE 0000 /SPACE,SPACE LIST5, LIST4 6343 /SC 6241 /RA 6443 /TC 5000 /H,SPACE LIST4, LIST3 5645 /NE 6700 /W,SPACE LIST3, LIST2 4271 /BY 4500 /E,SPACE LIST2, LIST1 5345 /KE 7100 /Y,SPACE
/A WHOLE BUNCH OF SORTC AND SORTJ LISTS /USED BY THE EDIT COMMAND MODL1, MODF5-1 /CR MODF1+5 /BELL /USED BY THE PRINT STATEMENT PRINL2, PRIN71-1 /CR PRIN61-1 /" /CONTINUATION OF MODL1 MODF4-1 /SEARCH CHARACTOR /USED BY THE PRINT STATEMENT PRINL, 73 /; 54 /, 47 /' 72 /: PRINLB, 15 /CR 42 /" 7777 PRINL1, PRINT5-1 /; PRINT4-1 /, PRINT7-1 /' PRINT7-1 /: PRINT7-1 /CR PRINT6-1 /" /LIST OF STANDARD EDU200 BASIC TERMINATORS TERMS, 40 /SPACE 0 53 /+ 1 55 /- 2 52 /* 3 57 // 4 136 /^ 5 50 /( 6 133 /[ 7 51 /) 10 135 /] 11 74 /< 12 76 /> 13 75 /= 14 7777 /USED BY THE GETC ROUTINE XGETL1, 137 /CR 100 /BELL 40 /SPACE 7777 /USED BY THE PACKC ROUTINE XPAKL1, 15 /CR 7 /BELL 177 /RUBOUT 137 /BACK ARROW 176 /3 CODES FOR ALTMODE 175 33 100 /@ 7777 XPAKL2, XPACK2-1 /CR XPACK3-1 /BELL XPACK7-1 /RUBOUT XPACK7-1 /BACK ARROW XPPCK1-1 /3 ALTMODES XPPCK1-1 XPPCK1-1 XPACK5-1 /@ /FIRST 2 CHARACTORS OF THE FUNCTION NAMES (USED BY GETVAR) FUNL1, 316 /FN 1151 /SI 157 /CO 64 /AT 270 /EX 617 /LO 42 /AB 1161 /SQ 1147 /SG 456 /IN 1116 /RN 311 /FI 1201 /TA 14^40+5 /LE 15^40+11 /MI 3^40+1 /CA 7777 /USED BY THE IF STATEMENT IF4, 1 /< 5 /> 11 /= 4 /<= 10 />= 3 /<> 7777 /LIST OF ERROR ADDRESSES (USED BY THE ERROR ROUTINE) ERRLST, ERR004 /STOP (CONTROL-C) ERR010 /ERROR 1 ERR020 /ERROR 2 ERR030 ERR040 ERR060 ERR070 ERR080 ERR100 ERR150 ERR110 ERR120 ERR260 ERR220 ERR130 ERR230 ERR170 ERR250 ERR210 ERR200 ERR180 ERR240 ERR410 ERR450 ERR430 ERR420 ERR440 ERR460 ERR470 ERR350 ERR340 ERR270 ERR370 ERR380 ERR390 ERR400 ERR500 ERR490 ERR510 ERR320 ERR330 ERR300 ERR280 ERR520 ERR001 ERR002 ERR003 ERRBEX /SYNTAX ERROR IN AN EXPRESSION ERRSAR /MISSING ARGUMENT TO MID OR CAT FUNCTION ERRSOV /STRING OVERFLOW IN MID FUNCTION ERREND=. 7777
ORG=. IFDEF CONFIG < ENPUNCH FIELD 0 *SIN 0 *LOOK USER0-1 *KL8JMP TAD LOOKST DCA LOOK SKP *MLOOKE -USER7+10 *XOUTL6-3 MTON *XOUTL6+3 MTON *XOUTL6+5 MINT *USER0 0 1 2 3 4 5 6 7 *DECKON NULL+1 *DFIND ENTRY1 NOPUNCH >
/USER DEFINITIONS LIMIT=7776 /HIGHEST CORE POSITION SWAPR=ENSWAP-STSWAP+1 /SWAP LENGTH BUFFER=ORG+SWAPR+40 BUFCOM=ORG+SWAPR+100 LINE0=ORG+SWAPR+162 LINE1=ORG+SWAPR+164 TOP=LIMIT
FIELD 1 *1200 MONDSK, 1773 3772 2372 2373 5356 1371 3350 1371 3351 5770 7573 7576 7573 7774 6603 6622 5374 7610 MONTAP, 1774 3773 2373 2374 5356 3354 1372 3355 1371 5770 7575 0220 7577 7575 7775 6766 6771 5376 OSDRK8, 1377 3030 1376 3031 5030 0 0 0 0 0 0 0 0 0 0 0 5031 6733 OSDDSK, 1772 3771 2371 2372 5356 5350 0 0 0 0 0 7750 7773 7600 6603 6622 5352 5752 OSDDTA, 6774 1377 3354 1376 3355 1375 6766 6771 5365 1374 6766 6771 5371 5200 220 600 7577 7700 OS8ERM, TEXT %ILLEGAL OS/8 DEVICE FOUND_CAN'T SAVE BOOTSTRAP__% OS8MSG, TEXT %__TO BOOTSTRAP BACK % OS8M1, TEXT %OS/8% OS8M2, TEXT % MONITOR:_ LOAD ADDRESS 07600_ AND START__% DISKMM, TEXT %DISK% TAPMM, TEXT %TAPE%
*1600 BEGOS8, CDF 10 TAD I (7760 /GET DCB OF SYS: AND (770 TAD (-050 /5 IS RK8 SPA JMP OS8ERR /<5 IS ERROR SNA JMP OS8RK8 /5 = RK8 TAD (050-160 /16 IS DECTAPE SPA JMP OS8KSK /6 TO 15 = DSK SNA CLA JMP OS8DTA /16 = DTA: OS8ERR, CLA JMS I (BEG003 OS8ERM /BAD OS8 DEVICE JMP I (BEGMV4 /DO NOT SET UP ANYTHING OS8KSK, CLA JMP OS8DSK IAC IAC OS8DSK, IAC OS8DTA, IAC OS8RK8, IAC TAD (OS8LST-1 DCA OS8PTR TAD I OS8PTR DCA OS8PTR /POINT TO BOOTSTRAP OS8LP1, CDF 10 TAD I OS8PTR ISZ OS8PTR CDF DCA I OS8PT2 ISZ OS8PT2 JMP OS8LP1 CDF 10 JMS I (BEG003 OS8MSG /OS8 MESSAGE JMS I (BEG003 OS8AB, OS8M1 JMS I (BEG003 OS8M2 JMP I (BEGMV4 OS8PTR, 0 OS8PT2, 7756 /INTO RIM LOCATIONS OS8LST, OSDRK8 OSDDTA OSDDSK MONDSK MONTAP TAPEM, CDF 10 TAD (600 DTXA DTCA /REWIND TAPE DTSF JMP .-1 TAD (TAPMM DCA OS8AB JMP OS8DSK-2 DISKM, CDF 10 TAD (DISKMM DCA OS8AB JMP OS8DSK-1
IFDEF CONFIG < PAGE ENPUNCH
FIELD 1 >
*2000 BEGIN, JMP .+3 /NORMAL ENTRY NOP /SO YOU CAN CHAIN TO US IFDEF CONFIG < HLT /NO CONFIG FOR OS/8 > IFNDEF CONFIG < JMP I (BEGOS8 /OS8 ENTRY POINT > BEGMV4, CDF 10 TAD I BEGMV1 /MOVE PAGE 7600 FIELD 0 INTO ITS SPOT CDF DCA I BEGMV2 ISZ BEGMV1 ISZ BEGMV2 ISZ BEGMV3 JMP BEGMV4 IFNDEF CONFIG < TAD I (FLOP DCA I (OPTABL+5 > CDF 10 TAD I BEGIN1 /MAKE SURE THAT NO ERRORS ARE NEG. SO THAT /THEY DON'T TERMINATE TABLE IAC CLL RAR DCA I BEGIN1 ISZ BEGIN1 ISZ BEGIN2 JMP .-6 BEG002, CDF 10 KCC TAD (BEGIOT DCA BEG012 TAD (-4 DCA BEG013 TAD (120 DCA I BEG012 ISZ BEG012 ISZ BEG013 JMP .-4 JMS I (BEG003 BEGM1 /INIT MESSAGE BEG006, JMS I (BEG003 BEGM2 /# USER MESSAGE JMS I (BEG001 TAD (-"8 SMA SZA JMP I (BEG005 TAD (10 SPA SNA JMP I (BEG005 CIA DCA BEGUSR BEG008, JMP I (BEGX08 CORDON, CDF 10 TAD BEGUSR IAC SNA CLA JMP BEG010 BEG009, JMS I (BEG003 BEGM4 /DC02? JMS I (BEG001 TAD (-"Y SNA JMP BEG010+1 TAD (331-316 SNA CLA JMP BEG010 JMS I (BEG003 BEGME JMP BEG009 BEG010, L7777 DCA BEGDEV TAD BEGDEV SNA CLA JMP I (BEG011 TAD (BEGIOT DCA BEG012 TAD BEGUSR DCA BEG013 TAD (410 DCA BEG12A BEG14B, ISZ BEG013 JMP BEG14A JMP I (BEG015 BEG14A, TAD BEG12A DCA I BEG012 ISZ BEG012 TAD BEG12A TAD (20 DCA BEG12A JMP BEG14B BEG12A, 400 BEG012, 0 BEG013, 0 BEGIN1, ERRLST BEGIN2, ERRLST-ERREND BEGMV1, F0P37 BEGMV2, 7600 BEGMV3, -156
PAGE BEG015, TAD BEGUSR IAC SNA CLA JMP I (BEG011 BEG15E, JMS I (BEG003 BEGM7 /STANDARD? JMS I (BEG001 TAD (-"Y SNA JMP I (BEG011 TAD (331-316 SNA CLA JMP BEG15A JMS I (BEG003 BEGME JMP BEG15E BEG15A, TAD BEGUSR DCA BEG15B TAD (BEGIOT DCA BEG15C TAD (4361 /TEXT "#1" DCA I (BEGM5A BEG15D, ISZ BEG15B JMP BEG014 JMP I (BEG011 BEG15C, 0 BEG15B, 0 BEG014, JMS I (BEG003 BEGM5 /DEVICE CODE JMS I (BEG001 TAD (-"7 SMA SZA JMP I (BEG016 TAD (7 SPA JMP I (BEG016 CLL RTL RTL RTL DCA I BEG15C JMS I (BEG001 TAD (-"7 SMA SZA JMP I (BEG016 TAD (7 SPA JMP I (BEG016 IAC CLL RTL RAL TAD I BEG15C DCA I BEG15C ISZ BEG15C ISZ I (BEGM5A JMP BEG15D /FIGURE OUT HIGHEST CORE FIELD FOR HIM BEGX08, L0001 DCA BEGCOR /FIELD 1 TOP TO START WITH TAD (6221 DCA BEGCHK TAD CNOP CDF DCA I (0 CDF 10 TAD CNOP DCA I (0 BEGCHK, 0 TAD (1000 DCA I (0 CNOP, NOP TAD I (0 SKP /PDP-8 NXM BUG HLT /THIS SHOULD HAUL DOWN A PDP-8 CDF 10 /DOUBLE CHECK FOR PDP8/L TAD I (0 SZA CLA JMP I (CORDON /NO MORE CORE TAD (1000 CDF TAD I (0 SZA CLA JMP I (CORDON /NO MORE CORE-PROBABLY A PDP-8/L ISZ BEGCOR /THIS FIELD WAS SUCCESSFUL TAD BEGCHK TAD (10 DCA BEGCHK JMP BEGCHK
PAGE BEG016, JMS BEG003 BEGME JMP I (BEG014 BEG005, JMS BEG003 BEGME JMP I (BEG006 BEG007, JMS BEG003 BEGME JMP I (BEG008 BEG001, 0 KSF JMP .-1 KRB TAD (-203 SNA JMP I (BEG002 TAD (203 TLS TSF JMP .-1 JMP I BEG001 BEG003, 0 CLA TAD I BEG003 DCA BEG004 ISZ BEG003 TAD I BEG004 CLL RTR RTR RTR JMS BEG03X TAD I BEG004 JMS BEG03X ISZ BEG004 JMP BEG003+5 BEG03X, 0 AND (77 SNA JMP I BEG003 TAD (-37 SNA JMP CRLF SPA TAD (100 TAD (237 JMS TTCHAR JMP I BEG03X TTCHAR, 0 TLS CLA TSF JMP .-1 KSF JMP I TTCHAR JMP I BEG003 /EXIT ON CHAR. CRLF, TAD (215 JMS TTCHAR TAD (212 JMP TTCHAR-2 BEG004, 0 BEGME, TEXT %_INVALID RESPONSE_% BEGM1, TEXT "__EDU200 BASIC_" BEGM2, TEXT %_NUMBER OF USERS (1 TO 8)?% PAGE
BEGM4, TEXT %_PDP-8/L COMPUTER (Y OR N)?% BEGM5, TEXT %_TELETYPE #1 DEVICE CODE?% BEGM5A=BEGM5+5 BEGM7, TEXT %_STANDARD REMOTE TELETYPE CODES (Y OR N)?% BEGMFL, TEXT %_FIELD % BEGMXX, TEXT %_THERE ARE % BEGMX1, TEXT % BLOCKS LEFT IN THIS FIELD._ YOUR ALLOCATION FOR USER #% BEGTTI, TEXT % WILL BE HOW MANY BLOCKS?% BEGM6, TEXT %__END OF DIALOGUE_% WNGDM, TEXT %_BLOCK SIZES DON'T WORK--HAVE TO START AGAIN__% BEGMQ, TEXT %_SAME AMOUNT OF STORAGE FOR ALL USERS?% BEGM6A, TEXT %_IS THE ABOVE CORRECT (Y OR N)?%
PAGE BEG011, TAD BEGUSR IAC SNA CLA JMP I (BEGOLD /ONLY 1 USER, ASSUME ANSWER! JMS I (BEG003 BEGMQ JMS I (BEG001 TAD (-"N SNA JMP I (BEG500 /GO ASK FOR IT TAD (-"Y+"N SNA CLA JMP I (BEGOLD /THIS WAS AN AFTERTHOUGHT, QUITE FRANKLY JMS I (BEG003 BEGME JMP BEG011 /ASK HIM AGIN PAGE
LBLK=SS OLNUM=USRPT2 NUNUM=CORPT2 BEGER0, CDF 10 JMS I (BEG003 WNGDM BEG500, CDF 10 TAD BEGUSR DCA USRCTR TAD (USRLST DCA USRPTR TAD BEGCOR IAC DCA CURFLD BEGFLD, L7777 TAD CURFLD SPA SNA JMP BEGER0 /EH? DCA CURFLD JMS I (BEG003 BEGMFL TAD (60 TAD CURFLD TLS TSF JMP .-1 L7777 TAD CURFLD SNA CLA L7775 /3 'BLOCKS' LESS IN FLD 1 TAD (20 /20 LOGICAL BLOCKS IN OTHERS DCA LBLK BEGXXX, JMS I (BEG003 BEGMXX TAD LBLK JMS I (BEGPRNT JMS I (BEG003 BEGMX1 JMS I (BEG001 TAD (-"8 SMA SZA JMP BEGER1 TAD (10 SPA SNA JMP BEGER1 /BAD USERNO DCA I USRPTR TAD BEGUSR TAD I USRPTR SMA SZA CLA JMP BEGER1 /NONEXISTENT USER DUMMY ISZ USRPTR TAD CURFLD DCA I USRPTR ISZ USRPTR /AND HIS NO. BEGRE, JMS I (BEG003 BEGTTI DCA OLNUM /DOUBLE CHECK! BEGINP, JMS I (BEG001 TAD (-215 SNA JMP DN TAD (215-"9 SMA SZA JMP BEGER2 /UNGOOD NO TAD (11 SPA JMP BEGER2 /LIKEWISE DCA NUNUM TAD OLNUM /MULT BY 10 DECIM CLL RAL RTL TAD OLNUM TAD OLNUM TAD NUNUM /PLUS NEW DIGIT DCA OLNUM /MAKES NEW NO JMP BEGINP DN, TAD OLNUM SNA SPA SZL JMP BEGER2 /JUNKY NO CIA TAD LBLK SPA JMP BEGER0 /TOO MUCH ASKED FOR DCA LBLK /NEW AMOUNT REMAINING TAD OLNUM ISZ USRCTR SKP JMP BEGR2 DCA I USRPTR ISZ USRPTR TAD LBLK SZA CLA /MORE TO COME IN THIS FIELD? JMP BEGXXX /SURE IS L7777 TAD CURFLD SPA CLA JMP BEGER0 JMP BEGFLD /MORE FIELDS TO COME BEGER2, JMS I (BEG003 BEGME JMP BEGRE BEGER1, JMS I (BEG003 BEGME JMP BEGXXX BEGR2, TAD LBLK /EXPAND HIM TO FINISH FIELD DCA I USRPTR /THERE'S NO REASON TO WASTE CORE ISZ USRPTR /JUST THINK OF ALL THE PEOPLE WHO GO TO BED HUNGRY FOR IT EVERY NIGHT! JMP I (BEG540
PAGE BEG540, CLA CLL IAC BSW TAD (-100 SZA CLA JMP BEG550-2 /NOT AN 8/E TAD KL8FRST SZA CLA /FIRST TIME THROUGH JMP BEG550 /NO ISZ KL8FRST /SIGNIFY DONE TAD BEGDEV SNA CLA JMP BEG550-1 /THE FOOL HAS AN 8/E WITH DC02 TAD I BEGKL1 DCA I BEGKL2 ISZ BEGKL1 ISZ BEGKL2 /MOVE PATCH TO PROPER POSITION JMP .-4 CDF TAD (CIF 10 DCA I BEGKL3 ISZ BEGKL3 TAD (KL8JMP+2&177+5600 DCA I BEGKL3 ISZ BEGKL3 TAD (KL8FIX DCA I BEGKL3 CDF 10 TAD (KL8FIX JMP BEG550-1 /SET TOP OF FIELD 1 BEGKL1, KL8LOD BEGKL2, KL8FIX KL8FRST, 0 BEGKL3, KL8JMP
DCA I (INTRRV DCA KLTOP BEG550, TAD (USRLST /NOW WE SORT FOR FIELDS TO MAKE IT EASY DCA USRPTR L0003 TAD (USRLST DCA CORPTR TAD BEGUSR DCA USRCTR DCA SS /SORT SWITCH FOR MODIFIED BUBBLE SORT BEG551, TAD USRPTR IAC DCA USRPT2 TAD CORPTR IAC DCA CORPT2 ISZ USRCTR SKP JMP BEG553 TAD I USRPT2 CIA TAD I CORPT2 SNA SPA CLA JMP BEG552 L7775 DCA SS /3 SWAPS TAD I USRPTR DCA 0 TAD I CORPTR DCA I USRPTR TAD 0 DCA I CORPTR ISZ USRPTR ISZ CORPTR ISZ SS JMP .-11 ISZ SS /SET TO INDICATE BEG552, L0002 TAD USRPT2 DCA USRPTR L0002 TAD CORPT2 DCA CORPTR JMP BEG551 BEG553, TAD SS SZA CLA JMP BEG550 JMP I (BEG600 PAGE BEG600, TAD (BEGLST DCA USRPT2 TAD (USRLST DCA USRPTR TAD BEGUSR DCA USRCTR TAD BEGUSR DCA I (BEGUS1 TAD I (USRLST+1 BEG610, DCA CURFLD L7777 TAD CURFLD SZA CLA JMP .+12 TAD KLTOP DCA BEG602 TAD BEGUSR DCA SS TAD (ENSWAP-STSWAP+1 ISZ SS JMP .-2 TAD (ORG JMP .+3 DCA BEG602 TAD (CONEND DCA BEG601 NXUSR, TAD I USRPTR ISZ USRPTR DCA I USRPT2 ISZ USRPT2 TAD I USRPTR CIA TAD CURFLD SZA CLA JMP BEG609 /HE WANTS A NEW FIELD ISZ USRPTR TAD CURFLD CLL RAL RTL TAD (6201 /MAKE UP XFIELD OP DCA I USRPT2 /INTO OUR QUICKIE LIST ISZ USRPT2 TAD I USRPTR ISZ USRPTR CIA DCA SS TAD (400 ISZ SS JMP .-2 /MULT. HIS BLOCKSIZE BY 400 OCTAL FOR CORE SIZE DCA SS L7776 TAD BEG602 DCA I USRPT2 ISZ USRPT2 TAD SS CIA TAD BEG602 DCA BEG602 L0004 TAD BEG602 SPA CLA JMP BEG608-1 TAD BEG602 SPA JMP BEG607 CIA TAD BEG601 SMA CLA JMP BEG607 TAD BEG602 BEG608, DCA I USRPT2 ISZ USRPT2 ISZ USRCTR JMP NXUSR JMP I (BEG700 /WHEW..THAT WENT QUICKLY ANYWAY BEG601, 0 /BOTTOM BEG602, 0 /TOP BEG609, TAD USRPTR DCA CURFLD /SAVE IT L7777 TAD USRPTR DCA USRPTR /TAKE OUT ENTRIES L7777 TAD USRPT2 DCA USRPT2 TAD I CURFLD /COUNT DOWN FIELD JMP BEG610 BEG607, CLA TAD BEG601 JMP BEG608
PAGE BEG700, TAD (BEGLST DCA USRPTR DCA SS TAD BEGUSR DCA USRCTR L0004 TAD (BEGLST DCA USRPT2 BEG7X1, ISZ USRCTR SKP JMP BEG703 TAD I USRPTR CIA TAD I USRPT2 SNA JMP I (BEGER0 /MULTIPLE ASSIGNMENTS FOR ONE USER SMA CLA JMP BEG702 TAD (-4 DCA SS BEG701, TAD I USRPTR DCA CORPTR TAD I USRPT2 DCA I USRPTR TAD CORPTR DCA I USRPT2 ISZ USRPTR ISZ USRPT2 ISZ SS JMP BEG701 ISZ SS TAD (-4 BEG702, TAD USRPT2 DCA USRPTR L0004 TAD USRPTR DCA USRPT2 JMP BEG7X1 BEG703, TAD SS SZA CLA JMP BEG700 /MORE TO COME TAD (BEGLST DCA USRPTR /NOW TAKE OUT USER NOS. TAD BEGUSR DCA USRCTR IAC TAD (BEGLST DCA USRPT2 BEG704, L7775 DCA SS TAD I USRPT2 DCA I USRPTR ISZ USRPTR ISZ USRPT2 ISZ SS JMP .-5 ISZ USRPT2 /SKIP OVER USER NO. ISZ USRCTR JMP BEG704 JMS I (BEG003 BEGM6A JMS I (BEG001 TAD (-"Y SZA CLA JMP I (BEG002 /OH NO--ALL THIS JUNK FOR NOTHING! JMS I (BEG003 BEGM6 JMP I (BEG750
BEGPRNT,0 DCA BEG705 TAD (-12 DCA BEG706 DCA BEG707 JMP .+3 ISZ BEG707 DCA BEG705 BEGPR1, TAD BEG705 TAD BEG706 SMA JMP .-5 CLA TAD (60 TAD BEG707 TLS TSF JMP .-1 KCC ISZ BEG706 SKP JMP I BEGPRNT /WAS SECOND TIME THROUGH L7777 DCA BEG706 DCA BEG707 JMP BEGPR1 BEG706, 0 BEG707, 0 BEG705, 0
BEG604=SS BEG605=USRPTR PAGE BEG750, TAD (7763 /CR,S DCA 0 /THIS WAS WIPED OUT BY INITIALIZER CDF TAD I (MLOOKE TAD BEGUSR DCA I (MLOOKE /CORRECT FOR NO. OF USERS TAD I (MLOOKE CIA DCA I (LOOK TAD (BEGIOT-1 DCA BEG604 TAD (INTRPL DCA BEG605 L7777 TAD BEGUSR DCA BEG60X TAD (-10 DCA USRCTR BEG75Q, CDF 10 TAD I BEG604 ISZ BEG604 ISZ BEG60X JMP .+4 CLA CMA DCA BEG60X TAD (CLA-6006 TAD (6006 DCA I BEG605 ISZ BEG605 ISZ USRCTR JMP BEG75Q TAD BEGUSR DCA SS SKP CLA CLL CML RAR ISZ SS JMP .-2 IAC DCA AUSER BEG75X, TAD BEGCOR CLL RTL RAL TAD (CDF DCA BEG756 TAD BEG756 TAD (-6211 SNA CLA JMP BEG760 TAD (-CONEND DCA BEG753 DCA BEG752 BEG755, CDF 10 TAD I BEG752 BEG756, CDF 20 DCA I BEG752 ISZ BEG752 ISZ BEG753 JMP BEG755 DCA I BEG752 ISZ BEG752 JMP .-2 L7777 TAD BEGCOR DCA BEGCOR JMP BEG75X BEG60X, 0 BEG752, 0 BEG753, 0 BEG760, TAD BEGDEV SNA CLA JMP I (BEG76X CDF DCA I (XOUTL6-3 DCA I (XOUTL6+3 DCA I (XOUTL6+5 CDF 10 DCA I (INTRP2-2 DCA I (INTRP3-5 DCA I (INTRP5+1 DCA I (INTRP5+3 DCA I (INTRRV+2 DCA I (INTRRV+4 JMP I (BEG800 PAGE BEG76X, CDF 10 TAD (TLS DCA I (INTRV2-3 TAD (MTLS DCA I (INTRV2-2 JMP I (BEG800 PAGE USRLST, 0 PAGE /THIS ROUTINE DOES ALLOCATION THE OLD WAY IF YOU ASK FOR THE SAME AMOUNT /OF CORE FOR ALL USERS. IT DOES A TABLE LOOKUP ON BEGCOR&BEGUSR AND /ENTERS THINGS IN USRLST THE WAY YOU WOULD IF YOU ANSWERED QUESTIONS BEGOLD, TAD BEGCOR CLL RTL RAL TAD BEGUSR /GET ADDR. OF ADDR. OF LIST TAD (BGLD1 DCA SS TAD I SS DCA SS TAD (USRLST DCA USRPTR /SETUP TO SLIDE TAD BEGUSR DCA USRCTR /NO. OF SLIDES BEGOL1, TAD I SS CLL RTL RTL AND (7 IAC /CORRECT USERNO. DCA I USRPTR ISZ USRPTR TAD I SS CLL RTR RTR RTR AND (7 /SET FIELD DCA I USRPTR ISZ USRPTR TAD I SS AND (37 DCA I USRPTR ISZ SS ISZ USRPTR ISZ USRCTR JMP BEGOL1 JMP I (BEG540 /CONTINUE ON...WE'VE ANSWERED QUESTIONS FOR HIM NOW. PAGE /THE FORMAT OF THE FOLLOWING LIST OF ANSWERS IS THE FOLLOWING: /(USER NO. [0 TO 7] +FIELD)TIMES 100 PLUS BLOCKSIZE. /THIS GETS ALL THREE DATA ABOUT EACH USER INTO ONE WORD. /THE USER NO. IS INTERNAL USER NO. OR EXTERNAL USER NO.-1 X=100 BGL11, 1^X+15 BGL12, 1^X+6 11^X+7 BGL13, 01^X+5 11^X+4 21^X+4 BGL14, 01^X+4 11^X+3 21^X+3 31^X+3 BGL15, 01^X+3 11^X+3 21^X+3 31^X+2 41^X+2 BGL16, 01^X+3 11^X+2 21^X+2 31^X+2 41^X+2 51^X+2 BGL17, 01^X+2 11^X+2 21^X+2 31^X+2 41^X+2 51^X+2 61^X+1 BGL18, 01^X+2 11^X+2 21^X+2 31^X+2 41^X+2 51^X+1 61^X+1 71^X+1 BGL22, 11^X+15 BGL21, 02^X+20 BGL31=BGL21 BGL41=BGL21 BGL51=BGL21 BGL61=BGL21 BGL71=BGL21 BGL23, 01^X+15 12^X+10 22^X+10 BGL24, 02^X+10 12^X+10 21^X+7 31^X+6 BGL25, 01^X+7 11^X+6 22^X+6 32^X+5 42^X+5 BGL26, 02^X+6 12^X+5 22^X+5 31^X+5 41^X+4 51^X+4 BGL27, 01^X+5 11^X+4 21^X+4 32^X+4 42^X+4 52^X+4 62^X+4 BGL28, 02^X+4 12^X+4 22^X+4 32^X+4 41^X+4 51^X+3 61^X+3 71^X+3 BGL33, 21^X+15 BGL32, 02^X+20 13^X+20 BGL42=BGL32 BGL52=BGL32 BGL62=BGL32 BGL72=BGL32 BGL34, 02^X+20 11^X+15 23^X+10 33^X+10 BGL35, 01^X+15 12^X+10 22^X+10 33^X+10 43^X+10 BGL36, 02^X+10 12^X+10 23^X+10 33^X+10 41^X+7 51^X+6 BGL37, 02^X+10 12^X+10 21^X+7 31^X+6 43^X+6 53^X+5 63^X+5 BGL38, 01^X+7 11^X+6 22^X+6 33^X+6 42^X+5 52^X+5 63^X+5 73^X+5 BGL44, 31^X+15 BGL43, 02^X+20 13^X+20 24^X+20 BGL53=BGL43 BGL63=BGL43 BGL73=BGL43 BGL45, 02^X+20 13^X+20 21^X+15 34^X+10 44^X+10 BGL46, 02^X+20 11^X+15 23^X+10 33^X+10 44^X+10 54^X+10 BGL47, 01^X+15 12^X+10 22^X+10 33^X+10 43^X+10 54^X+10 64^X+10 BGL48, 61^X+7 71^X+6 02^X+10
12^X+10 23^X+10 33^X+10 44^X+10 54^X+10 BGL55, 41^X+15 BGL54, 02^X+20 13^X+20 24^X+20 35^X+20 BGL64=BGL54 BGL74=BGL54 BGL56, 02^X+20 13^X+20 24^X+20 31^X+15 45^X+10 55^X+10 BGL57, 02^X+20 13^X+20 21^X+15 34^X+10 44^X+10 55^X+10 65^X+10 BGL58, 02^X+20 11^X+15 23^X+10 33^X+10 44^X+10 54^X+10 65^X+10 75^X+10 BGL66, 51^X+15 BGL65, 02^X+20 13^X+20 24^X+20 35^X+20 46^X+20 BGL75=BGL65 BGL67, 41^X+15 02^X+20 13^X+20 24^X+20 35^X+20 56^X+10 66^X+10 BGL68, 02^X+20 13^X+20 24^X+20 31^X+15 45^X+10 55^X+10 66^X+10 76^X+10 BGL78, 71^X+15 BGL77, 67^X+20 BGL76, 02^X+20 13^X+20 24^X+20 46^X+20 35^X+20 BGLD1, BGL18 BGL17 BGL16 BGL15 BGL14 BGL13 BGL12 BGL11 BGL28 BGL27 BGL26 BGL25 BGL24 BGL23 BGL22 BGL21 BGL38 BGL37 BGL36 BGL35 BGL34 BGL33 BGL32 BGL31 BGL48 BGL47 BGL46 BGL45 BGL44 BGL43 BGL42 BGL41 BGL58 BGL57 BGL56 BGL55 BGL54 BGL53 BGL52 BGL51 BGL68 BGL67 BGL66 BGL65 BGL64 BGL63 BGL62 BGL61 BGL78 BGL77 BGL76 BGL75 BGL74 BGL73 BGL72 BGL71
*7400 40 BEGIOT, 120 120 120 120 40 40 40 BEG800, TAD (ORG DCA BEG801 CDF 10 DCA I BEG801 ISZ BEG801 TAD BEG801 TAD (-7400 SZA CLA JMP .-5 TAD (ORG DCA BEG801 TAD (BEGLST BEG8111, DCA BEG802 TAD (BEGLST+1 DCA BEG804 TAD (BEGLST+2 DCA BEG803 TAD (BEGIOT-1 DCA BEG805 BEG810, TAD I BEG804 JMS BEG900 /SETUP PDLXR L0004 JMS BEGZER TAD (READY /PC GETS READY FOR STARTUP JMS BEG900 TAD (10 JMS BEGZER L7777 /DINPUT SET TO INPUT MODE JMS BEG900 JMS BEG900 /OUTPUT GETS ZEROED FOR ECHO TAD I BEG805 /MAKE UP XIOT TAD (6006-10 JMS BEG900 TAD I BEG802 /MAKE UP XFIELD JMS BEG900 TAD (5 JMS BEGZER TAD (40 /NOW BUILD BUFFERS TAD I BEG803 /THIS IS IPTRI JMS BEG900 TAD (40 /AND IPTRO TAD I BEG803 JMS BEG900 TAD (40 /IPTR0 TAD I BEG803 JMS BEG900 TAD I BEG803 /OPTRI JMS BEG900 TAD I BEG803 /OPTRO JMS BEG900 L0003 JMS BEGZER TAD (164 /BUFR TAD I BEG803 JMS BEG900 TAD (164 /LASTV TAD I BEG803 JMS BEG900 TAD I BEG804 /PDLST JMS BEG900 TAD (162 /ALINE0 TAD I BEG803 JMS BEG900 TAD (100 /COMBUF TAD I BEG803 JMS BEG900 TAD (5 JMS BEGZER ISZ BEG802 ISZ BEG802 ISZ BEG802 ISZ BEG803 ISZ BEG803 ISZ BEG803 ISZ BEG804 ISZ BEG804 ISZ BEG804 ISZ BEG805 ISZ BEGUS1 JMP BEG810 CIF JMP I (ENTRY BEGUS1, 0 BEG801, 0 BEG802, 0 BEG803, 0 BEG804, 0 BEG805, 0 BEGZER, 0 CIA DCA BEG8111 JMS BEG900 ISZ BEG8111 JMP .-2 JMP I BEGZER BEG900, 0 DCA I BEG801 ISZ BEG801 JMP I BEG900 PAGE BEGLST=. $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search