File EDU250.PA (PAL assembler source file)

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

/EDUCOMP EDU250 BASIC
/EDU250 V3.019 3:15 PM 11/30/75
/RECONSTRUCTED 6:24 PM 3/21/76










	/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/A, -8/E, -8/M, -8/F, -8/I -8/L; /EDU250 BASIC IS FOR THE PDP-8/A, -8/E, -8/M, -8/F /WITH 8K OR MORE MEMORY AND KL8E OPTION. /THE POWER FAIL-AUTO RESTART OPTION ALSO IS SUPPORTED /FOR EDU200, BUT NOT FOR EDU250 (DURING FILE OPERATIONS). /OS/8 ASSEMBLY INSTRUCTIONS: / .R PAL8 / *EDU250<EDU250/K/E / ERRORS DETECTED: 0 / LINKS GENERATED: 0 / .R ABSLDR / *EDU250=14000$ / .SAVE SYS EDU250 / /TO RUN EDU250: / .R EDU250 /ASSEMBLY PARAMETERS: / /CONFIG: TO GET THE CONFIGURER TAPE ONLY, DEFINE / "CONFIG" AS 1. THE CONFIGURER IS A SHORT OVERLAY / TAPE TO EDU200 TO RERUN THE INITIAL DIALOG. IFNDEF CONFIG <CONFIG=0> IFNZRO CONFIG <NOPUNCH> / /USERS: THE NUMBER OF USERS ON THE SYSTEM. THIS PARAMETER / IS LEFT OVER FROM THE SYSTEM DEVELOPEMENT. THE / INITIAL DIALOG OVERRIDES THIS SETTING. IFNDEF USERS <USERS=1> / /PDP8I: SET TO A 1 IF THE COMPUTER ON WHICH EDU200 IS / TO BE RUN IS A PDP-8/I OR -8/L. / VALUE IS 0, INDICATING A PDP-8/E, -8/M, OR -8/F. / THE INITIAL DIALOG CHECKS TO MAKE SURE IT IS / RUNNING ON THE RIGHT MACHINE AND HALTS IF NOT. IFNDEF PDP8I <PDP8I=0> / /TD8E: SET TO 1 IF MASS STORAGE DEVICE IS TD8E DECTAPE. / SET TO 0 OTHERWISE. IFNDEF TD8E <TD8E=0> / /RK8E: SET TO 1 IF MASS STORAGE DEVICE IS RK8E DISK. / SET TO 0 OTHERWISE. IFNDEF RK8E <RK8E=0> / /RX8E: SET TO 1 IF MASS STORAGE DEVICE IS RX8E TYPE / FLOPPY DISK. SET TO 0 OTHERWISE. IFNDEF RX8E <RX8E=0> / /NOTES: /1. EDU200 IS GENERATED BY SPECIFYING NO MASS / STORAGE DEVICES. /2. UNDER EDU250 ONLY ONE MASS STORAGE DEVICE / CAN BE SELECTED. EDU250=TD8E!RK8E!RX8E IFNZRO EDU250^PDP8I <?>
/DEFINITIONS FIXMRI FJMP=0000 FIXMRI FADD=1000 FIXMRI FSUB=2000 FIXMRI FMPY=3000 FIXMRI FDIV=4000 FIXMRI FGET=5000 FIXMRI FPUT=6000 FEXT=0000 FNOR=7000 IFZERO PDP8I < CAF=6007 BSW=7002 SPL=6102 GTF=6004 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 IFNZRO TD8E < SDSS=6771 SDST=6772 SDSQ=6773 SDLC=6774 SDLD=6775 SDRC=6776 SDRD=6777> IFNZRO RK8E < DSKP=6741 DCLR=6742 DLAG=6743 DLCA=6744 DRST=6745 DLDC=6746 DMAN=6747> IFNZRO RX8E < RXCODE=750 LCD=6001!RXCODE XDR=6002!RXCODE STR=6003!RXCODE SER=6004!RXCODE SDN=6005!RXCODE INTR=6006!RXCODE INIT=6007!RXCODE>
/PAGE ZERO FIELD 0 PAGE 0 0 CIF 10 /INTERRUPT HANDLER JMP INTRPT LOOK, USER0 /POINTER TO STATUS OF USER BEING RUN OR LOOKED AT DBFKS2, BUFSP2-BUFIOT+SWPRBF /CNTRL-O & ECHO DBFTS2, BUFSP2-BUFIOT+BUFOP-BUFIOT+1+SWPRBF /COLUMN COUNT DBFTC, BUFC-BUFIOT+BUFOP-BUFIOT+1+SWPRBF /PRINTER BUFFER CHAR COUNT RUNTIM, -1 /- # OF STATEMENTS FOR CURRENT USER XREG, 0 /GENERAL XREG XREG2, 0 /GENERAL XREG *.+3 STSWAP=. PDLXR, TOP /PUSH-DOWN XREG AXIN, 0 /PACKING XREG TEXTP=. /TEXT POINTERS AXOUT, 0 /UNPACK XREG IFNZRO .-20 <?> /GTEM MUST BE FIRST AFTER INDEX REGISTERS 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, 0 /LINE NUMBER LASTLN, 0 /LAST LINE POINTER MODE=LASTLN SPACSW, 0 /0 IS IGNORE SPACES XFIELD, CDF 10 /USER FIELD DATAPC, 0 /LINE NUMBER OF DATA STATEMENT 0 /DATA POINTER 0 /DATA TEMPORARY 0 /DATA UNPACK SWITCH 0 /DATA CHARACTER PACKND, 0 /POINTER TO END OF PACKING BUFR, LINE1+ORG /NEXT FREE SPACE STARTV=BUFR /START OF VARIABLES LASTV, LINE1+ORG /LAST DEFINED VARIABLE PDLST, TOP /START OF PUSH-DOWN ALINE0, LINE0+ORG /POINTER TO DUMMY LINE COMBUF, BUFCOM+ORG /COMMAND BUFFER ERLINE, 0 /ERROR LINE FRNDX, 1 /3 WORD 203 /RANDOM INTEGER 5555 PREADC, XREADC /POINTER TO *READC* PPRNTC, XPRNTC /POINTER TO *PRINTC* IFNZRO EDU250 < DEV, 0 /BIT 0=CURRENT DRIVE NAME, FILENAME NONE.BA /USER'S CURRENT PROGRAM NAME > ENSWAP=.-1 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 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 C14, 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 /CHARACTER 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 IFNZRO EDU250 < DTQI, 15 /PRIORITY OF LAST USER IN DECTAPE QUEUE DTLOOK, 0 /POINTER TO STATUS WORD (USER0 THRU USER7) /OF WHOEVER CURRENTLY HAS THE TAPE /0=NOBODY >
/NEW INSTRUCTIONS FINT=JMS I . FPT PRINTC=JMS I PPRNTC /PRINT AC OR CHAR 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; CALLED BY CIF 10;PRINTX XOUT 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 PREADC /READ A CHAR TSTEND=JMS I . /TEST FOR END OF LINE ENDTST TSTLPR=JMS I . /SKIP IF L-PAREN LPRTST GETSGN=TAD I FLARGP
/MAINLINE BASIC (PRIORITY SCHEDULER) /WHENEVER THERE IS NOTHING BETTER TO DO /OR A JOB WANTS TO DISMISS ITSELF SO OTHERS CAN RUN, /THIS ROUTINE IS ENTERED. /IT SEARCHES THE LIST OF USER PRIORITIES FOR THE LOWEST /PRIORITY LESS THAN 10. (A PRIORITY > 10 INDICATES I/O WAIT.) /SERVICING IS ROUND ROBIN WITHIN PRIORITIES. ONCE SWAPPED IN, /THE NUMBER OF STATEMENTS THAT THE USER RUNS IS DETERMINED BY /HIS PRIORITY; THE LOWER THE PRIORITY, THE BIGGER A CHUNCK /HE GETS. WHEN A JOB EXITS FROM I/O WAIT, HIS PRIORITY IS /SET TO 0 (HIGHEST POSSIBLE). WHEN A JOB USES UP ITS STATEMENT /ALLOCATION WITHOUT GOING INTO I/O WAIT, ITS PRIORITY IS LOWERED. /IN THIS WAY, COMPUTE BOUND JOBS GET LARGER CHUNKS OF TIME /WHILE INTERACTIVE USERS STILL GET A QUICK RESPONSE. *177 NULL, DCA PC /STORE RESTART ADDRESS ION /INTERRUPT ON IN SCHEDULER!!! ISZ INTCNT /BUMP COUNT FOR *RANDOMIZE* /IN CASE THE ISZ SKIPS IFZERO USERS-1 <USRM2=0> IFZERO USERS-2 <USRM2=1> IFZERO USERS-3 <USRM2=3> IFZERO USERS-4 <USRM2=3> IFNDEF USRM2 <USRM2=7> USRM, USRM2 /MASK FOR LOOK; SET BY INITIALIZER DCA T1 /NO NEW JOB FOUND YET TAD LOOK DCA T3 NULL1, TAD CCR /MUST FIND JOB WITH LOWER PRIORITY THAN THIS BEGKIE, KIE /KIES FOR ALL USER TTYS JMP NULL5 /IN CASE STATIC ELECTRICITY HARDWARE BUG JMP NULL5 /TURNS IT OFF JMP NULL5 JMP NULL5 JMP NULL5 JMP NULL5 JMP NULL5 NULL5, DCA T2 TAD MUSRCT /THIS IS -USRM-1 DCA TM /COUNTER AROUND THE STATUSES NULL2, L0001 /POINT TO NEXT STATUS WITH T3 TAD T3 AND USRM /MODULO USRM+1 IFNZRO USER0&7 <?> /BITS 9-11 OF ADDR. OF USER0 MUST = 0 TAD (USER0 DCA T3 TAD T2 /COMPARE PRIORITIES STL CIA /13 BIT NUMBER TAD I T3 SNL CLA JMP NULL3 /CURRENT PRIORITY IS STILL HIGHEST TAD T3 /SAVE POINTER TO NEW HIGH DCA T1 TAD I T3 /THIS IS THE NEW THING TO BEAT DCA T2 NULL3, ISZ TM /HAVE WE LOOKED AT EVERYONE? JMP NULL2 /NO IFNZRO TD8E < SDSS /DECTAPE UP TO SPEED? JMP NULL4 /NO CIF CDF 10 /YES, AND IT GETS PRIORITY JMP I (DTTUTS /GO CHECK BLOCK NUMBER > NULL4, TAD T1 /GET POINTER TO NEXT GUY'S STATUS SNA JMP NULL1 /NO ONE IS RUNNABLE, KEEP LOOKING CIA TAD LOOK /LOOK IS STILL POINTER TO JOB THAT'S SWAPPED IN SNA CLA JMP DCKON4 /ALREADY SWAPPED IN IOF /CAN'T HANDLE CONTROL-C OR ERROR WHILE SWAPPING JMS DFIND /SET UP POINTERS TO SWAP OUT DCKON2, TAD I XREG /GET PAGE 0 SWAP REGION CDF 10 DCA I XREG2 /AND PUT IT IN FIELD 1 CDF 0 ISZ T2 /MOVED ALL WORDS? JMP DCKON2 /NO TAD T1 /YES: NOW THIS JOB WILL BE SWAPPED IN DCA LOOK /IT'S OFFICIAL WITH LOOK ENTRY, JMS DFIND /SET POINTERS FOR NEW JOB DCKON3, CDF 10 /GET DATA FROM FIELD 1 TAD I XREG2 CDF 0 DCA I XREG /AND DEPOSIT IN PAGE 0 FLD 0 SWAP REGION ISZ T2 JMP DCKON3 /KEEP SWAPPING TAD XFIELD /SET UP *UDF* DCA XUDF1 L0003 /SET UP DBFKS2 TAD XREG2 DCA DBFKS2 TAD (BUFOP-BUFIOT+1 /SET UP DBFTS2 TAD DBFKS2 DCA DBFTS2 L0003 /SET UP DBFTC TAD DBFTS2 DCA DBFTC ION /NOW THAT IT'S SAFELY IN, RISK CONTROL-C DCKON4, TAD I LOOK /COMPUTE HOW MANY STATEMENTS THIS JOB SHOULD EXECUTE CMA DCA RUNTIM JMP I PC /GO TO IT!!! DFIND, 0 /SET UP POINTERS FOR SWAPPING TAD (SWPR0-USER0 TAD LOOK DCA T2 TAD I T2 DCA XREG2 /POINT TO AREA IN FIELD 1 TAD (STSWAP-1 DCA XREG /POINT TO AREA IN FIELD 0 TAD (STSWAP-ENSWAP-1 DCA T2 /TRANSFER MINUS THIS MANY WORDS JMP I DFIND MUSRCT, -USRM2-1 /-USRM-1; SET BY INITIALIZER INTCNT, 0 /RANDOM NUMBER FOR RANDOMIZE /*UDF* PSUEDO-INSTRUCTION XUDF, 0 XUDF1, CDF 10 /BECOMES CDF TO USER'S DATA FIELD JMP I XUDF PAGE
/*ERROR* ROUTINE /HERE IS WHERE ERRORS ARE PROCESSED /IT IS CALLED DIRECTLY BY THE *ERROR* PSUEDOINSTRUCTION XERROR, 0 L0002 /BUILD POINTER TO USER KEYBOARD DATA TAD DBFKS2 DCA XREG CDF 10 DCA I DBFKS2 /RESET CNTRL-O, ECHO, BREAK-ON-ANY DCA I XREG /KEYBOARD BUFFER CHARACTER COUNT L7775 /REST 3-WAY SWITCHES DCA I XREG L7775 DCA I XREG DCA I XREG /START OF BUFFER DCA I XREG CDF 0 IFNZRO EDU250 < TAD DTLOOK /DOES THIS USER HAVE THE DECTAPE? CIA TAD LOOK SNA CLA JMS I (DTDQ /YES: GET RID OF IT > TAD XERROR CLL RAR /FORM ERROR CODE DCA CHAR /PROTECT IT FROM THE FREE13 FREE13 /DO A LITTLE OUTPUT, MAYBE SORTC /NOW FIGURE OUT WHICH ERROR NUMBER 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 I (READY1 /PRINT "<CR>STOP " OR "<CR>ERROR " TAD SORTCN /GET ERROR NUMBER SZA /DON'T PRINT ERROR NUMBER IF CONTROL-C JMS I (ITPRNT TAD ERLINE /WHAT LINE WERE WE IN? SPA SNA CLA JMP READY /NONE: IMMEDIATE MODE FREE13 /GET ROOM FOR "IN ####" TAD CLF JMS I (READY1 /PRINT "IN " TAD ERLINE JMS I (ITPRNT /PRINT LINE NUMBER
/*READY* ROUTINE /ROUTINE TO PRINT "READY" AND RESET POINTERS /ENTER THE ROUTINE AT START TO OMIT READY MESSAGE READY, CDF 10 L0001 /RESET CONTROL-O, BREAK-ON-ANY AND I DBFKS2 DCA I DBFKS2 FREE13 L0006 JMS I (READY1 /PRINT "<CR>READY<CR>" START, TAD PDLST DCA PDLXR /RESET PUSH-DOWN 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 L0004 /LEAVE ROOM FOR A DELETE COMMAND PACKC 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 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 ION JMP START PINPUTX, INPUTX PXDELET, XDELET 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 (FIX1 /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 IFNZRO MAGICN&7000 <?> MAGICN /THIS LOC MUST BE < 1000 BECAUSE IT /MUST BE A NOP! JMS FIX /NOW TRUNCATE JMP I INT /AND RETURN, FAC=INT(FAC0) /THIS IS ADDED TO NEGATIVE NUMBERS IN *INT* MAGICN, 0000 /-.9999999999999 4000 0001 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 L3777 /TURN OFF CONTROL-O CDF 10 AND I DBFKS2 DCA I DBFKS2 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, TAD (-15 TAD DATAPC+4 SZA CLA JMP ERR490 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 KWDATA 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, DCA MODE 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 (ALINE0 DCA PACKND JMP I INPACK OTPACK, 0 TAD COMBUF DCA AXOUT DCA XCT DCA SPACSW IFNZRO PDLXR-15 <?> /PDLXR IS ASSUMED TO BE AT LOC 15 TAD CCR /TAD (PDLXR DCA PACKND GETC JMP I OTPACK PAKLIN, JMS INPACK READC PACKC TSTCCR JMP .-3 PACKC /FINISH PACKING CR JMS OTPACK POPJ /*PRINTC* ROUTINE XPRNTC, 0 SNA /IF AC=0 THEN AC=CHAR TAD CHAR CIF 10 /BEST PART IS IN FIELD 1 JMP XPCF1 XPCF0, JMP I XPRNTC /FLD 1 RETURNS HERE; THIS EXITS *PRINTC* PAGE
IFNZRO EDU250 < /*OLD* COMMAND OLD, PUSHJ DTGNAM JMS DTQ /GRAB THE TAPE CIF CDF 10 JMP OLDF1 OLDF0, TAD (DTRC DCA PREADC /*READC* NOW READS DECTAPE UDF /*SCRATCH* USER'S PROGRAM DCA I ALINE0 /NO PROGRAM TEXT L0002 /SET END OF PROGRAM TEXT TAD ALINE0 DCA BUFR TAD STARTV /NO VARIABLES DCA LASTV JMP I (START /READ IN PROGRAM (OR BATCH STREAM??!!) /*SAVE* COMMAND ERRDOV, ERROR /DIRECTORY OVERFLOW DURING SAVE SAVE, PUSHJ /GET FILENAME DTGNAM JMS DTQ /GRAB THE DECTAPE TAD ALINE0 /ESTIMATE FINAL LENGTH OF FILE CIA TAD BUFR RAR BSW AND (37 IAC CIF CDF 10 JMP SAVEF1 ERRDSV, ERROR /FILENAME ALREADY EXISTS DURING SAVE SAVF0, DCA PPRNTC /DECTAPE *PRINTC* JMS I (GETLIM /ASSUMING CR IS NEXT PUSHJ /NOW *LIST* LIS2 TAD (232 /INSERT CONTROL/Z PRINTC CIF CDF 10 JMP I (SAV2F1 ERRDNR, ERROR /NO ROOM FOR OUTPUT FILE /*CAT* (CATALOGUE) COMMAND CATAL, PUSHJ /GET NEW FILE SPEC DTGNAM JMS DTQ /GET TAPE FREE13 L0001 /FIRST DIRECTORY SEGMENT CATGO, CIF CDF 10 JMP CATF1 CATF0, CIA /MAKE POSITIVE LENGTH JMS ITPRNT /PRINT DECIMAL FILE LENGTH TAD CCR /END LINE PRINTC FREE13 /FREE SPACE FOR NEXT LINE JMP CATGO /DO NEXT DIRECTORY ENTRY /DECTAPE *READC* DTRC, 0 CIF CDF 10 JMP DTRCF1 DTRCF0, DCA CHAR /SAVE CHARACTER TAD (-32 /CHECK FOR CONTROL/Z TAD CHAR SZA CLA JMP I DTRC /NOT CONTROL/Z /GET RID OF THE DECTAPE DTDONE, JMS I (DTDQ /GET RID OF THE DECTAPE JMP I (READY /DECTAPE *PRINTC* DTPC, 0 SNA TAD CHAR /USE CHAR IF AC=0 DTPCLF, CIF CDF 10 JMP DTPCF1 DTPCF0, SZA CLA /DID WE OUTPUT A CR? JMP I DTPC /NO, EXIT TAD CLF /YES, NOW OUTPUT A LINE FEED (FOR OS/8) JMP DTPCLF /GET THE DECTAPE DTQ, 0 TAD DTLOOK /FIND OUT WHO HAS TAPE NOW SZA CLA /DOES ANYONE? JMP DTQ1 /IN USE TAD CCR /ITS FREE, RESET "QUEUE" PRIORITY DCA DTQI TAD LOOK /GIVE TAPE TO THIS USER DCA DTLOOK JMP I DTQ /EXIT DTQ1, ISZ DTQI /NEXT LOWER PRIORITY TAD DTQI /GET PRIORITY DCA I LOOK /SET STATUS: NOT RUNNABLE WAITING FOR DECTAPE TAD DTQ /RESTART ADDRESS JMP NULL /DISMISS > /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 AXIN /SAVE NUMBER DCA XCTIN /SIGNIFICANT DIGITS TAD LSTADR DCA ADD /SUBTRACTION LIST POINTER TAD ITPRNT /IN CASE SAVE COMMAND DISMISSES PUSHA /REMEMBER RETURN ADDRESS PRNT1, DCA T1 /SET DIGIT TO 0 PRNT2, TAD AXIN /GET NUMBER TAD I ADD /SUBTRACT POWER OF TEN SPA /DID IT FIT? JMP PRNT3 /NO, FOUND THIS DIGIT DCA AXIN /SAVE NEW NUMBER ISZ T1 /BUMP DIGIT JMP PRNT2 /STILL DOING THIS DIGIT PRNT3, CLA TAD XCTIN /GET SIGNIFIGANCE TESTER TAD T1 /AND DIGIT SNA CLA /BOTH ZERO? JMP PRNT4 /YES: DO NOT PRINT THIS DIGIT TAD T1 /GET DIGIT TAD (60 /CONVERT TO ASCII PRINTC /AND PRINT IT ISZ XCTIN /ALL FURTHER DIGITS ARE SIGNIFICANT PRNT4, ISZ ADD /NEXT POWER OF TEN TAD I ADD /MORE DIGITS? SPA CLA /LIST IS TERMINATED BY POSITIVE # JMP PRNT1 /YES POPJ /EXIT DECIMAL ITPLST, -1000 -100 -10 -1 OCTAL IFNZRO ITPLST&4000 <?> /ITPLST IS TERMINATED BY A POSITIVE NUMBER LSTADR, ITPLST PAGE
/*IF* COMMAND IF, DCA MODE PUSHJ /GET FIRST EXPRESSION EVAL COMMAN /CHECK RELATIONAL OPERATOR KWRELS TAD (IFSKPL /GET ASSOCIATED SKIP INST DCA T1 TAD I T1 SMA /WAS THERE A SKIP? ERR390, ERROR /NO: ILLEGAL RELATIONAL OPS DCA IFSKP /PUT SKIP IN POSITION PUSHF /SAVE FIRST VALUE LACX, ACX PUSHJ /EVALUATE SECOND VALUE EVAL COMMAN /CHECK THE "THEN" KWTHEN SZA CLA ERR400, ERROR /"THEN" MISSING POPF /GET FIRST ARG BACK FLARG ISZ MODE /STRING OR NUMERIC COMPARE? JMP IFNUM /NUMERIC L7775 /COMPARE MAX 3 WORDS DCA MODE TAD LACX /POINT TO SECOND ARG DCA T1 TAD FLARGP /POINT TO FIRST ARG DCA T2 IFS, L0001 /THE FOLLOWING GARBAGE DOES TAD I T1 /COMPARES OF CHARACTER STRINGS. DCA T3 /IT MUST RECOGNIZE THAT A TAD T3 /CARRIAGE RETURN GOES BEFORE AND C77 /ANY OTHER CHARACTER. SZA ISZ T1 SNA CLA TAD (100 TAD T3 DCA T3 L0001 TAD I T2 DCA CNTR TAD CNTR AND C77 SZA ISZ T2 SNA CLA TAD (100 TAD CNTR STL CIA TAD T3 SZA JMP IFSKP /A DIFFERENCE! COMPARE DONE ISZ MODE /DONE 3 WORDS? JMP IFS /NO, KEEP COMPARING IFSKP, HLT /COMPARE THE ARGS TESTN /CONDITION TRUE JMP REM /CONDITION FALSE JMP I (IFTRUE /EXECUTE STATEMENT AFTER "THEN" JMP I (GOTO /USE LINE NUMBER AFTER "THEN" REM, GETNXT /GET NEXT PROGRAM LINE JMP I (READY /OUT OF TEXT JMP I (RUN4 /EXECUTE LINE IFNUM, JMS I (FFSUB /COMPARE NUMERIC ARGS FLARG TAD ACH /GET HIGH ORDER DIFFERENCE CLL RAL /MAKE COMPATABLE WITH STRING MODE SNA /IF MAGNITUDE BITS = 0 TAD ACLO /THEN LOOK AT LOW ORDER TOO JMP IFSKP /NOW DO COMMON TEST
/*FREE2* ROUTINE XFREE2, 0 TAD (-54 /56(8) CHARACTERS IS A FULL BUFFER XFREET, CDF 10 TAD I DBFTC /ADD CHARACTER COUNT CDF 0 SPA CLA /ENOUGH FREE SPACES? JMP I XFREE2 L2000 /SET OUTPUT WAIT DCA I LOOK TAD XFREE2 /RESTART ADDRESS JMP NULL /GO AWAY, CONFIDANT WE WILL COME BACK /*FREE13* ROUTINE XFREE3, 0 TAD XFREE3 C3XXX, DCA XFREE2 TAD (-41 JMP XFREET IFNZRO TD8E < /SPECIAL CODE FOR DTTCON DTT3, TAD C3XXX /AC=3000, BITS 4-11 ARE IRRELEVANT TAD DEV /SELECT PROPER DRIVE SDLC /START UP, IN REVERSE CLA IAC BSW DCA I DTLOOK TAD (DTT6 JMP NULL DTT4, DCA I DTLOOK ION DTT5, JMP I (NULL4 DTT6, CIF CDF 10 JMP DTTDON > IFNZRO RX8E < RXF0DW, 0 /SUBR TO DISMISS UNTIL DONE FLAG COMES UP CLA IAC BSW /AC=100 DCA I DTLOOK /PUT JOB WITH RX8E IN I/O WAIT TAD (RXF0RN /START UP LATER AT RXF0RN JMP NULL /RUN SOMEONE ELSE RXF0RN, CIF CDF 10 /DONE FLAG WAS UP JMP I RXF0DW /RETURN (TO FIELD 1 SERVICE) > IFNZRO EDU250 < ERRDT, ERROR /READ/WRITE ERROR /*UNSAVE* COMMAND UNSAVE, PUSHJ DTGNAM JMS I (DTQ /GRAB THE DECTAPE CIF CDF 10 JMP UNSF1 > 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 /CHECK "TO" KWTO SZA CLA JMP ERR430 /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 KWNEXT 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 /CHECK "STEP" KWSTEP SZA CLA 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 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 ORDER CLL CMA IAC /NEGATE IT DCA ACH /STORE BACK JMP I FFNEG / /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,XDEL2, L7777 TAD LINEPC DCA XREG 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 XREG /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 TAD LASTV CLL CIA TAD PDLXR SNL CLA /IS PDLXR>=LASTV? JMP I (ERR100-2 /NO: NO ROOM IN PDL JMP I PCHK /YES: OK, IT'S SET UP, EXIT /*PUSHF* ROUTINE XPUSHF, 0 L7777 TAD I XPUSHF DCA XREG /POINT TO DATA L7775 JMS PCHK /BACK 3 L7775 DCA T3 TAD I XREG UDF DCA I PDLXR /PUSH DATA CDF ISZ T3 JMP .-5 L7775 JMS PCHK /BACK 3 AGAIN ISZ XPUSHF JMP I XPUSHF /*COMMAN* ROUTINE /TRANSFER TO XCOM IN FIELD 1 F0CMAN, 0 TAD I F0CMAN ISZ F0CMAN CIF 10 JMP I (XCOM F0CMN1, JMP I F0CMAN /EXIT /THIS CALLS *GETC* FROM FIELD 1 FOR XCOM F0GETC, GETC CIF CDF 10 JMP I (XCOMF1 /*RANDOMIZE* STATEMENT RANDOM, TAD FRNDX+1 TAD I (INTCNT /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 XREG /POINTER TO ARGUMENT TAD M6 DCA MODE /MULTIPURPOSE COUNTER LEN1, CLL IAC TAD C77 /L & AC = 00100 TAD I XREG 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 TSTCCR JMP ERR001 FINDLN ERR001, ERROR ISZ SPACSW JMS I (INPACK EDTBEL, L0003 CDF 10 DCA I DBFKS2 READC CDF 10 DCA I DBFKS2 TAD CHAR CIA EDTLF, DCA PT1 EDTFF, FREE2 GETC PRINTC TAD PT1 TAD CHAR SNA CLA JMP EDT2 EDTCR, PACKC TSTCCR JMP EDTFF PACKC JMS I (OTPACK JMP I (SRETN EDT2, PACKC READC SORTJ EDITL-1 EDITL2-EDITL JMP EDT2 /*LIST* COMMAND LIST, JMS GETLIM TAD (-110 DCA PACKND PUSHJ LIS2 JMP I CREADY LIS2, ISZ SPACSW FREE2 TAD CCR PRINTC LIS3, JMS GETLIN POPJ /OUT OF TEXT TAD PACKND CDF 10 DCA I DBFTS2 /SET TTY COLUMN COUNT FREE13 TAD LINENO JMS I (ITPRNT TAD C40 PRINTC LIS4, GETC FREE2 PRINTC TSTCCR JMP LIS4 JMP LIS3 /*PUNCH* COMMAND PUNCH, JMS GETLIM PUSHJ PUNCH2 PUSHJ /PUNCH2 SET PACKND UP LIS2 PUSHJ PUNCH2 JMP I (START /DON'T PRINT "READY" PUNCH2, TAD M100 DCA PACKND PUNCH3, FREE2 CIF 10 PRINTX ISZ PACKND JMP PUNCH3 POPJ /*DELETE* COMMAND DELETE, JMS GETLIM /GET LYMITS TAD BUFR DCA AXIN JMS GETLIN /GET A LINE JMP I CREADY /ALL DONE JMS I (XDELET /DELETE IT TAD LASTLN /REARRANGE POINTERS DCA LINEPC JMP .-5 /DO NEXT LINE GETLIM, 0 /GET LINE NUMBER LIMITS L7777 DCA PT1 DCA LINENO TSTEND JMP GLM2 GLMFND, FINDLN /FIND THE FIRST LINE IFNZRO READY&7000 <?> /MUST BE EFFECTIVE NOP CREADY, READY TAD LASTLN /POINT TO LINE BEFORE DCA LINEPC JMP I GETLIM GLM2, GETLN TAD LINENO DCA PT1 TSTCOM JMP GLM3 GETC JMS I (GETNUM /GET NUMBER IN OPX, NOT LINENO TAD OPX DCA PT1 GLM3, TSTEND JMP ERR001 JMP GLMFND GETLIN, 0 /GET NEXT LINE WITHIN LIMITS GETNXT JMP I GETLIN /NO NEXT LINE TAD PT1 /BIGGEST LINE NUMBER STL CIA TAD LINENO /CURRENT LINE NUMBER SZL SNA CLA ISZ GETLIN /SKIP RETURN: ANOTHER LINE AVAILABLE JMP I GETLIN PAGE
/*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
/*RUN* COMMAND RUN, TAD STARTV DCA LASTV /RESET VARIABLES PUSHF /INITIALIZE RANDOM NUMBER FRNDX0 POPF FRNDX RUN1, FIND /FIND A NEXT TO UNINITIALIZE KWNEXT 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 IFTRUE, COMMAN /GET KEYWORD CODE KWST /START OF MAIN KEYWORD LIST TAD (COMGO2 /CALCULATE ADDRESS OF ADISPATCH 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 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 /RUNTIME SCHEDULER ISZ RUNTIM /HAS JOB USED UP QUOTA OF STATEMENTS? JMP I RUN9 /NO, RETURN INSTANTLY L0001 /YES: LOWER PRIORITY ON THIS JOB TAD I LOOK AND C7 /MODULO 7 SNA /IF OLD PRIORITY WAS 7, L0003 /THEN MAKE NEW PRIORITY 3. DCA I LOOK TAD RUN9 /RESTART ADDRESS 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 KWCOM /THIS LIST INCLUDES COMMANDS AND STATEMENTS TAD (COMGOL JMP RUN5 /GO DO IT 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 PFUPAR /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 PFUPAR, FUPARR /POINTER TO FUPARR
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 TAD SUBS PUSHA TAD LINEPC PUSHA SKP FUNC11, TAD SORTCN FIND /FIND A "DEF FN" KWDEF ERR170, ERROR /FUNCTION NOT FOUND DCA SORTCN TAD FUNC17 TAD CHAR SZA CLA JMP FUNC11 /NOT PROPER FUNCTION 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 COMMAN /CHECK "TAB", "CHR$" KWTAB SZA /TAB? JMP PRINT2 /NO: GO CHECK OTHER POSSIBILITIES JMS PRINT8 /EVALUATE ARGUMENT SPA /NEGATIVE ARGS ARE DETRIMENTAL CIA 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 JMS I (ZONE /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 CIF 10 PRINTX /PRINT CR WITH NO LINE FEED CIF 10 PRINTX /PRINT NULL TO GIVE CARRIAGE TIME TO MOVE TAD (-110 /-72 DECIMAL CDF 10 DCA I DBFTS2 /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, RAR /CHR$? SNL CLA JMP PRINT3 /NO: MUST BE EXPRESSION JMS PRINT8 /EVALUATE ARG TO CHR$ CIF 10 PRINTX /SNEAK IN THE CHARACTER 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, JMS I (ZONE /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 JMP PRIN12 PRINF0, ION SNA CLA JMP PRINT5 /YES, NOW PROCEED AS IF SEMICOLON PRINT4, FREE2 TAD C40 CIF CDF 10 JMP I (PRINF1 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
/*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 XREG TAD LINENO CIA TAD I XREG 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 ZONE, 0 /KLUDGE FOR *PRINT* TO LOOK AT TTY COLUMN CDF 10 TAD I DBFTS2 /GET COLUMN COUNT CDF 0 JMP I ZONE ERR330, ERROR /TOO MANY *RETURN*S IFNZRO EDU250 < /ROUTINE TO DEASSIGN THE DECTAPE FROM THE CURRENT USER DTDQ, 0 IFNZRO TD8E <SDLC> /STOP DECTAPE FOR ERRORS TAD (XREADC /READ FROM KEYBOARD DCA PREADC TAD (XPRNTC /AND PRINT ON PRINTER DCA PPRNTC L7777 DCA T1 /LOWEST PRIORITY FOUND YET TAD (USER0 /START OF LIST DCA T2 DCA T3 TAD (-10 DCA XREG /STATUS COUNTER DTDQ1, TAD I T2 /IGNORE JOBS RUNNING OR IN I/O WAIT AND (70 SZA CLA TAD T1 STL CIA TAD I T2 /USER'S STATUS SNL CLA JMP DTDQ2 /NOT NEXT TAD T2 /THIS JOB MIGHT GET TAPE DCA T3 TAD I T2 DCA T1 /SEE IF ANYONE IS BEFORE HIM DTDQ2, ISZ T2 /NEXT USER'S STATUS ISZ XREG JMP DTDQ1 /MORE USERS TAD T3 /THIS JOB GETS TAPE NEXT(=0 IF NONE) DCA DTLOOK /THIS MAKES ASSIGNMENT DCA I DTLOOK /THIS RUNS HIM JMP I DTDQ /GET FILE SPECIFICATION FOR DECTAPE COMMANDS. /THIS ROUTINE IS A PAIN BECAUSE THE NAME MUST BE IN /STRAIGHT SIXBIT CODE FOR OS/8 COMPATIBILITY DTGNAM, COMMAN /GET DRIVE SPEC KWDEV IFNZRO TD8E < CLL RTR SNL DCA DEV> IFNZRO RK8E < TAD (-10 SNA JMP DTG1 AND C7 DCA DEV> IFNZRO RX8E < CLL RTR SZL JMP DTG1 CLL RAR BSW DCA DEV> DTG1, TSTCCR SKP POPJ /EXIT TAD (NAME-1 /NAME GOES TO NAME, OF COURSE DCA XREG2 JMS DTG2 /GET 2 CHARACTERS OF FILENAME JMS DTG2 JMS DTG2 TESTN /EXTENSION SPECIFIED? JMP DTGEXT /YES DTGCR, TSTCCR /FOLLOWED BY CR? ERRDTG, ERROR /NO, BUT IT SHOULD HAVE BEEN POPJ /DONE, SUCCESSFUL DTGEXT, GETC /SKIP OVER THE "." JMS DTG2 /GET 2 CHAR EXTENSION JMP DTGCR /CHECK CR DTG2, 0 /GET 2 CHARS OF FILENAME SORTC /CHECK . CR DTGL-1 JMP DTG4 /WAS TERMINATOR TAD CHAR /CONVERT CHAR TO STRAIGHT SIXBIT AND C77 BSW /LEFT BYTE DCA T1 GETC SORTC DTGL-1 JMP DTG3 TAD CHAR /REMEMBER CHARACTER DCA T2 GETC /NEXT CHARACTER TAD T2 /LAST CHARACTER AND C77 /CONVERT TO SIXBIT DTG3, TAD T1 /SIXBIT CHAR BEFORE LAST DTG4, DCA I XREG2 /STORE AWAY JMP I DTG2 /WE HAVE STORED 2, 1, OR 0 CHARS > PAGE
USER0, 0 USER1, 7777 USER2, 7777 USER3, 7777 USER4, 7777 USER5, 7777 USER6, 7777 USER7, 7777 /LOOKUP TABLE FOR DFIND /ENTRIES POINT TO FIELD 1 SWAP REGION FOR USER. SWPR0, SWPR-1 SWPR1, SWPRL+SWPR-1 SWPR2, SWPRL^2+SWPR-1 SWPR3, SWPRL^3+SWPR-1 SWPR4, SWPRL^4+SWPR-1 SWPR5, SWPRL^5+SWPR-1 SWPR6, SWPRL^6+SWPR-1 SWPR7, SWPRL^7+SWPR-1 /*PACKC* ROUTINE XPACKC, 0 TAD AXIN /IF AXIN+9>=PACKND THEN ERROR CLL CIA TAD M12 TAD I PACKND SZL CLA ERR060, ERROR /NO ROOM JMS XCPACK 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 SPA /VALID CHARACTER FOR PACKING? JMP XPAC10 /NO: TWO BELLS 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 COMBUF 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, TAD XPACKC /SAVE RETURN ADDRESS PUSHA PUSHF /SAVE TEXT POINTERS TEXTP FREE13 /PRINT "$ DELETED<CR>" TAD (17 JMS READY1 TAD COMBUF /PACKING WILL RESUME AT START OF COMMAND BUFFER DCA AXIN DCA XCTIN POPF /RESTORE TEXT POINTERS TEXTP DCA CHAR /BUT CLEAR CHAR FOR GOOD LUCK POPJ /EXIT FROM XPACKC XPAC10, CLA /OUTPUT TWO BELLS FOR ILLEGAL CHARACTER TAD C7 PRINTC TAD C7 PRINTC JMP I XCPACK /EXIT INNER ROUTINE /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
/*READC* ROUTINE XREADC, 0 L7776 /COMPUTE ADDRESS OF KEYBOARD DATA TAD DBFKS2 CIF CDF 10 JMP I (XRCF1 /READ KEYBOARD BUFFER FROM FLD 1 /*READC* RETURNS HERE FROM FIELD 1 XRCF0, SPA /VALID CHARACTER RETURNED? JMP XRCDIS /NO DCA CHAR /YES: SAVE IT JMP I XREADC XRCDIS, DCA I LOOK /AC0=1, USE IT TO SET INPUT WAIT L7777 /COMPUTE RESTART ADDRESS TAD XREADC JMP NULL /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
PAGE /*POPF* ROUTINE XPOPF, 0 L7777 TAD I XPOPF DCA XREG /POINT TO DATA AREA L7775 DCA T3 UDF TAD I PDLXR CDF DCA I XREG /MOVE DATA ISZ T3 JMP .-5 ISZ XPOPF JMP I XPOPF
/*TESTN* ROUTINE /CALLING SEQUENCE: /CLA /TESTN / /RETURNS HERE IF CHAR = "." / /CHAR IS NOT A DIGIT / /CHAR IS A DIGIT, SORTCN=BINARY VALUE XTESTN, 0 TAD CHAR TAD (-".+200 SNA JMP I XTESTN TAD (-"9-1+". CLL TAD CLF DCA SORTCN SZL ISZ XTESTN ISZ XTESTN 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 XGET5, L0006 /CR XGET4, TAD C7 /BELL XGET6, DCA CHAR JMP I XGETC /CONTINUATION OF RANDOM NUMBER GENERATOR RND1, RAL TAD FRNDX 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 TAD I XFIND ISZ XFIND DCA XFIND2 FINDLN JMP I XFIND /NOT FOUND XFIND1, JMS I (GETMOR JMP I XFIND /NOT FOUND GETC COMMAN XFIND2, KWNEXT SZA CLA JMP XFIND1 TAD LINENO ISZ XFIND JMP I XFIND GETMOR, 0 SKP GETC TSTEND JMP .-2 /GO TO TERMINATOR TAD CHAR TAD (-72 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
/*RETURN* AND *POPJ* RETURN, TSTEND ERR320, ERROR XPOPJ, DCA XREG /SAVE AC UDF TAD I PDLXR CDF DCA T3 /RETURN ADDRESS TAD XREG /GET AC JMP I T3
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 (-"!+": /TEST FOR ! COMMENT 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
/*BYE* COMMAND /WIPES OUT USER'S PROGRAM NAME, REPLACING IT WITH NONE.BA, /OR ACCEPTS ALTERNATE NAME AS AN ARG, THEN WIPES OUT PROGRAM /AND VARIABLES. BYE, IFNZRO EDU250 < PUSHF /GET NEW NAME DTNONE POPF NAME TAD DTNONE+3 DCA NAME+3> /*NEW* COMMAND /GETS NEW PROGRAM NAME (OPTIONALLY), THEN WIPES OUT PROGRAM /AND VARIABLES. NEW, IFNZRO EDU250 < PUSHJ /GET PROGRAM NAME DTGNAM> /*SCR??????????* COMMAND /WIPES OUT PROGRAM AND VARIABLES SCR, UDF DCA I ALINE0 /LINK TO NOTHING CDF 0 L0002 TAD ALINE0 DCA BUFR /END OF TEXT /*END* STATEMENT /WIPES OUT VARIABLE AND RETURNS TO "READY" STATE END, TAD STARTV DCA LASTV JMP I (READY IFNZRO EDU250 < DTNONE, FILENAME NONE.BA /NULL PROGRAM NAME >
/*ON* COMMAND ON, PUSHJ /GET VALUE EVAL COMMAN /CHECK "GOTO" KWGOTO SZA CLA ERR300, ERROR /NOT GOTO JMS I INTEGE CIA DCA T1 TAD LINENO /REMEMBER WHERE WE ARE DCA T2 ONLP, GETLN /READ LINE NUMBER ISZ T1 /SHOULD WE JUMP TO IT? SKP /NO JMP I CJUMP /YES TSTCOM /MORE LINE NUMBERS? JMP ONDON /NO GETC /YES: SKIP OVER "," JMP ONLP ONDON, TSTEND JMP ERR300 /BAD SYNTAX TAD T2 /RESTORE OLD LINE NUMBER DCA LINENO JMP I CCONT /DO NEXT STATEMENT
/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 /CHECK "NEXT" KWNEXT 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 XREG /SET TO LIST ISZ XSORTJ CDF 10 TAD I XREG SPA JMP XSORT1 /END OF LIST TAD T3 SZA CLA JMP .-5 /NO GO - LOOP TAD XREG 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 .+6 ENDFUN, JMS I LITS POPA DCA MODE JMS I LITS+1 FLARG TAD ERLINE DCA LINENO 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 OPTABL, FGET I PT1 FADD I PT1 FSUB I PT1 FMPY I PT1 FDIV I PT1 PFUPAR&177+600 /FJMP I PFUPAR
/*ECHO* AND *NO ECHO* STATEMENTS NOECHO, L0001 ECHO, DCA T1 /AC11=NEW ECHO BIT TSTEND ERR003, ERROR /CONTINUED PAST RECOGNIZED END POINT L7776 CDF 10 AND I DBFKS2 /ZERO ECHO BIT TAD T1 /REPLACE ECHO BIT DCA I DBFKS2 /REPLACE WORD CDF 0 JMP I CCONT
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 XREG L7777 TAD I XFLGET DCA XREG2 L7775 DCA T3 UDF TAD I XREG /MOVE FLOATING DATUM DOWN CDF DCA I XREG2 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 FLPUT FLZERO-1 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 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 FSUB1, ISZ FFADD /BUMP RETURN TAD OPH /IS OPERAND = 0 SNA CLA JMP I FFADD /YES-DONE TAD ACH /NO-IS FAC=0? SNA CLA JMP FAD1 /YES-DO ADD FIX1, 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 FAD1, 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 DCA AC0 /-SHIFT COUNT OPSR1, TAD OPH /IF OPERAND IS NEGATIVE, SMA JMP OPSR2 CLA RAL /THEN ADD 1 BEFORE SHIFTING RIGHT TAD OPL /LINK WAS OV BIT; ITS CARRY IS ITSELF DCA OPL RAL /PROPAGATE POSSIBLE CARRY TAD OPH /ADD HIGH ORDER SKP /LINK IS COMPLEMENT OF SIGN BIT OPSR2, STL /PROPAGATE 0 SIGN BIT FOR POSITIVE NUMBERS CML RAR /SHIFT RIGHT, PROPAGATING SIGN DCA OPH /STORE HIGH ORDER TAD OPL /GET LOW ORDER RAR /SHIFT RIGHT (LINK IS NOW OVERFLOW BIT) DCA OPL ISZ OPX /INCREMENT EXPONENT NOP /ISZ MAY SKIP ISZ AC0 /SHIFTED ENOUGH? JMP OPSR1 /NO RAR /SAVE OVERFLOW BIT DCA AC2 JMP I OPSR /EXIT
/ /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 /THIS ROUTINE IS VERY SIMILAR TO OPSR CLL CMA DCA AC0 ACSR1, TAD ACH SMA JMP ACSR2 CLA RAL TAD ACLO DCA ACLO RAL TAD ACH SKP ACSR2, STL CML RAR DCA ACH TAD ACLO RAR DCA ACLO ISZ AC0 JMP ACSR1 RAR DCA AC1 JMP I ACSR / /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 FSUB1 ARGETP, ARGET POPNEG, OPNEG
/ /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. / *.&7600+166 /SO PAGE BOUNDARY FALLS IN THE RIGHT PLACE 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 FFNOR2, CLA STL RTR /L&AC=02000 TAD ACH SPA JMP FFNOR3 /DONE, BINARY FAC IS 01???... OR 10???... CLL RTL /IGNORE BITS 0&1 SNA TAD ACLO /IF 0, LOOK AT ACLO SNA TAD AC1 /IF STILL 0, LOOK AT OVERFLOW BIT SNA CLA /IF FAC BITS 2-23=0, JMP FFNOR3 /THEN DONE L7777 /SUBTRACT 1 FROM EXPONENT TAD ACX DCA ACX JMS I (AL1 /SHIFT FAC LEFT JMP FFNOR2 FFNOR3, SZL CLA DCA ACX /IF FAC=0, THEN ZERO EXPONENT DCA AC1 /ZERO OVERFLOW BIT JMP I FFNOR / /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 (FAD1 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
PAGE ENPUNCH FIELD 1 *7400 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 XREG L7777 TAD I XFLPUT DCA XREG2 L7775 DCA T3 TAD I XREG2 UDF DCA I XREG CDF ISZ T3 JMP .-5 ISZ XFLPUT JMP I XFLPUT /*SORTC* ROUTINE XSORTC, 0 SNA TAD CHAR CIA DCA T3 TAD I XSORTC DCA XREG CDF 10 TAD I XREG CDF SPA JMP XSORT3 TAD T3 SZA CLA JMP .-7 TAD I XSORTC CMA TAD XREG DCA SORTCN SKP XSORT3, ISZ XSORTC ISZ XSORTC CLL CLA JMP I XSORTC
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 SYS ABS=NHNDLE IFSKPL, SNL CLA SZL SNA CLA SZA CLA /IFSKPL MUST BE FOLLOWED BY POSITIVE # SNL SZA CLA SZL CLA SNA CLA FRNDX0, 0 /EXPONENT OF RANDOM NUMBER 203 /2 WORD RANDOM INTEGER 5555 ERR004, ERROR /CONTROL-C /*FLARG* (FLOATING POINT ARGUMENT TO MANY THINGS) FLARG, 0 0 0 ERR070, ERROR /KEYBOARD BUFFER OVERFLOW ERR080, ERROR /PRINTER BUFFER OVERFLOW /*SYS* FUNCTION /WITH THIS FUNCTION, SYSTEM PROGRAMS SUCH AS SYSTAT /CAN BE WRITTEN IN EDU250 BASIC!!! SYS, 0 TAD ACH /GET DATA FIELD (ASSUMED POSITIONED!) AND SYSC70 /WITHOUT THIS, MISUSE COULD CRASH SYSTEM TAD SYSK /CONVER TO CDF DCA SYSCDF SYSCDF, HLT /CDF TO FIELD TO EXAMINE TAD I ACLO /GET WORD SYSK, CDF 0 DCA ACLO /CONVERT TO FLOATING POINT NUMBER DCA ACH JMS I SYSL /EVEN NORMALIZE, WHAT SERVICE! JMP I SYS /ALL DONE SYSL, FFNOR /POINTER TO NORMALIZE SYSC70, 70 IFNZRO CONFIG <NOPUNCH>
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 /@ XR1, 0 /TEMP INDEX REGISTERS XR2, 0 0444 /$D 4554 /EL 4564 /ET 4544 /ED 7740 /CR,@ CONEND=. SAVAC, 0 /SAVED AC DURING INTERRUPTS SAVF, 0 /SAVED FLAGS DURING INTERRUPTS SAVRES, 0 /SAVED RESTART ADDRESS DURING INTERRUPTS INTUSR, 0 /USER COUNTER DURING INTERRUPTS INTTM, 0 /3 TEMPS USED DURING INTERRUPTS INTTM1, 0 INTTM2, 0 MUSERS, -USERS /MINUS NUMBER OF USERS USRPT, USER0+USERS MUSRPT, -USER0-USERS IOTST, SWPRBF /POINTER TO FIRST IOT INTRPT=[DCA SAVAC /INTERRUPTS GO TO INTRPT AND FALL /THROUGH TO PAGE 1 IFNZRO INTRPT-177 <?> /INTRPT MUST BE AT 10177 IFZERO PDP8I < INTPWF, JMP I [INTPFR /DISPATCH TO POWER FAIL RECOVERY ROUTINE > /POINTERS TO USER BUFFERS & RELEVANT DATA BUFIOT, SWPRBF /USER TTY SKIP IOT BUFSP, SWPRBF+1 /KEYBOARD: NOT USED /PRINTER: 0=FREE, 7777=BUSY BUFSP2, SWPRBF+2 /KEYBOARD:BIT 0=CNTRL-O (1=SUPPRESS OUTPUT) /BIT 10=BREAK ON ANY (1=BREAK) /BIT 11=ECHO (1=NO ECHO) /PRINTER: TTY COLUMN COUNT BUFM, SWPRBF+3 /BUFFER COUNTER MASK BUFB, SWPRBF+4 /BUFFER BASE ADDRESS BUFC, SWPRBF+5 /# OF CHARACTERS IN BUFFER BUFIS, SWPRBF+6 /IN TO BUFFER 3-WAY SWITCH BUFOS, SWPRBF+7 /OUT OF BUFFER 3-WAY SWITCH BUFIP, SWPRBF+10 /IN TO BUFFER POINTER BUFOP, SWPRBF+11 /OUT OF BUFFER POINTER IFNZRO EDU250 < DTDCTC, 0 /INHIBIT ERRORS DURING DIRECTORY EXTENSION DTDCTD, DTDONE /USED WITH DTDCTC DTENTS, 0 /- # OF ENTRIES IN CURRENT SEGMENT DTSBN, 0 /STARTING BLOCK # OF CURRENT ENTRY DTBSBN, 0 /SBN OF NEW ENTRY (*SAVE* COMMAND) DTIBL, 0 /IDEAL BLOCK LENGTH FOR SAVE DTCEPT, 0 /CURRENT ENTRY POINTER DTLEPT, 0 /LAST ENTRY POINTER DTNEPT, 0 /NEXT ENTRY (END OF CURRENT ENTRY) POINTER DTBLK, 0 /CURRENT OS/8 BLOCK TM1, 0 /TEMPS TM2, 0 > PAGE
IFZERO PDP8I < PDP8I1, GTF /GET LINK, SAVE FIELD REG DCA SAVF /SAVE FLAGS TAD I [0 /SAVE RESTART LOCATION DCA SAVRES SPL /POWER FAIL INTERRUPT? JMP INTST /NO, SCAN TTYS DCA I [0 /YES, SET UP RESTART SEQUENCE TAD [JMP INTPWF DCA I [2 /FIELD 0;*0;AND 0;CIF 10;JMP INTPWF HLT /NOW JUST STOP AND WAIT FOR THE END > IFNZRO PDP8I < RAR DCA SAVF TAD I [0 DCA SAVRES > INTST, IFNZRO RX8E < SDN /FLOPPY DISK DONE FLAG UP? JMP RXNOIN /NOPE CDF 0 /SET UP TO RUN JOB WITH RX8E TAD I [DTLOOK DCA INTTM DCA I INTTM JMP INTDON /EXIT INTERRUPT SERVICE RXNOIN, > /MAIN TTY INTERRUPT HANDLER /SCANS ALL TTYS FOR INTERRUPTS, EXITS WHEN ONE HAS BEEN /HANDLED. ON AN UNDEFINED INTERRUPT, EXECUTES LIST OF /CLEAR IOTS AND EXITS. CDF 10 /WORK IN FIELD 1 NOW TAD MUSERS /- # OF USERS DCA INTUSR /USER COUNTER TAD IOTST /BEGINNING OF IOT LIST JMP INTST2 INTKEY, TAD [ENSWAP-STSWAP+BUFOP-BUFIOT+2 TAD BUFIOT INTST2, DCA BUFIOT /POINT TO NEXT USER'S KEYBOARD DATA TAD I BUFIOT /GET USER'S KSF IOT DCA INTKSF INTKSF, HLT /KEYBOARD INTERRUPT? JMP INTTTY /NO: CHECK TTY TAD [KRB-KSF /CONVERT KSF TO KRB TAD INTKSF DCA INTKRB INTKRB, HLT /READ KEYBOARD AND [177 /IGNORE PARITY BIT SNA JMP INTDON /IGNORE NULL DCA INTTM /SAVE CHAR JMS I [BUFSWP /SET UP REST OF POINTERS L7775 /CHECK FOR CONTROL-C TAD INTTM SNA JMP INTCTC /PROCESS CONTROL-C TAD [-"O+300+3 /CHECK FOR CONTROL-O SNA CLA JMP INTCTO /PROCESS CONTROL-O JMS I [BUFI /PUT CHARACTER IN KEYBOARD BUFFER JMP INTIOV /NO ROOM: KEYBOARD BUFFER OVERFLOW TAD [-"^+200-1 /SEE IF NON-BREAK CHARACTER TAD INTTM CLL TAD [-" +"^+1 SNL CLA JMP INTBRK /WIERD CHARACTER, BREAK! L0002 /CHECK BREAK ON ANY BIT AND I BUFSP2 SZA CLA JMP INTBRK /WAS SET, BREAK! TAD [-36 /BUFFER WITHIN 20(10) CHARS OF FULL? TAD I BUFC SZA CLA JMP INTECO /NO, DON'T BREAK INTBRK, JMS I [INTPRI /RESET INPUT WAIT 4000 /BIT 0 IS INPUT WAIT CDF 10 INTECO, L0001 /CHECK ECHO BIT AND I BUFSP2 SZA CLA JMP INTDON /WAS SET, DON'T ECHO L0001 /POINT TO TTY DATA TAD BUFOP DCA BUFIOT JMS I [BUFSWP /SET UP TTY POINTERS JMS I [TYP /ECHO CHAR /DISMISS INTERRUPT INTDON, TAD SAVF /GET FLAGS IFZERO PDP8I < PDP8I2, RTF /RESTORE FLAGS PDP8I3, CLA > IFNZRO PDP8I < CLL RAL RMF > TAD SAVAC /RESTORE AC JMP I SAVRES /EXIT FROM INTERRUPT INTTTY, TAD [BUFOP-BUFIOT+1 /POINT TO PRINTER DATA TAD BUFIOT DCA BUFIOT TAD I BUFIOT /GET TSF IOT DCA INTTSF INTTSF, HLT /PRINTER INTERRUPT? JMP INTNXT /NO, TRY NEXT USER OR UNDEFINED JMS I [BUFSWP /SET UP THE REST OF HIS POINTERS DCA I BUFSP /INDICATE PRINTER IS AVAILABLE JMS I [BUFO /GET CHARACTER OUT OF PRINTER BUFFER JMP INTTT2 /NONE THERE, CLEAR FLAG DCA INTTM /REMEMBER CHARACTER JMS I [OUT /OUTPUT IT TAD [-24 /DOES PRINTER BUFFER CONTAIN 20(10) CHARS? TAD I BUFC SZA CLA JMP INTDON /NO, JUST EXIT INTTBR, JMS I [INTPRI /YES, BREAK (RESET OUTPUT WAIT) 2000 /BIT 1 IS OUTPUT WAIT JMP INTDON /EXIT INTTT2, L0001 /CONVERT TSF TO TCF TAD INTTSF DCA INTTCF INTTCF, HLT /CLEAR INTERRUPT JMP INTDON /FINISHED INTCTO, CLA STL RAR /COMPLEMENT BIT 0 (CONTROL-O BIT) TAD I BUFSP2 DCA I BUFSP2 TAD [BUFOP-BUFIOT+1 /CLEAR PRINTER BUFFER JMS I [INTCB JMP INTTBR /INTERRUPT DONE INTCTC, TAD [BUFOP-BUFIOT+1 /CONTROL-C HANDLER JMS I [INTERR /FOR ERRORS IN INTERRUPTS ERR004 /ADDRESS OF ERROR IN FIELD 0 INTIOV, TAD [BUFOP-BUFIOT+1 /KEYBOARD BUFFER OVERFLOW JMS I [INTERR ERR070 INTNXT, ISZ INTUSR /MORE USERS? JMP INTKEY /YES CHECK THIER TTYS INTUDF, /UNDEFINED INTERRUPT /INSERT LIST OF CLEAR IOTS HERE JMP INTDON /FOLLOWED BY THIS PAGE
/ROUTINE TO SET UP POINTERS TO USER BUFFER DATA /BEGIOT POINTS TO FIRST BIT OF DATA BUFSWP, 0 /NOT SWAPPING, REALLY, BUT IT'S BUFSWP ANYHOW TAD BUFIOT /ALREADY SET UP? CMA TAD BUFSP SNA CLA JMP I BUFSWP /YES! QUICK EXIT TAD [-11 /DO 11 MORE WORDS DCA INTTM1 TAD [BUFIOT DCA INTTM2 BUFSW2, L0001 /SEQUENTIAL WORDS HAVE SEQUENTIAL VALUES TAD I INTTM2 ISZ INTTM2 DCA I INTTM2 ISZ INTTM1 /SET UP ALL WORDS? JMP BUFSW2 /NO JMP I BUFSWP /YES /ROUTINE TO PUT A CHARACTER INTO A BUFFER /8 BIT CHARACTER IS IN INTTM /IMMEDIATE RETURN MEANS NO ROOM WAS AVAILABLE FOR CHARACTER /SKIP RETURN IS NORMAL; CHARACTER IS IN BUFFER BUFI, 0 TAD I BUFM /COMPUTE CHARACTER CAPACITY CLL RAR TAD I BUFM CIA TAD I BUFC /COMPARE WITH # THERE ALREADY SMA CLA JMP I BUFI /ERROR RETURN: NO ROOM FOR CHARACTER ISZ I BUFC /BUMP CHARACTER COUNT ISZ BUFI /NORMAL RETURN (SKIP) ISZ I BUFIS /CONSULT 3-WAY SWITCH JMP BUFI1 /EASY WAY OUT L7775 /RESET SWITCH DCA I BUFIS L7776 /POINT TO WORD BEFORE LAST TAD I BUFIP AND I BUFM /MODULO LENGTH OF BUFFER TAD I BUFB /BASE OF BUFFER DCA INTTM1 TAD INTTM /SPLIT CHAR & STICK IN BITS 0-3 OF 2 WORDS RTL RTL AND C7400 TAD I INTTM1 DCA I INTTM1 ISZ INTTM1 /SECOND WORD TAD INTTM RTR RTR RAR AND C7400 TAD I INTTM1 JMP BUFI2 BUFI1, TAD I BUFIP /BUILD POINTER TO BUFFER AND I BUFM TAD I BUFB DCA INTTM1 ISZ I BUFIP /NEXT WORD OF BUFFER C7400, 7400 /ISZ MAY SKIP TAD INTTM /CHARACTER AND [177 /MAKE IT 8 BITS BUFI2, DCA I INTTM1 /STORE IT OFF JMP I BUFI /DONE AT LONG LAST /ROUTINE TO GET CHARACTER FROM BUFFER /IMMEDIATE RETURN MEANS NO CHARACTER WAS AVAILABLE /SKIP RETURN IS NORMAL; CHARACTER IS IN AC BUFO, 0 TAD I BUFC SNA JMP I BUFO /NO CHARACTERS THERE TO TAKE OUT! TAD [-1 DCA I BUFC ISZ BUFO ISZ I BUFOS JMP BUFO1 L7775 DCA I BUFOS L7776 TAD I BUFOP AND I BUFM TAD I BUFB DCA INTTM1 TAD I INTTM1 AND [3400 DCA INTTM2 ISZ INTTM1 TAD I INTTM1 AND C7400 CLL RTR RTR TAD INTTM2 RTR RTR JMP I BUFO BUFO1, TAD I BUFOP AND I BUFM TAD I BUFB DCA INTTM1 TAD I INTTM1 AND [177 ISZ I BUFOP JMP I BUFO JMP I BUFO /FIELD 1 CONTINUATION OF *READC* XRCF1, IOF /WE ARE SHARING CODE WITH THE INTERRUPT ROUTINE DCA BUFIOT /POINT TO KEYBOARD DATA JMS BUFSWP JMS BUFO /EXTRACT THE CHARACTER L4000 /WASN'T ONE ION /FINISHED SHARING CIF CDF 0 /RETURN TO FIELD 0 JMP I (XRCF0 IFZERO PDP8I < /POWER FAIL RECOVERY ROUTINE INTPFR, CAF /INITIALIZE ALL DEVICES TAD [12 /LINE FEED CODE BEGPFL, TLS /TLS CODES FOR ALL USERS NOP NOP NOP NOP NOP NOP NOP INTPF2, TSF /WAIT UNTIL LF DONE JMP INTPF3 TAD [INTRPT&177+5000-12 /TAD [-12+JMP INTRPT DCA I [2 /RESTORE NORMAL INTERRUPTS JMP I [INTDON /FINISH WHAT WAS SO RUDELY INTERRUPTED INTPF3, SPL /WATCH FOR ANOTHER POWER FAILURE JMP INTPF2 /WHILE RECOVERING FROM THIS ONE HLT /IT HAPPENED! > PAGE
/ROUTINE TO USE FIELD 0 *ERROR* ROUTINE INTERR, 0 JMS I [INTCB /CLEAR PRINTER BUFFER IFNZRO EDU250 < TAD DTDCTC /IS THIS JOB EXTENDING THE DIRECTORY? TAD INTUSR SNA CLA JMP INTER3 /YES, DELAY THE ERROR > JMS INTPRI /PUT USER IN HPQ 7777 TAD I [DBFTC /IS THIS USER RUNNING? CDF 10 CIA TAD BUFC SNA CLA JMP INTER2 /YES, RETURN DIRECTLY TAD [-BUFOP+BUFIOT-ENSWAP+PC-2 /CALCULATE PC'S SWAPPED LOCATION TAD BUFIOT DCA INTTM TAD I INTERR /GET RESTART ADDRESS DCA I INTTM /STORE IN PC JMP I [INTDON /EXIT FROM INTERRUPT INTER2, TAD I INTERR /GET RESTART LOC DCA SAVRES IFZERO PDP8I < RTF /COMBINED CID CDF 0; ION > IFNZRO PDP8I < CIF CDF 0 ION > JMP I SAVRES /GO DIRECTLY TO ERROR PROCESSOR IFNZRO EDU250 < INTER3, TAD I INTERR /WHEN DIRECTORY OPERATION IS FINISHED, DCA DTBSBN /WE WILL DO THE ERROR JMP I [INTDON /EXIT FROM INTERRUPT > /ROUTINE TO CLEAR I/O WAITS /WORD FOLLOWING CALL INDICATES WHICH IS BEING CLEARED /CAUTION: EXITS WITH DATA FIELD SET TO 0! INTPRI, 0 TAD USRPT /CALCULATE LOC OF FLD 0 STATUS WORD TAD INTUSR DCA INTTM1 TAD I INTPRI /GET STATUS MASK ISZ INTPRI /SKIP OVER MASK ON RETURN CDF 0 AND I INTTM1 /GET USER STATUS SNA CLA JMP I INTPRI /WASN'T WAITING DCA I INTTM1 /GIVE THIS JOB HIGHEST PRIORITY L7777 /STOP CURRENT USER AS SOON AS POSSIBLE DCA I [RUNTIM JMP I INTPRI /MAIN INTELLIGENT OUTPUT ROUTINE /HANDLES CR, BELL, PRINTING, & NON-PRINTING CHARACTERS. /INSERTS A CR-LF WHENEVER 72 CHARACTERS ARE PRINTED ON A LINE. /NON-PRINTING CHARACTERS ARE SUPPRESSED. *OUT* SHOULD BE USED /FOR SUCH THINGS AS LINE FEEDS AND LEADER-TRAILER CODE, ECT. TYP, 0 TAD [-15 TAD INTTM SNA JMP TYPCR /HANDLE CR TAD [-7+15 SNA JMP TYPBEL /OUTPUT BELL TAD [-"_+200-1+7 /CHECK IF PRINTING CHARACTER CLL TAD [-" +"_+1 SNL CLA JMP I TYP /NON-PRINTING, EXIT JMS OUT /OUTPUT IT ISZ I BUFSP2 /BUMP COLUMN COUNT JMP I TYP TAD [15 /TTY LINE HAS OVERFLOWED DCA INTTM TYPCR, JMS OUT /SO RETURN THE CARRIAGE TAD [-110 /-72(10) DCA I BUFSP2 /RESET COLUMN COUNT TAD [12 /NOW DO THE LF DCA INTTM TYPBEL, JMS OUT JMP I TYP /ALL DONE /ROUTINE TO ARRANGE OUTPUT OF CHARACTER IN INTTM. /ASSUMES BITS 0-3 OF INTTM ARE 0. OUT, 0 TAD I BUFSP /GET PRINTER BUSY STATUS SNA CLA /IS PRINTER BUSY? JMP OUT2 /NO JMS I [BUFI /YES, PUT CHAR IN PRINTER BUFFER JMP INTOOV /NO ROOM FOR IT JMP I OUT OUT2, TAD [TLS-TSF /CONVERT TSF IOT TO TLS TAD I BUFIOT /GET TSF DCA OUTTLS TAD INTTM /GET CHARACTER OUTTLS, HLT /ACTUALLY T*Y*P*E* IT!! L7777 /INDICATE PRINTER IS BUSY DCA I BUFSP JMP I OUT INTOOV, JMS INTERR /OUTPUT BUFFER OVERFLOW ERR080 /ROUTINE TO ARRANGE FOR A JOB TO USE *TYP* OR *OUT* OUTSIDE OF AN INTERRUPT. /A SKIP RETURN MEANS CONTROL-O IS IN EFFECT. JOB, 0 CDF 0 /MUST USE FIELD 0 IOF /SHARING CODE WITH INTERRUPT ROUTINE DCA INTTM /STANDARD PLACE FOR A CHARACTER TAD MUSRPT /THIS FAKES OUT *INTERR* IF NEED BE TAD I [LOOK DCA INTUSR /FAKED USER COUNT TAD I [DBFKS2 /GET POINTER TO CONTROL-O BIT DCA INTTM1 CDF 10 TAD I INTTM1 /CONTROL-O IS BIT 0 SPA CLA ISZ JOB /CONTROL-O: SKIP RETURN TAD [BUFOP-BUFSP2+1 /BUILD POINTER TO PRINTER DATA TAD INTTM1 DCA BUFIOT JMS I [BUFSWP /SET REST OF POINTERS JMP I JOB /DONE, AND NONE TOO SOON /FIELD 1 CONTINUATION OF *PRINTC* XPCF1, JMS JOB /SIMULATE INTERRUPT JMS TYP /PRINT IT CIF CDF 0 /NOW BEAT IT BACK TO FIELD 0 ION JMP XPCF0 /*PRINTX*, MERCIFULLY MOVED TO FIELD 1 XOUT, 0 JMS JOB /SIMULATE INTERRUPT JMS OUT /THIS WILL OUTPUT ANYTHING CIF CDF 0 ION JMP I XOUT /EXIT TO FIELD 0 PRINF1, JMS JOB /SPECIAL CONTROL/O KLUDGE FOR *PRINT* SKP JMP PRIN41 JMS TYP /OUTPUT SPACE L0002 TAD I BUFSP2 TAD [16 SPA JMP .-2 PRIN41, CIF CDF 0 JMP I [PRINF0 PAGE
IFNZRO EDU250 < /CONTROL WORDS FOR DECTAPE BUFFER /REFER TO BUFIOT DTBFM, 377 DTBFB, DTBUF DTBFC, 600 DTBFIS, -3 DTBFOS, -3 DTBFIP, 0 DTBFOP, 0 DTBFI=DTBFM-3 /LOGICAL START OF CONTROL WORDS /CONTINUATION OF DECTAPE *READC* DTRC2, JMS I [DTREAD /READ NEXT OS/8 BLOCK ISZ DTBLK /SELECT NEXT OS/8 BLOCK TAD [600 /JUST READ 600 CHARS DCA DTBFC /MAKE SURE BUFO KNOWS IT DTRCF1, IOF /SHARING CODE WITH INTERRUPT ROUTINE TAD [DTBFI /ADDR OF BUFFER CONTROL WORDS DCA BUFIOT JMS I [BUFSWP JMS I [BUFO /GET CHAR FROM DECTAPE BUFFER JMP DTRC2 /NONE LEFT CIF CDF 0 /AC=CHAR ION JMP DTRCF0 /CONTINUATION OF DECTAPE *PRINTC* DTPC2, TAD INTTM /PROTECT CHARACTER FROM INTERRUPTS DCA DTENTS JMS I [DTWRIT /WRITE DECTAPE BUFFER ISZ DTBLK /SELECT NEXT OS/8 BLOCK DCA DTBFC /ZERO CHAR COUNT TAD DTENTS /GET CHAR BACK DTPCF1, IOF /SHARING WITH INTERRUPTS DCA INTTM /SAVE CHAR TAD [DTBFI DCA BUFIOT JMS I [BUFSWP L0003 JMS I [BUFI /PUT CHAR IN DECTAPE BUFFER JMP DTPC2 /NO SPACE TAD [-15 /SET UP CHECK FOR CR TAD INTTM CIF CDF 0 ION JMP DTPCF0 /CONTINUATION OF *OLD* OLDF1, JMS I [DTLKUP /LOCATE OLD FILE ENTRY TAD DTSBN /STARTING BLOCK NUMBER DCA DTBLK /CURRENT OS/8 BLOCK DCA DTBFC /NO CHARACTERS IN BUFFER L7775 /POINT TO START OF BUFFER DCA DTBFOS DCA DTBFOP CDF CIF 0 JMP OLDF0 /HAVE FOUND FILE /CONTINUATION OF *CAT* CATF1, JMS I [DTDIR /GET NEXT DIRECTORY ENTRY JMP CATDON /NO MORE, DONE TAD I DTCEPT SNA CLA JMP CATF1 /IGNORE EMPTY ENTRIES L0003 /POINT TO EXTENSION TAD DTCEPT DCA TM1 CDF 0 TAD I [NAME+3 CDF 10 CIA TAD I TM1 /COMPARE WITH EXTENSION SZA CLA JMP CATF1 /IGNORE NON BASIC FILES L7775 /3 WORDS TO FILENAME DCA TM1 TAD DTCEPT DCA TM2 /POINTER TO FILENAME CAT3, TAD I TM2 BSW JMS I [CATPRT /PRINT CHAR OF FILENAME TAD I TM2 JMS I [CATPRT /PRINT NEXT CHAR ISZ TM2 /NEXT WORD OF FILENAME ISZ TM1 /ANY WORDS LEFT? JMP CAT3 /YES JMS I [CATPRT /PRINT SPACE AFTER NAME TAD I DTNEPT /GET LENGTH OF FILE CIF CDF 0 /GO TO FIELD 0 TO HAVE IT PRINTED JMP CATF0 CATDON, CIF CDF 0 JMP DTDONE /GO DEASSIGN DECTAPE /CONTINUATION OF *SAVE* SAVEF1, DCA DTIBL /AT MOST THIS BIG DCA DTBSBN L0001 /READ DIRECTORY SEGMENT 1 SAV2, JMS I [DTDIR JMP SAV5 /AIN'T NO MORE TAD I DTCEPT SZA CLA JMP SAV13 /NOT AN EMPTY TAD DTBSBN /FOUND A SPOT ALREADY? SZA CLA JMP SAV2 /YES, DON'T FIND ANOTHER TAD I DTNEPT /- LENGTH OF EMPTY CIA /SET UP LINK STL CIA TAD DTIBL /ESTIMATED FILE SIZE SNL SZA CLA JMP SAV2 /EMPTY TOO SMALL TAD DTSBN /REMEMBER THIS ENTRY DCA DTBSBN JMP SAV2 /IT SEEMS STUPID TO KEEP READING THE /DIRECTORY, BUT WE HAVE TO MAKE SURE THAT /THE FILE DOESN'T ALREADY EXIST SAV13, JMS I [DTNAME /MAKE SURE FILE NOT HERE ALREADY DTNCO1, 0 /THIS SUBR IS AN ARG TO DTNAME CIA TAD I XR2 SZA CLA JMP SAV2 /NOT SAME NAME JMS I DTNCO1 /EXIT ARG SUBR WITH JMS! DTLERR, CIF CDF 0 /FILE ALREADY EXISTS, OR LOOKUP ERROR JMP ERRDSV SAV5, TAD DTBSBN CIF CDF 0 SNA JMP ERRDNR /NO ROOM FOR OUTPUT FILE DCA DTBLK /THIS IS THE BLOCK FOR TRANSFERS DCA DTBFC /INIT BOGUS *PRINTC* FOR DECTAPE L7775 DCA DTBFIS DCA DTBFIP TAD [DTPC JMP SAVF0 PAGE
CATPRT, 0 /PRINT ROUTINE FOR *CAT* AND [77 /WIPE OUT GARBAGE SZA /IF ZERO, PRINT SPACE TAD (-40 /CONVERT SIXBIT TO ASCII SPA TAD [100 TAD (40 JMS I (JOB /PRINT CHARACTER IN AC JMS I [TYP ION JMP I CATPRT /DONE WITH THIS CHAR /CONTINUATION OF *UNSAVE* UNSF1, JMS I [DTLKUP /LOCATE FILE ENTRY TO UNSAVE DCA I DTCEPT /MAKE AN EMPTY OUT OF IT TAD DTCEPT DCA XR1 TAD I DTNEPT /GET LENGTH OF ENTRY DCA I XR1 /NOW LENGTH OF EMPTY L0002 /NOW, EXCEPT FOR EMPTY JMS I [DTDIRS /SQUISH OUT OLD ENTRY JMS I (DTDD1 /WIPE OUT ANY TRAILING EMPTIES JMS I [DTWRIT /WRITE NEW DIRECTORY CIF CDF 0 JMP I [DTDONE /DONE IFNZRO TD8E < /FOR USE BY DECTAPE READ & WRITE ROUTINES DTTBLK=TM1 /PHYSICAL BLOCK # BEING TRANSFERRED DTTBUF=INTUSR /BUFFER POINTER FOR TRANSFER DTTTM=INTTM /WORD COUNT FOR TRANSFER DTETRY=TM2 /ERROR RETRY COUNTER DTECS=INTTM1 /EQUIVALENCE CHECKSUM DTETM=INTTM2 /TEMP USED BY DTEEQ (CHECKSUMMER) /DECTAPE TRANSFER CONTROLLER /THIS ROUTINE'S MAIN FUNCTION IS TO POSITION THE DECTAPE /FOR DTRD AND DTWT. DTTCON, 0 TAD DTBLK /GET OS/8 BLOCK NUMBER CLL RAL /TRANSLATE TO PHYSICAL BLOCK NUMBER DCA DTTBLK L7775 /3 ERROR TRIES DCA DTETRY CIF CDF 0 JMP DTT3 DTTUTS, IOF /NO INTERRUPTS SDRC /CLEAR TIME ERROR, SLF, QLF SDLC JMS I (DTRQ /WAIT UNTIL MT REG CONTAINS VALID DATA DTTRMT, JMS DTRS /AC=NEXT MT+COMMAND REG+STATUS RTL AND (77^4 TAD (-26^4 /CHECK BLOCK MARK SZA JMP DTTMT2 /NOT BLOCK MARK SDRD /AC=BLOCK #, LINK=.NOT. DIRECTION BIT SNL /IF REVERSE, TARGET IS 3 BACK TAD [3 CIA TAD DTTBLK SZL /IF LINK=0, APPROACHING TARGET BLOCK JMP DTTREV /GONE PAST SNA JMP DTTFND /AT TARGET, MOVING FORWARD SPA CIA TAD [-1 /CHECK DISTANCE FROM TARGET SPA SNA JMP DTTRMT /ALMOST THERE, JUST WAIT TAD (-20+1 JMS DTECHK /CHECK TIME & SELECT ERRORS SZL CLA JMP DTTUTS /INTERRUPTS ONLY DTTLGO, CIF CDF 0 /TIMESHARING JMP DTT5 DTTMT2, TAD (-22+26^4 /CHECK END ZONE SZA CLA JMP DTTRMT /NOT END ZONE DTTREV, JMS DTECHK /CHECK ERRORS SDRC /REVERSE DECTAPE RTL CML RTR SDLC JMP DTTLGO DTTFND, JMS I (DTRQ /SKIP CONTROL WORDS JMS DTRS L0001 /SET UP POINTER TO BUFFER AND DTTBLK /BASED ON BIT 11 OF PHYS BLK ADDR CLL RAL BSW TAD (DTBUF DCA DTTBUF TAD (-200 /TRANSFER 200(8) WORDS DCA DTTTM JMS I (DTRQ JMS DTRS JMS I DTTCON /CALL ARGUMENT SUBROUTINE TO READ OR WRITE DTT2, 0 /JMS ARG RETURN LINKAGE SZA CLA /CHECK ERROR BITS JMP DTERR /ERROR ISZ DTTBLK /NEXT 200(8) WORDS L0001 /CHECK BIT 11 OF DTTBLK AND DTTBLK SZA CLA JMP DTTUTS /SET, MEANING THERE IS MORE TO READ DTTALM, SDLC /STOP DECTAPE CIF CDF 0 /GET OURSELVES SWAPPED IN JMP DTT4 /EVENTUAL RETURN WILL BE TO DTTDON DTTDON, TAD DTETRY /WERE WE SUCCESSFUL? SZA CLA JMP I DTT2 /YES, EXIT SWAPPED IN AND RUNNING CIF CDF 0 /NO, INVOKE *ERROR* JMP ERRDT DTECHK, 0 /CHECK TIME & SELECT ERRORS JMS DTRS /GET STATUS ION /ALLOW INTERRUPTS AND [100 /ISOLATE ERROR BIT SNA CLA JMP I DTECHK /NO ERROR DTERR, ISZ DTETRY /SOME DECTAPE ERROR JMP DTTUTS /TRY AGAIN JMP DTTALM /FATAL, CONFIRMED ERROR DTRS, 0 /READ NEXT MARK TRACK REGISTE SDSS /WAIT FOR SINGLE LINE JMP .-1 SDRC /READ MT REG & OTHERS JMP I DTRS PAGE
/DECTAPE READ ROUTINE /READS ONE OS/8 BLOCK (400(8) WORDS) FROM THE DECTAPE. /TRANSFER IS FROM THE OS/8 BLOCK IN DTBLK TO CORE AT DTBUF. /ON EXIT, THE USER IS SWAPPED IN AND RUNNING. DTREAD, 0 JMS I [DTTCON /USE THE DECTAPE TRANFER CONTROLLER /THE SUBROUTINE DTRD IS THE ARGUMENT TO DTTCON DTRD, 0 /DTRD READS A PHYSICAL DECTAPE BLOCK (200(8) WORDS) JMS DTRQ /SKIP OVER CONTROL WORD JMS DTRQ /GET REVERSE CHECKSUM AND [77 TAD [7700 DCA DTECS /EQUIVALENCE CHECKSUM DTRLP, JMS DTRQ /READ A WORD DCA I DTTBUF /SAVE IT IN THE BUFFER TAD I DTTBUF /GET IT BACK JMS DTEEQ /CHECKSUM IT ISZ DTTBUF /POINT TO NEXT WORD OF BUFFER ISZ DTTTM /READ ALL WORDS? JMP DTRLP /NO JMS DTRQ /READ 129TH WORD JMS DTEEQ /CHECKSUM IT JMS DTRQ /READ CHECKSUM AND [7700 /HACK OFF IRRELEVANT PART JMS DTEEQ /INCLUDE IN CHECKSUM JMS I [DTRS /READ DECTAPE COMMAND REGISTER AND [100 /LOOK AT TIME & SELECT ERROR BIT SNA JMS DTEBYT /UNLESS OTHER ERROR, SEE IF CHECKSUM OK JMS I DTRD /FUNNY EXIT FROM ARG TO DTTCON JMP I DTREAD /EXIT FROM DTREAD /DECTAPE WRITE SUBROUTINE /WRITES ONE OS/8 BLOCK (400(8) WORDS). /TRANFER IS FROM CORE AT DTBUF TO THE OS/8 BLOCK IN DTBLK /ON EXIT, THE USER IS SWAPPED IN AND RUNNING. DTWRIT, 0 JMS I [DTTCON /USE DECTAPE TRANSFER CONTROLLER DTWT, 0 /LIKE DTRD, THIS IS ARG TO DTTCON JMS DTRQ /SKIP OVER CONTROL WORD SDRC /TURN WRITE HEAD ON TAD [400 SDLC L7777 /WRITE 7777 IN REVERSE CHECKSUM SDLD DCA DTECS /AND IN THE CHECKSUM WORD DTWLP, TAD I DTTBUF /GET WORD FROM BUFFER JMS DTWQ /WRITE WORD ISZ DTTBUF /POINT TO NEXT WORD IN BUFFER ISZ DTTTM /DONE WHOLE BUFFER? JMP DTWLP /NO JMS DTWQ /WRITE 0000 IN 129TH WORD JMS DTEBYT /GET CHECKSUM JMS DTWQ /WRITE CHECKSUM JMS DTRQ /GIVE CHECKSUM TIME TO BE WRITTEN SDRC /TURN OFF WRITE HEAD DCA DTTTM /REMEMBER CURRENT STATUS FOR ERRORS TAD DTTTM AND [7000 SDLC TAD DTTTM /GET OLD COMMAND REGISTER AND [300 /LOOK AT WRITE LOCKOUT, TIME & SELECT BITS JMS I DTWT /THAT FUNNY EXIT JMP I DTWRIT /EXIT FROM DTWRIT DTRQ, 0 /READ NEXT DATA WORD SDSQ /WAIT FOR QUAD LINE JMP .-1 SDRD /READ DATA REGISTER JMP I DTRQ DTWQ, 0 /WRITE NEXT DATA WORD SDSQ JMP .-1 SDLD /LOAD WRITE DATA JMS DTEEQ /CHECKSUM DATA WRITING JMP I DTWQ DTEEQ, 0 /EQUIVALENCE CHECKSUM CMA DCA DTETM /ACTUALLY CHECKSUMS ON DECTAPE ARE TAD DTETM /EQUIVALENCE OF ALL WORDS IN A RECORD AND DTECS /6 BITS AT A TIME. SINCE EQUIVALENCE CIA /IS ASSOCIATIVE WE DO IT 12 AT A TIME CLL RAL /AND CONDENSE LATER TAD DTETM /IDENTITIES USED ARE: TAD DTECS /A+B=(A.XOR.B)+2*(A.AND.B) DCA DTECS /A.EQU.B=.NOT.(A.XOR.B)=A.XOR.(.NOT.B) JMP I DTEEQ /A.EQU.B=(A+(.NOT.B))-2*(A.AND.(.NOT.B)) DTEBYT, 0 /CONVERT 12 BIT CHECKSUM TO 6 BITS TAD DTECS CLL CMA BSW JMS DTEEQ TAD DTECS AND [7700 JMP I DTEBYT /AC0-5=CHECKSUM, AC6-11=0 > IFNZRO RK8E < DTWRIT, 0 TAD DTWRIT DCA DTREAD L4000 SKP DTREAD, 0 CDF 0 TAD I [DEV CDF 10 CLL RAR DCA TM1 SZL TAD [6260 CLL TAD DTBLK DCA TM2 TAD TM1 RAL TAD [10 DLDC TAD [DTBUF DLCA L7775 DCA TM1 DTR2, DCLR TAD TM2 DLAG DSKP JMP .-1 DRST CLL RAL SNA JMP I DTREAD AND [1002 SNA CLA JMP DTR3 /RECALIBRATE DRIVE DCLR L0002 DCLR DSKP JMP .-1 DCLR DRST SZA CLA JMP .-2 DTR3, ISZ TM1 JMP DTR2 CIF CDF 0 JMP ERRDT >
IFNZRO RX8E < DTWRIT, 0 /WRITE OS/8 BLOCK ON FLOPPY DISK JMS RXCON /THIS CONTROLS MAIN READ/WRITE LOOP RXW, 0 /WITH RXW (WRITE SEQUENCE CONTROL) JMS RXBUF /FILL HARDWARE BUFFER JMS RXRW /WRITE RX8E RECORD JMS I RXW /NOTE PECULIAR RETURN JMP I DTWRIT /DONE--SUBROUTINES DID THE WORK DTREAD, 0 /READ OS/8 BLOCK FROM FLOPPY DISK L0002 /SET READ BIT IN COMMAND WORD JMS RXCON /RXCON CONTROLS RX8E READ LOOP TOO RXR, 0 /NOTE SUBR RXR IS AN ARG TO RXCON JMS RXRW /FIRST READ RX8E REC JMS RXBUF /THEN EMPTY HARDWARE BUFFER JMS I RXR /STRANGE EXIT FROM ARG SUBR JMP I DTREAD /DONE RXCON, 0 /CONTROLS READ/WRITE OF OS/8 BLK ON RX8E CDF 0 /GET DEVICE BIT FROM FLD 0 TAD I [DEV /COMBINED WITH READ/WRITE BIT IN AC CDF 10 DCA RXFN /SAVE COMMAND REG WORD TAD [-4 /READ 4 RX8E RECS PER OS/8 BLK DCA TM1 TAD [DTBUF /POINTER TO CORE BUFFER DCA RXBFPT TAD DTBLK /CONVERT OS/8 BLKS TO RX8E RECS CLL RTL /MULTIPLY BY 4 DCA RXREC RXCONL, JMS I RXCON /TRANSFER 1 RX8E RECORD RXCONR, 0 /POINTER TO END OF ARG SUBR ISZ RXREC /NEXT RX8E RECORD ISZ TM1 /TRANSFERED 4 RECS YET? JMP RXCONL /NO: DO NEXT ONE JMP I RXCONR /YES: READ/WRITE DONE RXBUF, 0 /EMPTY/FILL RX8E'S HARDWARE BUFFER INTR /NO INTERRUPT ON DONE FLAG TAD RXBFPT /SAVE CURRENT PLACE IN BUFFER MQL /(IN CASE OF ERROR) TAD [-12 /TEN ERROR RETRIES ALLOWED DCA RXERCT RXBERL, TAD RXFN /INITIATE EMPTY/FILL OF HARD BUFFER LCD MQA /POINT TO RIGHT PLACE IN CORE BUFFER DCA RXBFPT RXB1, STR /READY TO TRANSFER A WORD? JMP RXB2 /NO: CHECK DONE FLAG TAD I RXBFPT /GET WORD IN CASE SENDING XDR /TRANSFER WORD DCA I RXBFPT /SAVD WORD IN CASE RECIEVING ISZ RXBFPT /POINT TO NEXT CORE BUFFER WORD RXB2, SDN /DONE? JMP RXB1 /NOT SURE, CHECK TRANSFER READY FLAG SER /YES: ANY ERRORS OCCUR? JMP I RXBUF /NO: EXIT ISZ RXERCT /YES: IS IT A HARD ERROR YET? JMP RXBERL /NO, TRY AGAIN RXFAT, CIF CDF 0 /FATAL I/O ERROR JMP ERRDT RXRW, 0 /READ/WRITE 1 RX8E REC INTO HARDWARE BUFFER TAD [-12 /TEN ERROR RETRIES ALLOWED DCA RXERCT RXRERL, L0004 /BIT TO CAUSE ACTUAL READ OR WRITE CLL IAC /CLL FOR LATER; AC11 IGNORED BY LCD INTR /BUT AC11 SETS INTERRUPT ON DONE FLAG TAD RXFN /ADD DEVICE&R/W BITS LCD /INITIATE ACTUAL DATA TRANSFER ON FLOPPY DCA RXTRAK /NOW COMPUTE TRACK (0-114(8)) /CLL /AND SECTOR (1-32(8)) FROM RECORD # TAD RXREC /JUST LIKE OS/8, INCLUDING INTERLEAVING RXDVLP, SNL ISZ RXTRAK TAD [-15 /THIS IS DIVISION SMA JMP RXDVLP RAL /INTERLEAVING STEP TAD [33 STR JMP .-1 XDR /TRANSFER SECTOR # CLA /THEN TRANSFER TRACK # TAD RXTRAK STR JMP .-1 XDR /NOW ACTUAL DATA TRANSFER CAN BEGIN CIF CDF 0 /DISMISS UNTIL DONE FLAG COMES UP JMS RXF0DW SER /ANY ERRORS? JMP I RXRW /NO: EXIT XDR /YES: GET ERROR&STATUS WORD RTR /CHECK CRC(BIT11) & PARITY(BIT 10) SPA SZL CLA JMP .+4 INIT /RECALIBRATE IF NOT CRC & NOT PARITY CIF CDF 0 /THEN WAIT FOR DONE FLAG JMS RXF0DW /(NONWASTEFULLY) ISZ RXERCT /HARD ERROR YET? JMP RXRERL /NO: KEEP TRYING TO DO IT RIGHT JMP RXFAT /YES: INDICATE FATAL ERROR RXBFPT=TM2 /POINTER TO CORE BUFFER RXREC, 0 /RX8E LOGICAL RECORD RXTRAK, 0 /RX8E TRACK CORRESPONDING TO RXREC RXERCT, 0 /ERROR RETRY COUNTER RXFN, 0 /DEVICE & R/W BITS FOR RX8E COMMAND REG /TM1 PAGE >
/SECOND CONTINUATION OF *SAVE* SAV2F1, JMS I [DTWRIT /WRITE LAST BLOCK OF FILE TAD DTBLK /COMPUTE ACTUAL LENGTH OF FILE CMA TAD DTBSBN DCA DTIBL TAD [DTDONE /EVENTUAL EXIT ADDRESS DCA DTDCTD /UNLESS CHANGED BY INTERR JMS I (SAVENT /MAKE ENTRY IN DIRECTORY JMS I (DTDD1 /CHECK FOR SEGMENT OVERFLOW JMP SAVDON /NONE, DONE NOW JMS I (DTDD2 /CHECK FOR DIRECTORY OVERFLOW JMS I (SAVENT /MAKE ENTRY FOR REAL JMS I (DTDD1 /GET TO OVERFLOW HLT /BUG OR SWITCHED TAPES CDF 0 /DISABLE CONTROL-C TAD I [LOOK CDF 10 CIA TAD USRPT DCA DTDCTC JMS I (DTDD2 /HANDLE SEGMENT OVERFLOW SAVDON, JMS I [DTWRIT /WRITE LAST DIRECTORY SEGMENT DCA DTDCTC /ENABLE CONTROL-C CIF CDF 0 JMP I DTDCTD /EXIT > /ROUTINE TO CLEAR BUFFER (USUALLY OUTPUT BUFFER) INTCB, 0 TAD BUFIOT DCA BUFIOT JMS I [BUFSWP /SET UP POINTERS TO BUFFER DATA DCA I BUFC /ZERO CHARACTER COUNT L7775 /RESET 3-WAY SWITCHES DCA I BUFIS L7775 DCA I BUFOS DCA I BUFIP /POINTERS SAME DCA I BUFOP JMP I INTCB /BUFFER IS CLEARED
IFNZRO EDU250 < PAGE /DIRECTORY READER DTDIR, 0 SZA JMP DTD2 JMS DTDIRC ISZ DTENTS JMP DTD3 TAD I [DLINK SNA JMP I DTDIR DTD2, DCA DTBLK JMS I [DTREAD TAD I [DCOUNT DCA DTENTS TAD I [DORG DCA DTSBN TAD [DCOUNT DCA DTLEPT TAD [DPROPR DCA DTCEPT DTD3, JMS DTDIRN ISZ DTDIR JMP I DTDIR DTDIRC, 0 TAD I DTNEPT CIA TAD DTSBN DCA DTSBN /SQUEEZE OUT 0 LENGTH ENTRIES & CONSECUTIVE ENTRIES TAD I DTNEPT SNA CLA JMP DTDC2 /0 LEN ENTRY: SQUISH TAD I DTLEPT SNA TAD I DTCEPT SZA CLA JMP DTDC3 L7777 TAD DTCEPT DCA TM1 TAD I DTNEPT TAD I TM1 DCA I TM1 DTDC2, JMS DTDIRS /SQUISH OUT CURRENT ENTRY ISZ I [DCOUNT /ONE LESS ENTRY JMP I DTDIRC /NOW POINTING AT NEW ENTRY DTDC3, TAD DTCEPT DCA DTLEPT L0001 TAD DTNEPT DCA DTCEPT JMP I DTDIRC DTDIRN, 0 /FIND END OF CURRENT ENTRY TAD I DTCEPT SNA CLA JMP DTDN2 L7775 TAD I [DWASTE CIA DTDN2, IAC TAD DTCEPT DCA DTNEPT JMP I DTDIRN DTDIRS, 0 /ELIMINATE CURRENT ENTRY TAD DTCEPT DCA TM1 /MOVE DIRECTORY UP TO HERE DTDS2, ISZ DTNEPT TAD I DTNEPT DCA I TM1 ISZ TM1 TAD [-DTBEND TAD DTNEPT SPA CLA JMP DTDS2 JMP I DTDIRS DTDIRM, 0 /MAKE ROOM AT CURRENT ENTRY TAD [DTBEND+1 DCA TM1 /MOVE DIRECTORY FROM HERE TAD [DTBEND+1 DCA TM2 /TO HERE DTDM2, L7777 /BACK POINTERS UP TAD TM1 DCA TM1 L7777 TAD TM2 DCA TM2 TAD I TM1 /MOVE DIRECTORY DOWN DCA I TM2 TAD DTCEPT /AT CURRENT ENTRY YET? CIA TAD TM1 SZA SMA CLA JMP DTDM2 /NO, MOVE ANOTHER WORD DOWN JMP I DTDIRM /YES, EXIT DTLKUP, 0 /ROUTINE TO LOOK UP A FILENAME L0001 /FIRST DIRECTORY SEGMENT DTL2, JMS DTDIR /GET FILE ENTRY JMP I [DTLERR /FILE NOT FOUND JMS DTNAME /IS CURRENT ENTRY THE FILE? DTNCO3, 0 CIA TAD I XR2 SZA CLA JMP DTL2 /NOT THIS ENTRY JMS I DTNCO3 JMP I DTLKUP /CURRENT ENTRY IS FILE IN QUESTION DTNAME, 0 TAD [-4 DCA TM1 TAD [NAME-1 DCA XR1 L7777 TAD DTCEPT DCA XR2 DTN2, CDF 0 TAD I XR1 CDF 10 JMS I DTNAME DTN3, 0 ISZ TM1 JMP DTN2 JMP I DTN3 PAGE
SAVENT, 0 L0001 /READING DIRECTORY AGAIN SAV12, JMS I [DTDIR HLT /SYSTEM ERROR: BUG, SWITCHED TAPES TAD DTBSBN /IS THIS THE EMPTY THAT BECOMES A FILE ENTRY? CIA TAD DTSBN SZA CLA JMP SAV12 /NO, NOT SAME SPOT OUT ON TAPE TAD DTIBL /CHANGE LENGTH OF EMPTY STL CIA TAD I DTNEPT SNL SZA HLT /BLOCKS IN EMPTY .LT. 0: BAD ESTIMATE DCA I DTNEPT TAD [-5 /MAKE ROOM FOR NEW ENTRY TAD I [DWASTE JMS I [DTDIRM JMS I [DTNAME /TRANSFER NAME TO DIRECTORY DTNCO2, 0 DCA I XR2 JMS I DTNCO2 /EXIT INTO DTNAME TAD I [DWASTE /ZERO WASTE WORDS SNA JMP SAV10 /THERE ARE NONE DCA TM1 DCA I XR2 /ZERO WORD ISZ TM1 JMP .-2 /ZERO ANOTHER SAV10, TAD DTIBL /FIX LENGTH OF NEW ENTRY DCA I XR2 L7777 /ONE MORE ENTRY IN SEGMENT TAD I [DCOUNT DCA I [DCOUNT L7777 /ONE MORE ENTRY TO SCAN, TOO TAD DTENTS DCA DTENTS JMP I SAVENT DTDD1, 0 DTDD11, JMS I [DTDIRN TAD [DCOUNT+400-5 /CHECK SEGMENT OVERFLOW TAD I [DWASTE CIA TAD DTNEPT SMA CLA JMP DTDD13 /OH-OH, SEGMENT OVERFLOWED JMS I [DTDIRC ISZ DTENTS JMP DTDD11 JMP I DTDD1 /NO SEGMENT OVERFLOW DTDD13, ISZ DTDD1 /SEGMENT OVERFLOW: SKIP RETURN JMP I DTDD1 DTDD2, 0 DTDD21, TAD (DTBOV-1 /SAVE OVERFLOWED ENTRIES DCA XR1 L7777 TAD DTCEPT DCA XR2 TAD (-16 /LARGEST OVERFLOW IF 1 WASTE WORD DCA DTNEPT /TEMP COUNTER TAD I XR2 DCA I XR1 ISZ DTNEPT /THIS MUST = 0 FOR LATER JMP .-3 TAD I [DLINK DCA XR1 TAD [-6 TAD DTBLK SNA JMP SAVERR /DIRECTORY OVERFLOW TAD [7 DCA I [DLINK TAD DTENTS CIA TAD I [DCOUNT DCA I [DCOUNT TAD DTDCTC /ACTUALLY WRITE DIRECTORY? SZA CLA JMS I [DTWRIT DCA I [DLINK /DON'T ASSUME SEGMENT PAST THIS ONE ISZ DTBLK /OS/8 BLOCK OF DIRECTORY EXTENSION TAD XR1 /OLD DLINK SNA CLA /ALREADY ANOTHER BLOCK TO DIRECTORY? JMP DTDD3 /NO, CREATE ONE JMS I [DTREAD /READ DIRECTORY TAD I [DCOUNT /NOT STARTING FROM SCRATCH DTDD3, TAD DTENTS /DTENTS IS OVERFLOW FROM LAST SEGMENT DCA I [DCOUNT /ALTERED DCOUNT TAD DTSBN /NEW DORG DCA I [DORG TAD (DTBOV-1 DTDD4, IAC TAD DTNEPT /DTNEPT SHOULD = 0 FIRST TIME THROUGH DCA DTCEPT JMS I [DTDIRN /FIND END OF CURRENT ENTRY ISZ DTENTS /COUNT OVERFLOWED ENTRIES JMP DTDD4 TAD [DCOUNT /POINTER FOR START OF DIRECTORY SEGMENT DCA DTLEPT TAD [DPROPR DCA DTCEPT TAD DTNEPT /SAVENT=-LENGTH OF OVERFLOW CIA TAD (DTBOV-1 DCA SAVENT TAD SAVENT /MAKE ROOM FOR OVERFLOW JMS I [DTDIRM TAD [DPROPR-1 /INSERT OVERFLOWED ENTRIES DCA XR1 TAD (DTBOV-1 DCA XR2 TAD I XR2 DCA I XR1 ISZ SAVENT /COUNT WORDS JMP .-3 TAD I [DCOUNT /NEW NUMBER OF ENTRIES IN SEGMENT DCA DTENTS JMS DTDD1 /CHECK FOR ANOTHER SEGMENT OVERFLOW JMP I DTDD2 /NOT FOUND: EXIT JMP DTDD21 /HANDLE THIS OVERFLOW SAVERR, CIF CDF 0 JMP I (ERRDOV PAGE >
/KEYWORD DECODER XCOM, DCA COMPT DCA COMCT TAD I LAXOUT /QUICKIE SAVE TEXT POINTERS DCA COMAXT TAD I LGTEM DCA COMGTM TAD I LXCT DCA COMXCT TAD I LCHAR DCA COMCHR CDF 10 COM2, TAD COMPT /POINTER FOR UNPACKING DCA COMPT2 JMP COM3 XCOMF1, ISZ COMTM /UNPACK CHARACTER JMP COM5 COM3, L7776 DCA COMTM ISZ COMPT2 TAD I COMPT2 RTR RTR RTR COM4, AND L77 SNA JMP COM6 /MATCH! TAD L40 /CONVERT TO ASCII CIA CIF CDF 0 TAD I LCHAR /COMPARE WITH CURRENT CHAR SNA CLA JMP I LF0GETC /SAME: COMPARE NEXT 2 CHARS TAD COMAXT /FAST RESTORE ORIGINAL TEXT POINTERS DCA I LAXOUT TAD COMGTM DCA I LGTEM TAD COMXCT DCA I LXCT TAD COMCHR DCA I LCHAR CIF CDF 10 ISZ COMCT /COUNT FAILED KEYWORDS TAD I COMPT /POINT TO NEXT KEYWORD DCA COMPT JMP COM2 /SEE IF THIS ONE COM5, TAD I COMPT2 JMP COM4 COM6, TAD COMCT /GET KEYWORD CODE CIF CDF 0 /BEGIN ARDUOUS EXIT FROM WRONG FIELD JMP I LF0CMN1 LAXOUT, AXOUT LGTEM, GTEM LXCT, XCT LCHAR, CHAR L77, 77 L40, 40 LF0GETC, F0GETC LF0CMN1, F0CMN1 COMCT, 0 /KEYWORD CODE COMPT, 0 /KEYWORD POINTER COMPT2, 0 /KEYWORD UNPACK POINTER COMTM, 0 /KEYWORD UNPACK TEMP COMAXT, 0 /AXOUT SAVE COMGTM, 0 /GTEM SAVE COMXCT, 0 /XCT SAVE COMCHR, 0 /CHAR SAVE /COMMAND DISPATCH LIST COMGOL, LIST RUN EDIT DELETE SCR /SCRATCH NEW /NEW BYE /BYE PUNCH IFNZRO EDU250 < OLD SAVE UNSAVE CATAL> /STATEMENT DISPATCH LIST COMGO2, LET PRINT GOTO IF FOR NEXT INPUT READ CONT /DATA GOSUB RETURN CONT /DEF ON REM /REM LINPUT RESTOR CONT /DIM RANDOM ECHO NOECHO REM /! COMMENT READY /STOP END LET /UNKNOWN KWTHEN, LIST0 6450 /TH 4556 /EN 0000 /SPACE,SPACE KWTO, LIST0 6457 /TO 0000 /SPACE,SPACE KWSTEP, LIST0 6364 /ST 4560 /EP 0000 /SPACE,SPACE KWDEF, LIST0 4445 /DE 4646 /FF 5600 /N,SPACE KWNEXT, LIST0 5645 /NE 7064 /XT 0000 /SPACE,SPACE KWDATA, LIST0 4441 /DA 6441 /TA 0000 /SPACE,SPACE KWTAB, KWCHR 6441 /TA 4200 /B,SPACE KWCHR, LIST0 4350 /CH 6204 /R$ 0000 /SPACE,SPACE KWREL4, KWREL2 3400 /< KWREL2, KWREL3 3600 /> KWREL3, LIST0 3500 /= KWRELS, KWREL5 3435 /<= 0000 KWREL5, KWREL6 3635 />= 0000 KWREL6, KWREL4 3436 /<> 0000 IFNZRO TD8E < KWDEV, KWDTA1 4464 /DT 4120 /A0 3200 /: KWDTA1, LIST0 4464 /DT 4121 /A1 3200 /: > IFNZRO RK8E < KWDEV, KWRKB0 6253 /RK 4120 /A0 3200 /: KWRKB0, KWRKA1 6253 /RK 4220 /B0 3200 /: KWRKA1, KWRKB1 6253 /RK 4121 /A1 3200 /: KWRKB1, KWRKA2 6253 /KW 4221 /B1 3200 /: KWRKA2, KWRKB2 6253 /RK 4122 /A2 3200 /: KWRKB2, KWRKA3 6253 /RK 4222 /B2 3200 /: KWRKA3, KWRKB3 6253 /RK 4123 /A3 3200 /: KWRKB3, LIST0 6253 /RK 4223 /B3 3200 /: > IFNZRO RX8E < KWDEV, KWRXA1 6270 /RX 4120 /A0 3200 /: KWRXA1, LIST0 6270 /RX 4121 /A1 3200 /: > /USED BY THE GETC ROUTINE XGETL2, XGET5-1 /CR XGET4-1 /BELL XGET3-1 /SPACE /USED BY THE EDIT COMMAND EDITL2, EDTCR-1 /CR EDTLF-1 /LF EDTFF-1 /FF EDTBEL-1 /BELL EDITL, 15 /CR 12 /LF 14 /FF 7 /BELL /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 -"S+200 /SYS
/COMMAND KEYWORD LIST KWCOM, 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 6200 /R,SPACE LIST4, LIST3 5645 /NE 6700 /W,SPACE LIST3, LIST2 4271 /BY 4500 /E,SPACE LIST2, IFNZRO EDU250 <LISTDT> IFZERO EDU250 <KWST> 6065 /PU 5643 /NC 5000 /H,SPACE IFNZRO EDU250 < LISTDT, LISTD2 5754 /OL 4400 /D,SPACE LISTD2, LISTD3 6341 /SA 6645 /VE 0000 /SPACE,SPACE LISTD3, LISTD4 6556 /UN 6341 /SA 6645 /VE 0000 /SPACE,SPACE LISTD4, KWST 4341 /CA 6400 /T,SPACE > /STATEMENT KEYWORD LIST KWST, LIST40 /LINK TO NEXT KEYWORD 5445 /LE 6400 /T,SPACE LIST40, KWGOTO 6062 /PR 5156 /IN 6400 /T,SPACE KWGOTO, LIST36 4757 /GO 6457 /TO 0000 /SPACE,SPACE LIST36, LIST34 5146 /IF 0000 /SPACE,SPACE LIST34, LIST31 4657 /FO 6200 /R,SPACE LIST31, LIST30 5645 /NE 7064 /XT 0000 /SPACE,SPACE LIST30, LIST27 5156 /IN 6065 /PU 6400 /T,SPACE LIST27, LIST26 6245 /RE 4144 /AD 0000 /SPACE,SPACE LIST26, LIST25 4441 /DA 6441 /TA 0000 /SPACE,SPACE LIST25, LIST24 4757 /GO 6365 /SU 4200 /B,SPACE LIST24, LIST23 6245 /RE 6465 /TU 6256 /RN 0000 /SPACE,SPACE LIST23, LIST21 4445 /DE 4600 /F,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, LISTA1 6241 /RA 5644 /ND 5755 /OM 0000 /SPACE,SPACE LISTA1, LISTA2 4543 /EC 5057 /HO 0000 /SPACE,SPACE LISTA2, LISTA3 5657 /NO 4543 /EC 5057 /HO 0000 /SPACE,SPACE LISTA3, LIST13 0100 /!,SPACE LIST13, LIST12 6364 /ST LIST0, 5760 /OP 0000 /SPACE,SPACE LIST12, LIST0 4556 /EN 4400 /D,SPACE
/A WHOLE BUNCH OF SORTC AND SORTJ LISTS IFNZRO EDU250 < /USED BY DTGNAM DTGL, 15 /CR ".-200 /. 7777 > /USED BY THE PRINT STATEMENT PRINL2, PRIN71-1 /CR PRIN61-1 /" /USED BY THE PRINT STATEMENT PRINL, 73 /; 54 /, 41 /! 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 /@ 12 /LINE FEED 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 /@ XPACK5-1 /LINE FEED /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 23^40+31 /SY 7777 /LIST OF ERROR ADDRESSES (USED BY THE ERROR ROUTINE) ERRLST, ERR004+1%2 /STOP (CONTROL-C) ERR010+1%2 /ERROR 1 ERR020+1%2 /ERROR 2 ERR030+1%2 ERR040+1%2 ERR060+1%2 ERR070+1%2 ERR080+1%2 ERR100+1%2 ERR150+1%2 ERR110+1%2 ERR120+1%2 ERR260+1%2 ERR220+1%2 ERR130+1%2 ERR230+1%2 ERR170+1%2 ERR250+1%2 ERR210+1%2 ERR200+1%2 ERR180+1%2 ERR240+1%2 ERR410+1%2 ERR450+1%2 ERR430+1%2 ERR420+1%2 ERR440+1%2 ERR460+1%2 ERR470+1%2 ERR350+1%2 ERR340+1%2 ERR270+1%2 ERR370+1%2 ERR380+1%2 ERR390+1%2 ERR400+1%2 ERR500+1%2 ERR490+1%2 ERR510+1%2 ERR320+1%2 ERR330+1%2 ERR300+1%2 ERR280+1%2 ERR001+1%2 ERR003+1%2 ERRBEX+1%2 /SYNTAX ERROR IN AN EXPRESSION ERRSAR+1%2 /MISSING ARGUMENT TO MID OR CAT FUNCTION ERRSOV+1%2 /STRING OVERFLOW IN MID FUNCTION IFNZRO EDU250 < ERRDOV+1%2 ERRDTG+1%2 ERRDSV+1%2 ERRDNR+1%2 ERRDT+1%2> 7777
/USER DEFINITIONS IFNZRO EDU250 < DTBUF, /DECTAPE BUFFER DCOUNT, -1 /MINUS # OF ENTRIES IN DIRECTORY SEGMENT DORG, 70 /STARTING BLOCK # OF THIS SEGMENT DLINK, 0 /LINK TO NEXT DIRECTORY SEGMENT 0 /USED BY OS/8, BUT NOT BY EDU250 DWASTE, -1 /MINUS # OF ADDITIONAL INFORMATION WORDS DPROPR, 0 /START OF ENTRIES ZBLOCK 416-6 /ZERO OUT REST OF BUFFER DTBEND=DTBUF+377+16 DTBOV=. ZBLOCK 16 /ZERO SEGMENT OVERFLOW AREA > /USER DEFINITIONS BUF=. /START OF USER TTY BUFFERS SWPR=USERS^100+BUF /START OF USER SWAP REGIONS SWPRBF=SWPR+ENSWAP-STSWAP+1 /USER 0 POINTERS TO TTY DATA SWPRL=ENSWAP-STSWAP+BUFOP-BUFIOT+BUFOP-BUFIOT+3 ORG=SWPRL^USERS+BUF /START OF FIELD 1 USER CORE BUFCOM=0 /RELATIVE DEFINITIONS LINE0=BUFCOM+72 LINE1=LINE0+2 TOP=7776 BEGXR1=XR1 BEGXR2=XR2 BEGUSR=SAVAC BEGORG=SAVF BEGSWP=SAVRES BEGNUM=INTUSR BEGTM1=INTTM BEGTM2=INTTM1 BEGTM3=INTTM2 BEGTM4=BUFIOT BEGTM5=BUFSP /USER 0 TTY BUFFER ENPUNCH *. IFZERO .&7600+200-.&7760 <*.&7600+200> /AVOID PAGE BOUNDARY /CLEAR ALL CORE AND START UP EDU250 BEGCL1, DCA I BEGORG /CLEAR CORE ISZ BEGORG JMP .-2 CIF CDF 0 /YES, START UP EDU250!! ION JMP I .+1 ENTRY IFNZRO CONFIG < FIELD 0 *BEGKIE KIE JMP NULL5 JMP NULL5 JMP NULL5 JMP NULL5 JMP NULL5 JMP NULL5 JMP NULL5 *USER0 0000 7777 7777 7777 7777 7777 7777 7777 FIELD 1 IFZERO PDP8I < *BEGPFL TLS NOP NOP NOP NOP NOP NOP NOP> > *4000 /START OF INTITIALIZER BEG000, NOP /ARE WE RUNNING ON THE RIGHT MACHINE? IFZERO PDP8I <CLA IAC BSW; TAD (-100> IFNZRO PDP8I <CLA CLL IAC RTL; TAD (-4> SZA HLT /NOPE, GIVE UP BEG00A, TLS /SET PRINTER FLAG BEG001, JMS I (BEGCR JMS I (BEGCR JMS I (BEGPRT /"EDUCOMP EDU250 BASIC" BEGTED JMS I (BEGCR JMS I (BEGCR BEG002, JMS I (BEGPRT /"HOW MANY USERS?" BEGTUS JMS I (BEGKEY TAD (-"8-1 CLL CML TAD (-"0+"8+1 SNA SZL JMP BEG009 /INVALID RESPONSE DCA BEGUSR /NUMBER OF USERS JMS I (BEGCR TAD (BUF /START OF USER BUFFERS DCA BEGSWP TAD BEGUSR CIA DCA BEGTM1 BEG02A, DCA BEGORG TAD (100 /LENGTH OF USER TTY BUFFER TAD BEGSWP DCA BEGSWP TAD (SWPRL TAD BEGORG ISZ BEGTM1 JMP BEG02A TAD BEGSWP DCA BEGORG /START OF FIELD 1 CORE TAD (INTUDF DCA BEGTM1 BEG003, JMS I (BEGPRT /"ANY UNUSED TELETYPES?" BEGTTU JMS I (BEGYN JMP BEG005 /NO JMP BEG003 /INVALID RESPONSE JMS I (BEGPRT /"ENTER TWO DIGIT READER CODES FOLLOWED BY 00" BEGTTC JMS I (BEGCR BEG004, DCA BEGNUM /GET 2 DIGIT OCTAL NUMBER JMS I (BEGDG JMP BEG004 /INVALID RESPONSE JMS I (BEGDG JMP BEG004 JMS I (BEGCR TAD BEGNUM SNA JMP BEG005 /END OF LIST CLL RTL /CONVERT TO KCC RAL TAD (KCC-030 JMS BEG007 /ENTER IN LIST TAD BEGNUM CLL IAC RTL /CONVERT TO TCF RAL TAD (TCF-040 JMS BEG007 /ENTER IN LIST JMP BEG004 /GET NEXT READER CODE BEG005, JMS I (BEGPRT /"ANY OTHER UNUSED DEVICES?" BEGTDV JMS I (BEGYN JMP BEG008 /NO JMP BEG005 /INVALID RESPONSE JMS I (BEGPRT /"ENTER FOUR DIGIT CLEAR IOTS FOLLOWED BY 0000" BEGTDC JMS I (BEGCR BEG006, DCA BEGNUM /READ 4 DIGIT OCTAL NUMBER JMS I (BEGDG JMP BEG006 /INVALID RESPONSE JMS I (BEGDG JMP BEG006 JMS I (BEGDG JMP BEG006 JMS I (BEGDG JMP BEG006 JMS I (BEGCR TAD BEGNUM /GET CLEAR IOT SNA JMP BEG008 /END OF LIST JMS BEG007 /ENTER IOT IN LIST JMP BEG006 /GET ANOTHER IOT BEG007, 0 /ENTER CLEAR IOT IN LIST AT INTUDF DCA I BEGTM1 /PUT IT IN LIST ISZ BEGTM1 /NEXT SLOT TAD BEGTM1 /ROOM FOR MORE ENTRIES? TAD (-INTUDF&7600+200-177 SPA CLA JMP I BEG007 /YES JMS I (BEGPRT /NO, "LIST TERMINATED" BEGTLT JMS I (BEGCR BEG008, TAD (INTDON&177+5200 /JMP INTDON DCA I BEGTM1 /TERMINATE LIST WITH "JMP INTDON" JMP I (BEG17A /NOW DO USER TTY CODES BEG009, CLA JMS I (BEGPRT /"INVALID RESPONSE" BEGTIR JMS I (BEGCR JMP BEG002 BEG00B, BEG034 PAGE
/TTY CODES BEG17A, L7777 /CHECK IF 1 USER TAD BEGUSR SNA JMP I (BEG010 /1 USER, DON'T BOTHER HIM WITH TTY CODES CIA /PUT REMAINING COUNT IN BEGTM1 DCA BEGTM1 BEG017, JMS I (BEGPRT /"STANDARD TELETYPE CODES?" BEGTTS JMS I (BEGYN JMP BEG022 /NO JMP BEG017 /INVALID RESPONSE TAD (BEGIOT /SET UP STANDARD CODES DCA BEGXR1 TAD (40 DCA BEGTM2 BEG018, TAD BEGTM2 DCA I BEGXR1 ISZ BEGTM2 ISZ BEGTM2 ISZ BEGTM1 JMP BEG018 JMP I (BEG010 /NOW DO CORE PARTIONING BEG022, TAD (BEGIOT DCA BEGXR1 BEG023, JMS I (BEGPRT /"USER #" BEGTT1 TAD ("2-BEGIOT TAD BEGXR1 JMS I (BEGTTY JMS I (BEGPRT /" READER CODE (2 DIGITS)?" BEGTT2 DCA BEGNUM /READ READER CODE JMS I (BEGDG JMP BEG023 /INVALID ENTRY JMS I (BEGDG JMP BEG023 JMS I (BEGCR TAD BEGNUM DCA I BEGXR1 ISZ BEGTM1 JMP BEG023 JMP I (BEG010 /NOW DO CORE PARTITIONING PAGE
/CORE PARTITIONER BEG010, TAD (-30 /ZERO ALL USER'S ENTRIES DCA BEGTM1 TAD (BEGCU-1 DCA BEGXR1 DCA I BEGXR1 /CLEAR ENTRY ISZ BEGTM1 JMP .-2 TAD BEGUSR CIA DCA BEGXR1 TAD (7 BEG011, DCA BEGTM1 /CORE FIELD TAD BEGTM1 /CONVERT TO CDF CLL RTL RAL TAD (CDF DCA BEG012 BEG012, HLT L4000 /DOES THIS CORE FIELD EXIST? DCA I (BEGTM2 TAD I (BEGTM2 CDF 10 SMA CLA JMP BEG14A /IN FACT, NO JMS I (BEGPRT /"FIELD " BEGTF1 TAD ("0 TAD BEGTM1 JMS I (BEGTTY JMS I (BEGCR L7777 /CHECK IF FIELD 1 TAD BEGTM1 SNA CLA TAD BEGORG /START OF CORE IN FIELD 1 SNA /OTHERWISE CONEND IS START OF CORE TAD (CONEND DCA BEGTM2 /START OF CORE BEG013, JMS I (BEGPRT /"THERE ARE " BEGTF2 JMS I (BEGDO /PRINT BLOCKS LEFT IN DECIMAL JMS I (BEGPRT /" BLOCKS LEFT IN THIS FIELD" BEGTF3 JMS I (BEGCR BEG014, JMS I (BEGPRT /"YOUR ALLOCATION FOR USER #" BEGTF4 JMS I (BEGKEY TAD (-"1 SPA JMP BEG015 /INVALID RESPONSE DCA BEGTM4 /USER NUMBER TAD BEGUSR CIA TAD BEGTM4 SMA CLA JMP BEG015 /INVALID RESPONSE TAD BEGTM4 /BUILD POINTER TO USER'S ENTRIES CLL RAL TAD BEGTM4 TAD (BEGCU DCA BEGTM4 /POINTER TAD I BEGTM4 /THIS USER ALREADY DONE? SZA CLA JMP BEG015 /YES, INVALID RESPONSE JMS I (BEGPRT /" IS HOW MANY BLOCKS?" BEGTF5 JMS I (BEGDI /READ DECIMAL # SNA JMP BEG016 /BLOCK SIZES DON'T WORK CIA /COMPARE WITH BLOCKS LEFT TAD BEGTM3 SPA CLA JMP BEG016 /BLOCK SIZES DON'T WORK TAD BEG012 /GET CDF FOR THIS FIELD DCA I BEGTM4 /ENTER CDF ISZ BEGTM4 /NEXT ENTRY TAD BEGTM2 /GET START OF CORE DCA I BEGTM4 /ENTER IT ISZ BEGTM4 /NEXT ENTRY TAD BEGNUM /COMPUTE START OF CORE FOR NEXT SEGMENT CLL RTR RTR RAR TAD BEGTM2 TAD (377 AND (7400 DCA BEGTM2 L7777 /END OF CORE FOR THIS GUY TAD BEGTM2 DCA I BEGTM4 /MAKE ENTRY ISZ BEGXR1 /DONE ALL USERS? SKP /NO JMP I (BEG019 /YES, FINISHED WITH QUESTIONS BEG14B, TAD BEGTM2 /END OF FIELD? SZA CLA JMP BEG013 /NO BEG14A, L7777 /YES... DECREMENT CORE FIELD TAD BEGTM1 SZA /MORE CORE? JMP BEG011 /YES, DO THIS FIELD /NO, BLOCK SIZES DON'T WORK! BEG016, JMS I (BEGPRT /"BLOCK SIZES DON'T WORK -- HAVE TO START AGAIN" BEGTBS JMS I (BEGCR JMP BEG010 BEG015, CLA JMS I (BEGPRT /"INVALID RESPONSE" BEGTIR JMS I (BEGCR JMP BEG014 PAGE
BEG019, JMS I (BEGPRT /"IS THE ABOVE CORRECT?" BEGTOK JMS I (BEGYN JMP I (BEG001 /NO! ALL THIS IS WASTED! JMP BEG019 /INVALID RESPONSE BEG032, JMS I (BEGPRT /"START UP?" BEGTGO JMS I (BEGYN JMP BEG040 JMP BEG032 /SET UP OTHER VALUES BEG034, CDF 0 TAD (TAD BEGUSM-1 /SET USRM TAD BEGUSR DCA BEG20B BEG20B, HLT DCA I (USRM TAD I (USRM /SET MUSRCT CMA DCA I (MUSRCT TAD (SWPR0 /SET LISTS AT SWPR0 & BEGKIE DCA BEGTM1 TAD (BEGIOT-1 DCA BEGXR1 TAD (BEGKIE-1 DCA BEGXR2 TAD BEGUSR CIA DCA BEGTM2 L7777 TAD BEGSWP BEG020, DCA I BEGTM1 CDF 10 TAD I BEGXR1 CDF 0 CLL RTL RAL TAD (KIE-030 DCA I BEGXR2 TAD (SWPRL TAD I BEGTM1 ISZ BEGTM1 ISZ BEGTM2 JMP BEG020 CLA TAD (USER0-1 /SET USER0 THRU USER7 DCA BEGXR1 TAD BEGUSR CIA DCA BEGTM1 BEG021, DCA I BEGXR1 /THIS JOB IS RUNNABLE ISZ BEGTM1 JMP BEG021 CDF 10 TAD BEGUSR /SET MUSERS CIA DCA MUSERS TAD (USER0 /SET USRPT TAD BEGUSR DCA USRPT TAD USRPT /SET MUSRPT CIA DCA MUSRPT TAD (ENSWAP-STSWAP+1 /SET IOTST TAD BEGSWP DCA IOTST IFZERO PDP8I < TAD (BEGIOT-1 /GENERATE POWER FAIL TLS LIST DCA BEGXR1 TAD (BEGPFL-1 DCA BEGXR2 TAD BEGUSR CIA DCA BEGTM1 BEG21A, TAD I BEGXR1 CLL RTL RAL TAD (10+TLS-040 DCA I BEGXR2 ISZ BEGTM1 JMP BEG21A > JMP I (BEG34A BEG040, TAD (BEG00B&177+5600 /TAD (JMP I BEG00B DCA I (BEG00A /SO RESTART STARTS EDU250 CIF CDF 0 /NOW GO TO OS/8 JMP I (7600 BEGUSM, 0 1 3 3 7 7 7 7 PAGE BEG34A, TAD (-CONEND DCA BEGTM1 BEG035, CDF 10 TAD I (0 BEG036, CDF 20 DCA I (0 ISZ (0 ISZ BEGTM1 JMP BEG035 BEG037, DCA I (0 ISZ (0 JMP BEG037 TAD (10 TAD BEG036 DCA BEG036 ISZ BEG039 JMP BEG34A CDF 10 BEG038, TAD I (F0P37 /MOVE LAST PAGE OF FIELD 0 INTO PLACE CDF 0 DCA I (7600 CDF 10 ISZ (F0P37 ISZ (7600 JMP BEG038 /POINTERS TO SWAP REGION & ASSOCIATED DATA L7777 TAD BEGSWP DCA BEGXR1 TAD (BEGCU-1 DCA BEGXR2 TAD (BEGIOT DCA BEGTM1 TAD (BUF DCA BEGTM2 TAD BEGUSR CIA DCA BEGTM3 JMP I (BEG031 BEG039, -6 PAGE
/SET UP SWAP REGION BEG031, DCA I BEGXR1 /PDLXR DCA I BEGXR1 /AXIN DCA I BEGXR1 /AXOUT DCA I BEGXR1 /GTEM DCA I BEGXR1 /XCT TAD (READY DCA I BEGXR1 /PC DCA I BEGXR1 /ADD DCA I BEGXR1 /XCTIN DCA I BEGXR1 /PT1 DCA I BEGXR1 /CHAR DCA I BEGXR1 /LINEPC DCA I BEGXR1 /LINENO DCA I BEGXR1 /LASTLN DCA I BEGXR1 /SPACSW TAD I BEGXR2 /CDF TO USER'S FIELD DCA I BEGXR1 /XFIELD DCA I BEGXR1 /DATAPC DCA I BEGXR1 DCA I BEGXR1 DCA I BEGXR1 DCA I BEGXR1 DCA I BEGXR1 /PACKND TAD I BEGXR2 /START OF USER CORE DCA BEGTM4 TAD (LINE1 TAD BEGTM4 DCA I BEGXR1 /BUFR TAD (LINE1 TAD BEGTM4 DCA I BEGXR1 /LASTV TAD I BEGXR2 /END OF USER CORE DCA I BEGXR1 /PDLST TAD (LINE0 TAD BEGTM4 DCA I BEGXR1 /ALINE0 TAD BEGTM4 DCA I BEGXR1 /COMBUF DCA I BEGXR1 /ERLINE L0001 DCA I BEGXR1 /FRNDX TAD (203 DCA I BEGXR1 TAD (5555 DCA I BEGXR1 TAD (XREADC DCA I BEGXR1 /PREADC TAD (XPRNTC DCA I BEGXR1 /PPRNTC IFNZRO EDU250 < DCA I BEGXR1 /DEV TAD (1617 DCA I BEGXR1 /NAME TAD (1605 DCA I BEGXR1 DCA I BEGXR1 TAD (0201 DCA I BEGXR1 > TAD I BEGTM1 /READER CODE CLL RTL RAL TAD (KSF-030 DCA I BEGXR1 /KSF IOT DCA I BEGXR1 DCA I BEGXR1 TAD (37 DCA I BEGXR1 TAD BEGTM2 DCA I BEGXR1 DCA I BEGXR1 L7775 DCA I BEGXR1 L7775 DCA I BEGXR1 DCA I BEGXR1 DCA I BEGXR1 TAD I BEGTM1 ISZ BEGTM1 CLL IAC RTL RAL TAD (TSF-040 DCA I BEGXR1 /TSF IOT DCA I BEGXR1 TAD (-110 DCA I BEGXR1 TAD (37 DCA I BEGXR1 TAD (40 TAD BEGTM2 DCA I BEGXR1 DCA I BEGXR1 L7775 DCA I BEGXR1 L7775 DCA I BEGXR1 DCA I BEGXR1 DCA I BEGXR1 TAD (100 TAD BEGTM2 DCA BEGTM2 ISZ BEGTM3 JMP BEG031 JMP I (BEGCL1 /GO CLEAR FIELD 1 PAGE
BEGKEY, 0 KSF JMP .-1 KRB TAD (-203 SNA CLA JMP I (BEG001 KRB JMS BEGTTY KRB JMP I BEGKEY BEGTTY, 0 TSF JMP .-1 KSF TLS CLA JMP I BEGTTY BEGCR, 0 TAD (215 JMS BEGTTY TAD (212 JMS BEGTTY JMP I BEGCR BEGYN, 0 JMS BEGKEY TAD (-"N SNA JMP BEGYN2 ISZ BEGYN TAD (-"Y+"N SNA ISZ BEGYN SNA CLA JMP BEGYN2 JMS BEGPRT /"INVALID RESPONSE" BEGTIR BEGYN2, JMS BEGCR JMP I BEGYN BEGDG, 0 JMS BEGKEY TAD (-"7-1 CLL TAD (-"0+"7+1 DCA BEGTM5 SNL JMP BEGDG1 TAD BEGNUM CLL RTL RAL TAD BEGTM5 DCA BEGNUM ISZ BEGDG JMP I BEGDG BEGDG1, JMS BEGPRT BEGTIR JMS BEGCR JMP I BEGDG BEGPRT, 0 TAD I BEGPRT ISZ BEGPRT DCA BEGTM5 BEGP1, TAD I BEGTM5 RTR RTR RTR JMS BEGP2 TAD I BEGTM5 JMS BEGP2 ISZ BEGTM5 JMP BEGP1 BEGP2, 0 AND (77 SNA JMP I BEGPRT TAD (-40 SPA TAD (100 TAD (240 JMS BEGTTY JMP I BEGP2 BEGDI, 0 /DECIMAL INPUT BEGDI2, DCA BEGNUM JMS BEGKEY TAD (-215 SNA JMP BEGDI3 /CR TAD (-"9-1+215 CLL TAD (-"0+"9+1 DCA BEGTM5 SNL JMP I (BEG015 TAD BEGNUM CLL RTL TAD BEGNUM CLL RAL TAD BEGTM5 JMP BEGDI2 BEGDI3, JMS BEGCR TAD BEGNUM JMP I BEGDI PAGE
BEGDO, 0 /DECIMAL OUTPUT FROM BEGTM3 TAD BEGTM2 /START OF CORE CLL CMA IAC RTL /CONVERT WORDS LEFT TO BLOCKS LEFT RTL RAL AND (17 DCA BEGTM3 /BLOCKS LEFT TAD BEGTM3 DCA BEGNUM TAD (-12 TAD BEGNUM SPA JMP BEGDO2 DCA BEGNUM TAD ("1 JMS I (BEGTTY BEGDO2, CLA TAD ("0 TAD BEGNUM JMS I (BEGTTY JMP I BEGDO BEGIOT, 3 ZBLOCK 7 BEGCU, ZBLOCK 30 PAGE
BEGTED, IFZERO EDU250 <TEXT "EDUCOMP EDU200 BASIC V3.019"> IFNZRO EDU250 <TEXT "EDUCOMP EDU250 BASIC V3.019"> BEGTUS, TEXT "HOW MANY USERS?" BEGTTU, TEXT "ANY UNUSED TELETYPES?" BEGTTC, TEXT "ENTER TWO DIGIT READER CODES FOLLOWED BY 00:" BEGTDV, TEXT "ANY OTHER UNUSED DEVICES?" BEGTDC, TEXT "ENTER FOUR DIGIT CLEAR IOTS FOLLOWED BY 0000:" BEGTLT, TEXT "LIST TERMINATED" BEGTIR, TEXT "INVALID RESPONSE" BEGTF1, TEXT "FIELD " BEGTF2, TEXT "THERE ARE " BEGTF3, TEXT " BLOCKS LEFT IN THIS FIELD." BEGTF4, TEXT "YOUR ALLOCATION FOR USER #" BEGTF5, TEXT " IS HOW MANY BLOCKS?" BEGTBS, TEXT "BLOCK SIZES DON'T WORK -- HAVE TO START AGAIN" BEGTTS, TEXT "STANDARD TELETYPE CODES?" BEGTOK, TEXT "IS THE ABOVE CORRECT?" BEGTT1, TEXT "USER #" BEGTT2, TEXT " READER CODE (2 DIGITS)?" BEGTGO, TEXT "START UP?"



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