File: M2.PA of Disk: Disks/MyPDP/m8-blue-rka1-rkb1
(Source file text)
/M2.PA 1-MAY-80 /******************************************************** /********* C O R E A L L O C A T O R ************** /******************************************************** /HOLE FINDS THE FIRST HOLE IN CORE THAT FITS THE REQUEST. /FIRST LOOKS FOR FREE SPACE (0), THEN FOR RELEASED SPACE (POS.) /ENTER WITH AC=NUMBER OF PAGES REQUESTED. /CORMAP SHOULD END WITH -3;0 HOLCNT, 0 /COUNTER HOLLEN, 0 /MINUS REQUESTED LENGTH HOLMAX, 40 /+LENGTH LAST REJECTED REQUEST+1 HOLE, 0 SMA CIA /BE SURE TO GET -#PAGES DCA HOLLEN TAD HOLLEN TAD HOLMAX SPA SNA CLA JMP I HOLE /LARGER/EQUAL THEN LAST FAILING REQUEST /FIRST SCAN LOOKS FOR FREE SPACE TAD (ENDF00+177%200+CORMAP-1 DCA AUTO10 /SET UP THE POINTER HOLE1, TAD I AUTO10 /SEARCH FREE PAGE SZA CLA JMP HOLE1 TAD AUTO10 TAD (-MAPEND SMA CLA /END OF MAP ? JMP HOLE10 /YES TAD HOLLEN DCA HOLCNT JMP HOLE3 HOLE2, TAD I AUTO10 SZA CLA /END OF HOLE ? JMP HOLE1 /YES, MUST BE TO SMALL HOLE3, ISZ HOLCNT /HOLE LARGE ENOUGH ? JMP HOLE2 /NO, NOT YET HOLE7, TAD HOLLEN TAD AUTO10 IAC ISZ HOLE /NORMAL EXIT WITH START OF JMP I HOLE /HOLE IN AC /SECOND SCAN LOOKS FOR RELEASED CORE HOLE10, TAD (ENDF00+177%200+CORMAP-1 DCA AUTO10 /SET UP THE POINTER HOLE11, TAD I AUTO10 /SEARCH RELEASED PAGE SPA CLA JMP HOLE11 TAD AUTO10 TAD (-MAPEND SMA CLA /END OF MAP ? JMP HOLE20 /YES TAD HOLLEN DCA HOLCNT JMP HOLE13 HOLE12, TAD I AUTO10 SPA CLA /END OF HOLE ? JMP HOLE11 /YES, MUST BE TO SMALL HOLE13, ISZ HOLCNT /HOLE LARGE ENOUGH ? JMP HOLE12 /NO, NOT YET ACM1 TAD AUTO10 DCA AUTO11 /POINTS TO LAST PAGE OF HOLE TAD AUTO11 DCA AUTO12 TAD I AUTO11 /GET CODE FROM LAST PAGE OF ALLOCATED CORE CIA DCA HOLCNT /REMEMBER I.O. TO COMPARE WITH REST HOLE14, DCA I AUTO12 /ZERO OUT ALL CORE THAT TAD I AUTO11 /BELONGS TO A TASKS WHOSE IMAGE HAS BEEN TAD HOLCNT /SPOILED BY THIS ALLOCATION SNA CLA /STILL THE SAME ? JMP HOLE14 /YES CYCLE JMP HOLE7 /DONE, EXIT WITH START OF HOLE IN AC HOLE20, TAD HOLLEN /REMEMBER, CIA DCA HOLMAX /THIS IS TOO MUCH, CURRENTLY JMP I HOLE /ERROR RETURN /RELEASE OPTION. IF 'RELEASE' BIT SET, THE COREMAP ENTRY'S /OF THE CURRENT TASK ARE COMPLEMENTED AND 'ONDISK' IS SET. /IF SWPOUT, THE MAP IS CLEARED TO FORCE RELOADING. RELESE, 0 TAD FUNCTION SMA CLA /'RELEASE' ? JMP I RELESE /NO 'RELEASE' REQUESTED JMS I (MAPIND /GET INDEX IN CORMAP FOR CURTSK TAD M1 /TO SEE WHAT'S BENEATH US DCA AUTO12 JMS I (DISCON /DISCONNECT IF NECCESSARY JMS I (GETLEN DCA ZTEM1 /-NUMBER OF PAGES TAD FUNCTION RTR CLA /LINK HOLDS RELEASE/SWPOUT TAD I AUTO12 /IF PRECEEDING SLOT IS FREE, SNL SZA CLA /FORCE SWPOUT. TAD CURTSK CIA DCA AUTO11 /COMPLEMENT OF CURTSK OR ZERO RELES1, TAD AUTO11 DCA I AUTO12 ISZ ZTEM1 JMP RELES1 ISZ I CURTSK /SET 'ONDISK' JMS RELSUB /ACTIVATE COREQ WAITERS JMP I RELESE /RETURN FROM RELESE RELSUB, 0 /ACTIVATE WAITERS IN COREQ ROUTINE TAD CHEAD /COREWAITERS ? SNA / JMP RELSU2 /NO DCA I MTAIL /YES, HANG THEM IN MAINQ DCA CHEAD /CLEAR COREWAITERS Q TAD CTAIL / DCA MTAIL / TAD (CHEAD / DCA CTAIL / RELSU2, TAD (40 /LARGEST POSSIBLE HOLE DCA HOLMAX /SET TO MAXIMUM HOLE AVAILABLE+1 JMP I RELSUB /RETURN HLPCNT, 0 ///(IF NON-ZERO, HELP WAS CALLED) HELP, TAD M100 ///IF HERE, WE HAVE PROCESSED 4096 INTER- DCA HLPCNT ///RUPTS. WAIT FOR 1 SECOND (IO RUNDOWN), HELP1, ISZ HNGCNT ///THEN CAF AND TRY AGAIN. JMP HELP1 ///INNER LOOP SRQ ///INTERRUPT STILL PENDING ? JMP I ZFSTEXT ///THANK HEAVEN, IT'S GONE !!! ISZ HLPCNT ///OUTER LOOP JMP HELP1 /// CAF ///WOOOPY ! OUR LAST RESORT ... JMP I (.+200&7600 ///JUMP TO NEXT PAGE PAGE IFNZRO BGMAX < CDF 10 /MAKE SURE THAT THE MMU IS RELOADED DCA I (BJOB / CDF 0 / > IFDEF DK8EA <DK8EA+6001 / > IFDEF DK8EB <DK8EB+6003 / > IFDEF DK8EC <DK8EC+6001 / > IFDEF DKC8AA <AC0001 / 6135 / > IFDEF DK8EP < IFNDEF DK8EA <IFNDEF DK8EB <IFNDEF DK8EC <IFNDEF DKC8AA < TAD (-1750 / DK8EP+6003 / TAD (1750+5410 / DK8EP+6002 / >>>>> JMP I ZFSTEXT ///LETS TRY AGAIN MAPIND, 0 /COMPUTE MAPINDEX OF CURTSK ACM2 / TAD CURTSK DCA ZTEM1 /POINTER TO 'START ADDR' TAD I ZTEM1 AND C7600 CLL RAR BSW TAD (CORMAP-1 DCA ZTEM1 /POINTS IN COREMAP TAD I CURTSK /FETCH FIELD AND C70 CLL RTL TAD ZTEM1 JMP I MAPIND /AC POINTS TO FIRST WORD OF HOLE-1 /***************************************************** /****** S W A P L O G I C ********************** /***************************************************** SWPIN, JMS MAPIND /FETCH POINTER IN COREMAP IAC DCA ZTEM1 /GET TASK LENGTH: JMS GETLEN DCA ZTEM2 /-NUMBER OF PAGES /CORE IMAGE STILL O.K. ? TAD I ZTEM1 TAD CURTSK SZA CLA JMP SWP1 /NO ... /YES, CLAIM CORE AND START: JMS SETMAP AC7776 AND I CURTSK /CLEAR ONDISK DCA I CURTSK JMS I (CONNCT /PERFORM ANY CONNECTS AS NECCESSARY TAD I CURTSK / JMP I (START2 /SUBROUTINE SETMAP PUTS CURTSK IN COREMAP SETMAP, 0 TAD CURTSK DCA I ZTEM1 ISZ ZTEM1 ISZ ZTEM2 JMP SETMAP+1 JMP I SETMAP /GETLEN COMPUTES MINUS LENGTH OF TASK GETLEN, 0 TAD I CURTSK AND C3700 BSW CIA JMP I GETLEN /GET A BLOCKLET FROM FREECORE: SWP1, TAD FHEAD / SNA / JMP I (SWPER1 /POOL EMPTY, RESCHEDULE TASK IN MAINQ DCA ZTEM7 / TAD I FHEAD / DCA FHEAD / /SEARCH A HOLE IN CORE: TAD ZTEM2 /-LENGTH JMS I (HOLE / JMP I (SWPER2 /CORE IS FULL DCA ZTEM1 /POINTER TO FIRST SLOT TAD ZTEM1 DCA ZTEM3 JMS SETMAP /COMPUTE LOAD ADDRESS: TAD ZTEM3 TAD (-CORMAP AND C37 BSW CLL RAL / DCA ZTEM4 /NEW LOAD ADDRESS /COMPUTE RELOCATION FOR PC: ACM2 TAD CURTSK DCA ZTEM2 /POINTER TO 'SA' TAD I ZTEM2 AND C7600 CIA TAD ZTEM4 DCA ZTEM1 /RELOCATION DISTANCE /RELOCATE PC: AC0003 TAD CURTSK DCA ZTEM5 /POINTS TO PC TAD I ZTEM5 TAD ZTEM1 DCA I ZTEM5 /UPDATE 'SA' WITH LOAD ADDRESS: TAD ZTEM4 DCA I ZTEM2 /COMPUTE NEW FIELD: TAD ZTEM3 /POINTS IN CORMAP TAD (-CORMAP CLL RTR AND C70 DCA ZTEM3 /INSERT NEW FIELD IN TCB[4] TAD I CURTSK AND (7707 TAD ZTEM3 DCA I CURTSK /BUILD DISK REQUEST IN TASKS TCB: ACM3 TAD CURTSK DCA ZTEM3 /POINTS TO 'THREAD' TAD I CURTSK AND C3700 SNA CLA /DON'T ALLOW 4K TASKS ! JMS ALARM TAD I CURTSK AND (3770 /SET TO 'READ' DCA I ZTEM3 /BUILD TCB FOR FAKETSK TAD CURTSK DCA I ZTEM7 TAD C4 TAD ZTEM7 DCA CURTSK /HERE FAKETASK TAKES OVER DCA I CURTSK JMP I (.+200&7600 /JUMP TO NEXT PAGE PAGE /DO THE TRANSFER REQUEST NOW: TAD ZTEM3 /POINTS TO REQUEST RETRY, JMS MONITOR CALL "S^100+"Y&3777 JMP RETRY /DISK SEEMS BUSY DCA .+3 /AC IS DEV # FOR COMPLETION INT. JMS MONITOR WAIT 0 CDF 00 SZA CLA /ERRORS ? JMP SWPER3 /YES ! /KILL FAKETSK AND SET UP CURTSK TAD CURTSK TAD M4 DCA ZTEM1 TAD I ZTEM1 DCA CURTSK /CLEAR 'ONDISK': AC7776 AND I CURTSK DCA I CURTSK /CLEAR 'ONDISK' /RELOCATE THE NEW TASK TAD I CURTSK AND C70 /EXTRACT FIELD BITS TAD C6201 DCA RELCDF JMS I (GETLEN DCA ZTEM5 ACM2 TAD CURTSK DCA ZTEM2 TAD I ZTEM2 DCA ZTEM4 /ALL TASKS MUST BE ASSEMBLED TAD ZTEM4 /AT *200; HENCE SUBSTRACT 200 TAD M200 DCA ZTEM3 /RELOCATION DISTANCE RELCDF, HLT ISZ ZTEM4 /SKIP NAME TAD I ZTEM4 AND C77 /EXTRACT NUMBER OF CONNECTS SNA JMP SWP2 /NO CONNECTS /RELOCATE THE CONNECT-LABELS CIA DCA ZTEM7 /COUNTER SWP1A, ISZ ZTEM4 ISZ ZTEM4 /SKIP SLOT NUMBER TAD I ZTEM4 TAD ZTEM3 /RELOCATE CONNECT LABEL DCA I ZTEM4 ISZ ZTEM7 JMP SWP1A /LOOP /RELOCATE THE OTHER POINTERS SWP2, ISZ ZTEM4 TAD I ZTEM4 SNA JMP SWP3 /ALL RELOCATORS FINISHED TAD ZTEM3 DCA I ZTEM4 JMP SWP2 /REMEMBER CORRECT START ADDRESS SWP3, AC0001 TAD ZTEM4 DCA ZTEM6 /GOTO NEXT PAGE SWP4, TAD ZTEM4 TAD C200 AND C7600 DCA ZTEM4 ISZ ZTEM5 SKP JMP SWP6 SWP5, TAD I ZTEM4 SNA JMP SWP4 TAD ZTEM3 DCA I ZTEM4 ISZ ZTEM4 JMP SWP5 /UPDATE 'SA' SWP6, CDF 00 TAD ZTEM6 DCA I ZTEM2 /RELEASE BLOCKLET: TAD FHEAD / DCA I ZTEM1 / TAD ZTEM1 / DCA FHEAD / JMS I (CONNCT JMP I (START /AND GO !!! /NO ROOM IN CORE, SCHEDULE CURTSK IN COREQ: SWPER2, ACM3 TAD CURTSK DCA I CTAIL TAD I CTAIL DCA CTAIL DCA I CTAIL JMP SWPER4 /DISK TRANFER ERROR: KEEP TRYING SWPER3, JMS MONITOR STALL DGNTICK%2 CLA CLL TAD CURTSK TAD M4 JMS DEFER TAD M3 JMP RETRY /RELEASE BLOCKLET: SWPER4, TAD FHEAD / DCA I ZTEM7 / TAD ZTEM7 / DCA FHEAD / JMP I ZDISPATCH IFNZRO BGMAX < TICK, 0 /ROUTINE FOR BG ACCOUNTING CDF 10 TAD I (BJOB SNA /ANY BG EXECUTING ? JMP TICK1 /NO, QUIT JMS DEFER /GET HIS STATE AND (-LONG-1 / SZA CLA / JMP TICK1 / TAD I (BJOB /HE WAS REALY RUNNING TAD (UACCNT-1 /YES, MAKE POINTER TO HIS COUNTER DCA AUTO10 / ISZ I AUTO10 /BUMP LOWORDER COUNT JMP TICK1 / ISZ I AUTO10 /OVERFLOW, BUMP HIGHORDER COUNT NOP / TICK1, CDF 0 / JMP I TICK /RETURN > PAGE /******************************************************* /****** C O N N E C T - D I S C O N N E C T ****** /******************************************************* CONNCT, 0 JMS CONSET /SETUP CONGET JMP I CONNCT /NO CONNECTS, QUIT CON1, JMS CONGET //FETCH DEVICE NUMBER CLL RTL // TAD (INT+1 // DCA AUTO11 // TAD I ZMYCDIF //CDF CIF TASKFIELD CDF 00 IOF /// DCA I AUTO11 /// TAD AUTO11 /// TAD (CONTAB^4-INT-4 /// CLL RTR /// DCA ZTEM2 TAD ZTEM2 TAD (5400 ///MAKE JMP I Z ... DCA I AUTO11 JMS CONGET ///INTERRUPT ENTRYADDRES CDF 00 /// ION /// DCA I ZTEM2 /// ISZ ZTEM1 /MORE CONNECT'S ? JMP CON1 / JMP I CONNCT CONSET, 0 /SETUP FOR CONNCT AND DISCON TAD I CURTSK / AND C70 /EXTRACT FIELDBITS TAD C6201 DCA CONCDF ACM2 TAD CURTSK DCA ZTEM1 TAD I ZTEM1 /FETCH 'SA' AND C7600 DCA AUTO10 JMS CONGET //NUMBER OF CONNECT'S AND C77 // CIA // SZA //ANY CONNECTS AT ALL ? ISZ CONSET //YES, GO FOR SKIP-RETURN DCA ZTEM1 //SET COUNTER FOR # CONNECTS CDF 00 /SELECT FIELD 0 FOR NON-SKIP RETURN JMP I CONSET / DISTMP, CONGET, 0 /CHANGE DATAFIELD TO USERS FIELD AND /FETCH NEXT WORD FROM TASK IMAGE CONCDF, CDF // TAD I AUTO10 // JMP I CONGET // DISCON, 0 JMS CONSET JMP I DISCON /NOTHING TO DISCONNECT DIS1, JMS CONGET //FETCH DEVICE # TAD (CLRTAB-1 // DCA DISTMP //POINTS TO PROPER CLEAR IOT TAD DISTMP // TAD (-CLRTAB+1 // CLL RTL // TAD (INT+1 // DCA AUTO11 // CDF CIF 00 /// TAD I DISTMP ///FETCH CLEAR-IOT DCA I AUTO11 /// TAD (JMS I ZHRDINT ///RESTORE THIS INSTRUCTION DCA I AUTO11 /// ISZ AUTO10 ///SKIP INTERRUPT ENTRY ADDRESS ISZ ZTEM1 ///MORE TO DISCONNECT ? JMP DIS1 ///YES JMP I DISCON XLIST -LRESMOD-1&XLISTX BB, 0 /BB IS A SUBROUTINE OF 'TI' ISZ BBCNT /SHOULD WE RUN THIS TIME ? JMP I BB /NO, RETURN TAD (-DGNTICK /YES, RESET COUNTER DCA BBCNT / /SOME CODE TO REVIVE TTY'S WITH LOST ENABLE FLAGS: AC0001 6035 /SET INTERRUPT ENABLE OF CONSOLE TTY IFDEF KL8E2 <6005+KL8E2 /SET INTERRUPT ENABLE OF SECOND TTY> IFDEF KL8E3 <6005+KL8E3 /SET INETRRUPT ENABLE OF THIRD TTY> IFDEF KL8E4 <6005+KL8E4 /SET INTERRUPT ENAMLE OF FOURTH TTY> IFDEF KL8E5 <6005+KL8E5 /SET INTERRUPT ENABLE OF FIFTH TTY> IFDEF KL8E6 <6005+KL8E6 /SET INTERRUPT ENABLE OF SIXTH TTY> IFDEF KL8E7 <6005+KL8E7 /SET INETRRUPT ENABLE OF SEVENTH TTY> IFDEF KLPLOT <6005+KLPLOT-10 /ENABLE INTERRUPT OF ASYNC PLOTTER> IFDEF LE8E < IFZERO LE8E&401 <6665 /ENABLE LINEPRINTER INTERRUPTS> IFNZRO LE8E&400 <6655 /ENABLE LINEPRINTER INTERRUPTS> IFNZRO LE8E&001 <6575 /ENABLE LINEPRINTER INTERRUPTS>> CLA CLL IFDEF TC08 < /KEEP AN EYE ON THE DECTAPE UNITS! 6761 /READ STATUS A REGISTER TWICE IN 6761 /ORDER TO BE SURE (ENDZONE !) AND C200 /EXTRACT MOTION BIT SZA CLA /TC08 CONTOLER BUSY ? JMP TCEND /YES, SKIP THIS TIME TAD (TAPETB /NO, SETUP POINTER TO UNITS POSITION DCA ZTEM1 /TABLE AND A COUNTER FOR 8 UNITS TAD M10 DCA ZTEM2 TCLOOP, TAD ZTEM2 /USE COUNTER TO PRODUCE A UNIT # 0-7 RTR RTR AND C7000 /UNIT # 6766 /DTLA AND I 0 /SPENT SOME TIME AND I 0 6772 /DTRB: ERROR ? SPA CLA /SUPPOSE ERRORS MEANS SELECT ERROR DCA I ZTEM1 /SO WE RESET THIS UNITS POSITION 6764 /CLEAR ERROR FLAGS ISZ ZTEM1 /BUMP POINTER AND ISZ ZTEM2 /UNIT COUNTER. DONE ? JMP TCLOOP /NO TCEND, / > JMP I BB / BBCNT, -DGNTICK PAGE XLIST -LSYSDRV-1&XLISTX /THE SYSTEM DISK DRIVER TASK SYSMAX=10 /LENGTH OF SYSTEM DISK QUEUE SY, SNA //CLOSE ? JMP SYCLOSE // DCA SYSTEM //SAVE DTV POINTER AC0002 // TAD SYSTEM // DCA SYSTM //USE SYSTM FOR BLOCK # ACCESS RDF //SAVE DF BSW DCA SYFLD //SAVE FIELD TEMPORARILY IFDEF SYRL01 <IFZERO SYRL01-1&2 < AC0004 //DRIVES 2 AND 3 NOT ARE NOT AND I SYSTEM //IMPLEMENTED SZA CLA //TO SAVE SOME TABLE SPACE JMP SYEROR //SO DON'T TRY IT ! >> IFNDEF SYRX02 < /LENGTH CHECK SPOILS PIP DENSITY TEST ! /TEST IF THE TRANSFER IS WITHIN LIMITS: TAD I SYSTEM //GET FUNCTION WORD AND C3700 // SNA //4K TRANSFER ? AC4000 //YES BSW // CLL IAC RAR //ROUND UP TO BLOCKS TAD I SYSTM //ADD LENGTH OF TRANSFER TO STARTBLOCK CDF 0 /RESET DATAFIELD CLL /12-BIT NUMBERS! TAD (-SYLNGT-1 /COMPARE WITH DISK LENGTH SZL CLA /PAST END OF DISK ? JMP SYEROR /YES, FATAL ERROR > IFDEF SYRX02 < CDF 0 / > JMS MONITOR RESERV DCA SYSTM /SAVE SLOT# TAD SYFLD /MERGE FIELD WITH TAD SYSTM /WITH SLOT# SCENTR, DCA I SYSPUT /ENTRY-POINT FOR RLC HANDLER ISZ SYSPUT TAD SYSTEM /PUT POINTER IN Q TOO DCA I SYSPUT /EACH ENTRY IN SYSQ CONTAINS 2 WORDS: /WORD1: FFF.UUS.SSS.SSS /FIELD, DRIVE # AND EVENT # /WORD2: PPP.PPP.PPP.PPP /POINTER TO DISK TRANSFER VECTOR IFNDEF SYRX02 < SYS5, IOF /// TAD SYSCNT /// SNA ///IS DISKQ EMPT?Y? JMS I (SYSDO ///Y, START DISK TAD (SYSMAX-1 ///IS DISKQ FULL ? SPA CLA /// JMP SYSWAIT ///Y;WAIT A WHILE TAD SYSPUT /// IAC ///WRAPPING AROUND AND (-SYSMAX-1^2+1 /// DCA SYSPUT /// ACM1 /// TAD SYSCNT /// ION /// DCA SYSCNT /// > IFDEF SYRX02 < SYS5, TAD SYSCNT / SZA /IS DISKQ EMPT?Y? JMP SYS51 /NO, SZ ALREADY RUNNING JMS MONITOR / RUN "S^100+"Z&3777 NOP /SEEMS TO BE RUNNING SYS51, TAD (SYSMAX-1 /IS DISKQ FULL ? SPA CLA / JMP SYSWAIT /Y;WAIT A WHILE TAD SYSPUT / IAC /WRAPPING AROUND AND (-SYSMAX-1^2+1 / DCA SYSPUT / ACM1 / TAD SYSCNT / DCA SYSCNT / > IFDEF SYRL01 < JMS MONITOR /RESTART ME IN CASE OF RLC USE RESTRT "S^100+"Y&3777 HLT /CAN NEVER HAPPEN > TAD SYSTM /RETURN WITH SLOT# IN AC JMP SYEXIT SYEROR, ACM1 SYCLOSE,TAD M1 SYEXIT, JMS MONITOR EXIT / SYSWAIT,ION JMS MONITOR /WAIT ONE SYSTEM TICK STALL 1 CLA CLL JMP SYS5 /RETRY SYSPUT, SYSQ ///'PUT' POINTER SYSTEM, 0 /TEMPORARY STORAGE FOR DTV POINTER SYSTM, 0 /TEMP STORAGE FOR CURRENT SLOT# SYFLD, 0 /TEMP STORAGE FOR FIELD OF DTV SYSCNT, 0 ///COUNTER OF ELEMENTS IN SYSQ IFNDEF SYRX02 < IFNDEF SYRL01 < /INTERRUPT PART OF DISK SYSTEM DRIVER /THE PROGRAM ALLOWS FOR 3 CONSECUTIVE ERRONEOUS DISK- /TRANSFERS, THEN ISSUES AN ERROR. /IT FETCHES THE NEXT TRANSFER FROM THE DISKQ AND CAUSES /A 'SOFT' INTERRUPT AT THE SLOT FOR THE CALLING TASK. IFDEF SYRK8E < DSKP=6741 /SKIP ON DONE OR ERROR FLAG DCLR=6742 /DISK CLEAR DLAG=6743 /LOAD DISK ADDRESS AND GO ! DLCA=6744 /LOAD CURRENT ADDRESS DRST=6745 /READ STATUS DLDC=6746 /LOAD COMMAND / DMAN=6747 (MAINTENANCE INSTRUCTION) > IFDEF SY3010 <SYSI=1 /FOR COMMON CODE > IFDEF SY3040 <SYSI=1 /FOR COMMON CODE > IFDEF SYSI < /EQUATES FOR SYSTEM INDUSTRIES CONTROLER DSDD=6501 /SKIP ON DONE DLCR=DSDD+1 /LOAD CONTROL REGISTER DRCR=DLCR+1 /READ CONTROL REGISTER DCSR=DRCR+1 /CLEAR STUTUS REGISTER DRSR=DCSR+1 /READ STATUS REGISTER DLSS=DRSR+1 /LOAD SEEK ADDRESS AND SEEK DRSS=DLSS+1 /READ SEEK STATUS REGISTER DSDE=DRSS+2 /SKIP ON DISK ERROR DLSR=DSDE+1 /LOAD SECTOR REGISTER DSRR=DLSR+1 /READ SECTOR REGISTER DLTR=DSRR+1 /LOAD TRACK ADDRES AND READ DLTW=DLTR+1 /LOAD TRACK ADDRESS AND WRITE DRTR=DLTW+1 /READ TRACK ADDRESS REGISTER DWCA=DRTR+1 /INITAIATE WC/CA SEQUENCE > IFDEF SYRK08 < DLDC=6732 DLCA=6755 DLWC=6753 DLDR=6733 DSKD=6745 DSKE=6747 DCLS=6742 DRDS=6741 DRDA=6734 DCLA=6751 / > JMS I (SYSDO ///INITIATE NEXT TRANSFER SYSIN0, JMS SYSWAT ///GET COMPLETION INTERRUPT IFDEF RFORDF < 6616 ///READ STATUS AND (5 ///LOOK FOR SERIOUS ERRORS SNA CLA /// JMP SYS10 ///IGNORE NXD-ERRORS 6616 ///READ STATUS AGAIN DCA ERSTAT ///AND STORE FOR ANALISYS > IFDEF SYRK8E< DRST ///READ STATUS CLL RAL ///BIT 0 MUST BE 1, OTHERS ZERO SZA ///RIGHT ? JMP SYSERR ///NO, WHAT A PITY TAD I (SYSDO-1 ///YES, FAST CONTINUE SNA ///LAST TRANSFER ? JMP SYS10 ///YES, TRY NEXT IN QUEUE JMS I (SYNXCT ///QUICKLY INITIATE NEXT TRANSFER ///AND COMPUTE THE ONE AFTER THAT JMP SYSIN0 ///WAIT FOR NEXT INTERRUPT SYSERR, RAR ///RESTORE DCA ERSTAT ///AND STORE FOR ANALISYS SYSER1, DRST /// AND (0401 ///GET IMPORTANT ERROR BITS SNA CLA ///SERIOUS ERROR ? JMP SYNSER ///NO, TRY AGAIN DCLR ///YES, RECALIBRATE AC0002 DCLR ///RECALIBRATE JMS SYSWAT ///WAIT FOR COMMAND ACCEPTED STL IAC RTL ///6 IN AC AND I (SYFUNC ///GET DRIVE # TAD (600 ///INTERRUPT ON SEEK DONE DLDC JMS SYSWAT ///WAIT TILL SEEK COMPLETED JMP SYSER1 ///OK NOW ? SYNSER, > IFDEF SYSI < DSDE ///DISK ERROR ? JMP SYS10 ///NO, PROCEED DRSR ///READ STATUS REGISTER DCA ERSTAT ///AND STORE FOR ANALYSIS > IFDEF SYRK08 < DSKE ///ERROR FLAG UP ? JMP SYS10 ///NO, DONE DRDS ///YES, SEE WHATS UP AND C4 ///LETS HOPE FOR TRACK OVERFLOW SNA CLA ///IS IT ? JMP SYSER ///IT'S NOT... TAD I (SYSRW ///GET THE READ OR WRITE INSTRUCTION DCA SYSRW1 /// DCLS ///CLEAR THE STATUS REGISTER DRDA ///READ THE TRACK ADDRESS AND (7760 ///AND COMPUTE THE NEW TAD (20 ///TRACK ADDRESS SYSRW1, HLT ///READ OR WRITE JMP SYSIN0 ///AND WAIT FOR EVENT TO COME SYSER, DRDS ///SERIOUS ERROR,RECORD IT DCA ERSTAT /// > ISZ ERRLOG ///ACCOUNT THIS ERROR ISZ SYERCNT ///Y;3RD CONSEC. ERROR? JMP SYSIN0-1 ///N;TRY AGAIN TAD (HRDERR ///ERROR CODE /AT THIS POINT A DISK TRANSFER HAS DEFINITELY TERMINATED SYS10, DCA SYSTAT ///COMPLETION STATUS ACM3 ///RESET THE ERRORCOUNTER DCA SYERCNT /// AC0002 /// TAD I (SYSGET ///INCREMENT THE POINTER AND (-SYSMAX-1^2+1/// DCA I (SYSGET /// TAD SYSLOT ///GO GIVE COMPLETION TO USER JMS SYSWAT ///WILL RETURN SOON, FLAG STILL UP ISZ SYSCNT ///SKIP IF QUE EMPTY JMP SYSIN0-1 ///INITIATE NEXT TRANSFER SYIGNR, IFDEF RFORDF <6601> IFDEF SYRK8E <DCLR> IFDEF SYSI < DCSR ///CLEAR STATUS AND DLCR ///CONTROL REGISTER > IFDEF SYRK08 < DCLA ///CLEAR ALL > JMS SYSWAT ///IGNORE EXCESSIVE INTERRUPTS JMP SYIGNR SYSWAT, SYIGNR ///COROUTINE, INITIAL INTERRUPT ENTRY SNA ///MUST GIVE SOFINT ? JMP I ZFSTEXT ///NO, QUICK RETURN JMS I ZSOFINT ///YES, AC IS DEVICE NUMBER SYSTAT, 0 ///COMPLETION STATUS SYSINT, /// HERE GOES THE INTERRUPT !!! IFDEF SYRF08 <6641 ///CLEAR HIGHORDER DISK ADDRESS > JMP I SYSWAT ///GOT NEXT INTERRUPT SYERCNT,-3 ///ERROR COUNTER SYSLOT, 0 ///CURRENT SLOT# ERRLOG, 0 ///TOTAL DISK ERRORS ERSTAT, 0 ///LAST ERROR STATUS PAGE /SET UP ALL DISK REGISTERS AND INITIALIZE THE TRANSFER. /THE PROGRAM DECODES THE DISKTRANSFERVECTOR: /WORD1: RLL.LLL.FFF.UUU /READ/WRITE;LENGTH AND FIELD /WORD2: STARTING ADDRESS IN CORE /WORD3: BLOCK NUMBER ON DISK /THE ROUTINE IS SHARED BY THE INTERRUPT PART OF THE DISK /DRIVER,BUT NEEDS NOT BE ENTERED WITH 'IOF'. THE DISK BUSY /FLAG PREVENTS CONCURRENT USE. 0 /TEMPORARY SYSDO, 0 TAD (SYSIN0+1 DCA I (SYSWAT /FROM NOW ON DON'T IGNORE INTRP TAD I SYSGET /FETCH CORRECT CDF BSW AND C70 TAD C6201 DCA SYSCDF TAD I SYSGET /REPLACE SLOT# AND C177 DCA I (SYSLOT /NOW LEAVE THE POINTER WHERE IT IS BUT FETCH NEXT ITEM TAD SYSGET IAC DCA SYSDO-1 TAD I SYSDO-1 DCA SYSDTV SYSCDF, HLT //HERE COMES THE CORRECT CDF TAD I SYSDTV IFDEF RFORDF < SPA CLA //READ OR WRITE? AC0002 //6603 OR 6605 ? TAD (6603 //READ=6603;WRITE=6605 DCA SYSRW TAD I SYSDTV //ISOLATE FIELD AND C70 IFDEF SYDF32 < DCA SYSDO-1 //AND SAVE FOR LATER > IFDEF SYRF08 < TAD (RFINTS //COMPLETION AND ERROR INT. ENABLED 6615 //ALSO CLEARS AC > TAD I SYSDTV //# OF PAGES IN BITS 1-5 CLL RAL //MAKE WORDCOUNT AND C7600 CIA DCA SYSWC ISZ SYSDTV ACM1 //CURRENT ADDRESS=BUF ADDR.-1 TAD I SYSDTV DCA SYSCA ISZ SYSDTV //HIGH ORDER ADDRESS=BLOCK#/16 TAD I SYSDTV IFDEF SYRF08 < CLL RTR RTR // > IFDEF SYDF32 < CLL RTL AND C3700 TAD SYSDO-1 //0AA.AAA.FFF.000;EXT.ADDR. AND FLD 6615 //THIS DOES NOT CLEAR THE AC CLA TAD I SYSDTV // > DCA SYSDO-1 //SAVE TEMP CDF 00 TAD SYSWC DCA I (7750 TAD SYSCA DCA I (7751 TAD SYSDO-1 /LOAD TEMP IFDEF SYRF08 < 6643 TAD SYSDO-1 /L AND 3 BITS GIVE LOW ORDER ADDR. AND C7000 RAR / > IFDEF SYDF32 < RTR RTR RAR /MAKE DISK ADDRESS AND C7400 / > SYSRW, 0 /OVERLAID BY READ OR WRITE INSTR JMP I SYSDO /END OF RFORDF > IFDEF SYRK8E < AND (4076 //MASK WRITE+FIELD+UNIT TAD (0400 //INTR. ENABLE DCA SYFUNC TAD I SYSDTV AND C3700 //# OF PAGES SNA AC4000 BSW //MINUS NUMBER OF PAGES CIA DCA SYSWC TAD I SYSDTV RAR //ROTATE UNIT TO LINK CLA ISZ SYSDTV TAD I SYSDTV //CORE BUFFER ADDRESS DLCA ISZ SYSDTV SZL CLA TAD (6260 //B SIDE HAS OFFSET CLL TAD I SYSDTV //FETCH CALLERS BLOCK # CDF 0 DCA SYSSB /THIS IS THE LOW ORDER START BLOCK SZL /IF NO OVERFLOW, ISZ SYFUNC /SET H.O.CYLINDER ADDRESS TAD SYFUNC JMS SYNXCT /INITIATE TRANSFER AND COMPUTE NEXT FUNCT. JMP I SYSDO /INITIALIZE THE TRANSFER AND COMPUTE THE FUNCTION REGISTER /FOR THE NEXT TRANSFER. SYNXCT, 0 ISZ SYSWC /THIS SKIPS IF ONLY ONE PAGE TO GO SKP TAD C100 /SET THE HALF SECTOR BIT DLDC /LOAD FUNCTION WORD REGISTER TAD SYSSB /LOAD BLOCK # DLAG /GO... ISZ SYSWC /IS THIS THE END ? TAD SYSWC /OR PAST THE END ? SMA CLA JMP SYLAST /YES, WE ARE TROUGH ! ISZ SYSSB /INCREMENT BLOCK # JMP .+3 / ISZ SYFUNC /CARRY GOES TO FUNCTION WORD JMP .+5 /THIS CERTAINLY IS A NEW CYLINDER TAD SYSSB /TEST IF STARTBLOCK AND C37 /IS FIRST BLOCK OF NEW CYLINDER SZA CLA /IN THAT CASE WE SHOULD TEST HEADER INFO TAD (1000 /SET THE 'ALL' BIT TAD SYFUNC SYLAST, DCA SYSDO-1 /NEW FUNCTION WORD FOR NEXT TRANSFER JMP I SYNXCT SYSSB, 0 /STARTING BLOCK SYFUNC, 0 > /FUNCTION WORD IFDEF SYSI < SPA CLA ///READ OR WRITE ? AC0001 /// TAD (DLTR ///MAKE READ OR WRITE INSTRUCTION DCA SYSRW ///AND PUT IT AHEAD DCSR ///CLEAR STATUS REGISTER DLCR ///SETUP CONTROL REGISTER FOR WC/CA CLA ///IS THIS REALY NECCESAIRY TAD I SYSDTV ///GET FUNCTION WORD AGAIN CLL RAL ///# OF WORDS IN BITS 1-4 AND C7600 ///MASK OFF GARBADGE IFDEF SY3010 < SNA ///4K ? ACM1 ///DO 4095 WORDS (SORRY) > DCA SYSWC /// TAD I SYSDTV ///THE FUNCTION WORD AGAIN AND C70 ///EXTRACT BUFFER FIELD IAC BSW ///MAKE F.1.0.0 DCA SYSCTR ///CONTROL REGISTER FOR TANSFER TAD I SYSDTV ///FUNCTION WORD IFDEF SY3010 < AND (6 ///GET DRIVE NUMBER CLL RTR RTR ///DD0.000.000.000 DCA SYSDRV ///STORE DRIVE NUMBER FOR LATER > IFDEF SY3040 < AND C4 ///DRIVE 0 OR 1 ? CLL RAL ///GET UNIT BIT TAD SYSCTR ///MERGE IN CONTROL WORD DCA SYSCTR /// > TAD I SYSDTV /// IFDEF SY3010 < CLL RAR /L/ A/B BIT TO LINK CLA /L/ > IFDEF SY3040 < CLL RTR /// SPA CLA ///EVEN OR ODD ? TAD (1460 ///OFFSET FOR ONE UNIT=314 RTR ///ROTATE IN UNIT 2000 AND MAKE 314 DCA SYSDRV /// > ISZ SYSDTV /L/BUMP POINTER TO BUFFER ADDRESS TAD I SYSDTV /L/ DCA SYSCA /L/STORE CURRENT ADDRESS TAD (SYSWC /L/ DWCA /L/INITIATE WC/CA SEQUENCE CLA /L/IS THIS REALY NECESARRY ? ISZ SYSDTV /L/BUMP POINTER TO BLOCK NUMBER TAD I SYSDTV /L/ AND C17 /L/EXTRACT SECTOR NUMBER (256 WRD SECTORS!) DLSR /L/LOAD SECTOR REGISTER CLA /L/IS THIS REALY NECCESARY TAD SYSCTR /L/GET CONTROL REGISTER FOR TRANSFER /L/(I HOPE THE WC/CA SEQ. IS FINISHED NOW ) DLCR /L/LOAD CONTROL REGISTER CLA /L/(EMA+INT ENABLE+UNIT) TAD I SYSDTV /L/GET BLOCK NUMBER AGAIN IFDEF SY3010 < RAR ///SIGN-BIT IS A/B NOW ! AND C7770 /// SPA /// TAD (7130 ///B-SIDE HAS OFFSET OF 6260 BLOCKS CLL RTR /// MAKE TRACK ADDRESS RAR ///IN BITS 3-11 > IFDEF SY3040 < CLL RTR /// RTR /// AND (377 ///TRACK ADDRESS > TAD SYSDRV ///ADD DRIVE NUMBER IN BITS 0-1 SYSRW, HLT ///'READ-OR WRITE INSTRUCTION CLA ///IS THIS REALY NECESARY ? CDF 0 ///RESTORE DATAFIELD JMP I SYSDO ///RETURN ! SYSDRV, 0 /HOLDS DRIVE NUMBER IN BITS 0-1 SYSCTR, 0 /HOLD CONTROL REGISTER > IFDEF SYRK08 < CLL RAL ///UNIT # AND C7 /// DCA SYSDO-1 /// TAD I SYSDTV ///GET FUNCTION WORD AGAIN AND C70 ///EXTRACT FIELD BITS TAD SYSDO-1 ///ADD UNIT BITS TAD (6000 ///ADD DONE ENABLE DLDC ///AND LOAD COMMAND WORD TAD I SYSDTV ///FINALLY WE WANT TO HAVE RAL ///THE READ/WRITE BIT AND THE AND C7600 ///TRANSFER LENGTH SZA ///(DON'T SPOIL THE LINK) CIA ///MAKE NEGATIVE WORD COUNT DLWC ///AND LOAD THAT IN THE CONTROL RTL ///NOW COMPUTE A READ OR WRITE TAD (DLDR ///INSTRUCTION DCA SYSRW ///AND STORE IT AHEAD ISZ SYSDTV ///BUMP ACCESS POINTER ACM1 ///CURRENT ADDRESS MUST BE ONE DOWN TAD I SYSDTV /// DLCA /// ISZ SYSDTV ///NOW ACCESS BLOCK NUMBER TAD I SYSDTV /// SYSRW, HLT ///BY THIS TIME IT'S DLDR OR DLDW CDF 0 ///RESET DATAFIELD JMP I SYSDO ///THAT'S IT > IFDEF RFORDF < SYSCA, 0 > /CURRENT ADDRES SYSWC, 0 /WORDCOUNT IFDEF SYSI < SYSCA, 0 /MUST FOLLOW SYSWC IMMEDIATLY !!!! > SYSGET, SYSQ ///'GET'POINTER IN SYSQ SYSDTV, 0 /PTR TO DISK TRANSFER VECTOR /END IFNDEF SYRL01 > IFDEF SYRL01 < /INTERRUPT PART OF DISK SYSTEM DRIVER /THE PROGRAM ALLOWS FOR 3 CONSECUTIVE ERRONEOUS DISK- /TRANSFERS, THEN ISSUES AN ERROR. /IT FETCHES THE NEXT TRANSFER FROM THE DISKQ AND CAUSES /A 'SOFT' INTERRUPT AT THE SLOT FOR THE CALLING TASK. RLDC=6600 /CLEAR DEVICE RLSD=RLDC+1 /SKIP IF DONE AND CLEAR DONE RLMA=RLSD+1 /LOAD MEMORY ADDRESS REGISTER RLCA=RLMA+1 /LOAD REGISTER A (SEEK DIFF. REG.) RLCB=RLCA+1 /LOAD REGISTER B RLSA=RLCB+1 /LOAD SECTOR ADDRESS FROM AC0-5 RLWC=RLSA+2 /LOAD WORD COUNT REG RRER=RLDC+10 /READ ERROR REGISTER RRWC=RRER+1 /READ WORD COUNT REGISTER RRCA=RRWC+1 /READ REGISTER A RRCB=RRCA+1 /READ REGISTER B RRSA=RRCB+1 /READ SECTOR ADDRESS RRSI=RRSA+1 /READ SILO BYTE IN AC4-11 RLSE=RRSI+2 /SKIP IF ANY ERROR /REGISTER A: DH0/0CC/CCC/CCC/ D=MOVE TO HIGHER CYL. ADDR. / H=SET LOWER HEAD / C=8-BIT CYL. ADDR. DIFFERENCE / /REGISTER B: 0M8/IDD/EMA/FUN/ M=MAINTENANCE / 8=BYTE MODE / I=INTENA / D=DRIVE / FUN: 0: MAINTENANCE 1: CONTR RESET 2: READ STATUS 3: DIFF. SEEK / 4: READ HEADER 5: WRITE DATA 6: READ DATA 7:READ WO HEAD / /REGISTER ERR: CI0/000/000/0DR/ C=CRC ERROR / I=OPERATION INCOMPLETE / D=DRIVE ERROR / R=DRIVE READY IO, 0 ///INTERRUPT SERVICE ROUTINE TAD I (DRIVE /// RLCB ///LOAD FUNCTION SYIGNR, JMP I ZFSTEXT ///WAIT FOR NEXT INTERRUPT SYSINT, ERRSKP, NOP ///NOP OR RLSE JMP I IO /// RRER ///READ ERROR DCA ERSTAT ///SAVE FOR DEBUG ISZ ERRLOG ///COUNT THEM ISZ TRYCNT /// JMP I (SYRTRY ///TRY AGAIN AC0004 ///(HRDERR) PASS FATAL ERROR DONE, DCA SYSTAT ///COMPLETION STATUS TAD (DONACK ///PULL BACK ADRESS AFTER SOFINT DCA IO /// TAD I (DRIVE ///GET DRIVE NUMBER IAC ///FUNCTION DRIVE RESET RLCB ///LEAVE INTERRUPT ON FOR 'DONACK' DCA ERRSKP ///DISABLE ERROR CHECK AS WELL AC0002 ///BUMP QUEUE POINTERS TAD I (SYSGET /// AND (-SYSMAX-1^2+1 /// DCA I (SYSGET /// TAD SYSLOT ///PASS COMPLETION STATUS TO CALLER JMS I ZSOFINT /// SYSTAT, 0 ///COMPLETION STATUS DONACK, TAD (SYIGNR ///SET IGNORE RETURN IF END OF QUEUE DCA IO ISZ SYSCNT ///UPDATE QUEUE COUNTER, QUEUE EMPTY ? JMS I (SYSDO ///NO, START NEXT REQUEST JMP I ZFSTEXT ///RETURN IF QUEUE EMPTY SYSIN0, TAD (RLSE ///FIRST RESTORE ERROR CHECKING DCA ERRSKP /// RRSI ///READ FIRST STATUS BYTE BSW ///EXTRACT COVER OPEN BIT SPA ///IS THE COVER OPEN INDEED ? JMP I (INVBBL ///YES, WE CERTAINLY WANT A FRESH BBL(AC#0) RRSI ///GET SECOND STATUS BYTE AND (377-40 ///TEST ALL BUT WRITE LOCK JMP I (INVBBL ///YES, GO INVALIDATE BBL IF AC NON-ZERO SYSLOT, 0 TRYCNT, 0 ERRLOG, 0 ERSTAT, 0 PAGE SYSDO, 0 ///ROUTINE TO START A TRANSFER TAD (SYSIN0 ///INITIALIZE THE COROUTINE DCA I (IO /// TAD I SYSGET ///GET FIELD OF NEW REQUEST BSW /// AND C70 ///MAKE A CDF TAD C6201 /// DCA SYSCDF ///CDF TO REQUEST PARAMETERS TAD I SYSGET ///GET EVENT NUMBER AND C177 /// DCA I (SYSLOT ///FOR COMPLETION SIGNALING TAD I SYSGET ///GET 'C' UNIT AND C200 /// SZA CLA /// AC0006 ///SET PART OF OFFSET DCA ABC ///AND INHIBIT A&B UNITS TAD SYSGET /// DCA AUTO13 ///POINTER TO POINTER TO REQUEST TAD I AUTO13 /// DCA SYSDTV /// SYSCDF, CDF /\/ TAD I SYSDTV /\/GET FUNCTION WORD DCA TEMSYS /\/STORE FOR LATER TAD TEMSYS /\/ AND C7 /\/EXTRACT UNIT BITS CLL RAR /\/DRIVE+A/B IN LINK BSW /\/GET DRIVE # IN AC 4-5 TAD (0400 /\/ADD INTERRUPT ENABLE BIT DCA DRIVE /\/THAT'S THE DRIVE WORD TAD ABC /\/IS IT UNIT 'C'? SNA /\/IF NOT 'C' TEST FOR A/B SZL /\/TEST A/B BIT IN LINK TAD (6 /\/EITHER UNIT B OR C(AC=14) DCA ABC /\/AND SET A/B/C FLAG AC4000 /\/ TAD TEMSYS /\/READ/WRITE TO LINK AND C70 /\/EXTRACT FIELD BITS SZL /\/WRITE ? TAD M1 /\/MAKE WRITE FUNCTION (=5) TAD (6 /\/MAKE 6/5 FOR READ/WRITE DCA IOFN /\/ TAD TEMSYS /\/NOW FOR THE TRANSFER LENGTH AND C3700 /\/EXTRACT LENGTH BITS SNA /\/4K ? AC4000 /\/ BSW /\/ CIA /\/ DCA IOPGCT /\/MINUS NUMBER OF PAGES ISZ SYSDTV /\/BUMP POINTER TO BUFFER ADDRESS TAD I SYSDTV /\/ DCA IOMA /\/ ISZ SYSDTV /\/BUMP POINTER TO BLOCK # TAD I SYSDTV /\/ CDF 0 ///RESTORE DATAFIELD DCA I (BLOCK /// AC0006 ///GET DRIVE BITS AND TEMSYS ///TO COMPUTE INDEX IN DRVTAB TAD (DRVTAB /// DCA I (CURTRK ///POINTER TO CURRENT TRACK ON DRIVE N TAD I (CURTRK /// DCA AUTO13 ///MAKE POINTER TO BBL POINTER LIST TAD I AUTO13 /// DCA I (BBLID /// TAD ABC ///ABC OFFSET IN ACBLST TAD (ABCLST ///MAKE POINTER TO ABCLST DCA TEMSYS /// TAD (BBLID ///SETUP TRANSFER OF BBL PARAMS #0 DCA AUTO13 /// AC0006 ///SETUP FOR BBL READ DCA I AUTO13 ///BSETUP #1: FN TAD I TEMSYS ///GET TRACK OFFSET FROM ABCLST ISZ TEMSYS ///MOVE TO NEXT IN ABCLST DCA I AUTO13 ///BSETUP #2: OFFSET TAD I TEMSYS ///GET WC FOR BBL READ ISZ TEMSYS DCA I AUTO13 ///BSETUP #3: STORE AS TENTATIVE WC TAD I TEMSYS ///GET SECTOR FOR BBL READ ISZ TEMSYS /// DCA I AUTO13 ///BSETUP #4: SECTOR DCA I AUTO13 ///BSETUP #5: TRCK (BBL'S ARE ON TRACK 0) TAD I TEMSYS ///GET BBL OFFSET ISZ TEMSYS /// TAD I (BBLID /// DCA I AUTO13 ///BSETUP #6: MA (CA FOR BBLREAD) TAD I TEMSYS ///GET MAPPING ROUTINE ADDRESS ISZ TEMSYS /// DCA I AUTO13 ///BSETUP #7: MAPPED TAD I TEMSYS ///GET OFFSET FOR RUNNING BBL POINTER TAD I (BBLID /// DCA I AUTO13 ///BSETUP #8: MAPPTR DCA I AUTO13 ///BSETUP #9: PGCT RAWGO, DCA I (ERRSKP ///DISABLE ERROR CHECKING ON STATUS READ RLSA ///ZERO SECTOR ADDRESS RLCA ///CLEAR A REGISTER TAD (1002 ///READ STATUS IN BYTE MODE TAD DRIVE ///ADD DRIVE AND INTERRUPT ENABLE RLCB ///START FUNCTION JMP I SYSDO ///END OF SYSDO ROUTINE TEMSYS, 0 SYSGET, SYSQ SYSDTV, 0 ABC, 0 IOFN, 0 IOPGCT, 0 IOMA, 0 DRIVE, 0 PAGE INVBBL, SNA CLA ///TROUBLE ? JMP CHKBBL ///NO, DRIVE IS OK DCA I BBLID ///YES, INVALIDATE BBL TAD BBLID ///FOR UNITS A/B AND TAD (41 /// DCA BBLID ///FOR UNIT C AS WELL DCA I BBLID /// CHKBBL, TAD MA /// DCA BBLID ///USE MA TO LOCATE CHECK WORD TAD I BBLID ///GET TEST WORD TAD (-123 ///COMPARE TO ID SZA ///SKIP IF OK JMS TRANS ///WRONG BBL, READ A FRESH ONE OKBBL, TAD I (IOMA ///COPY USER PARAMETERS TO DCA MA ///ACTUAL PARAMETERS TAD M200 /// DCA WC /// TAD I (IOFN /// DCA FN /// TAD I (IOPGCT /// DCA PGCT /// MAPLOP, TAD I MAPPTR ///LOOK AT NEXT BBL ENTRY SNA ///END OF LIST ? JMP I MAPPED ///YES, PROCEED STL CIA ///NO, COMPARE WITH CURRENT BLOCK TAD BLOCK /// SZL CLA ///SKIP IF BLOCK LT BBL ENTRY JMP I MAPPED ///W'RE THROUGH ISZ MAPPTR ///BUMP MAP POINTER NXTBLK, ISZ BLOCK ///SHIFT BLOCK PAST BAD BLOCK JMP MAPLOP ///AND GO AROUND AGAIN HLT ///OVERFLOW IS CERTAINLY AN ERROR ! DOTRAN, TAD OFFSET ///ADD TRACK OFFSET DCA TRCK ///PHYSICAL TRCK JMS TRANS ///TRANSFER FIRST SECTOR OF BLOCK ISZ SECTOR /// ISZ SECTOR ///TWO-WAY INTERLEAVE JMS TRANS ///SECOND SECTOR OF BLOCK JMP NXTBLK ///GO FOR NEXT BLOCK IF ANY TRANS, 0 ///READ/WRITE A SECTOR SNA CLA ///IS THIS A BBL READ ? JMP NOTBBL ///NO, PROCEED AC2000 ///YES, INVALIDATE CURTRK AS WELL DCA I CURTRK ///WE JUST DON'T KNOW WHAT HAPPENED... NOTBBL, ACM3 ///SETUP RETRY COUNT FOR THIS SECTOR DCA I (TRYCNT /// TAD TRCK ///MAKE CYLINDER + SURFACE CLL RAR ///SURFACE GOES TO LINK DCA CYL ///THE CYLINDER REMAINS RTR ///GET SURFACE BIT AC1 DCA SURF ///AND REMEMBER THAT JMS TRKCMP ///COMPARE TRCKS, TRANSFER OF SEEK COMPLETE SYRTRY, RLDC ///RESET INTERFACE IF NO MATCH SEEK, IAC ///RESET CONTROLER FOR SEEK JMS I (IO /// TAD (1004 ///READ HEADER IN BYTE MODE JMS I (IO /// RRSI ///READ FIRST HEADER BYTE BSW /// AND C3 ///GET LOWORDE TRCK BITS FROM HEADER DCA I CURTRK ///STORE THEM FOR A MOMENT RRSI ///READ SECOND HEADER BYTE AND (377 ///CLEAN IT UP CLL RTL ///MAKE ROOM FOR LOWORDER BITS TAD I CURTRK ///ADDIN LOWORDER BITS DCA I CURTRK ///THAT IS THE REAL TRCK W'ER AT JMS TRKCMP ///TRY AGAIN TAD I CURTRK ///NO MATCH, COMPUTE DISTANCE TO GO CLL RAR /// CIA /// TAD CYL /// CLL RAL ///SAVE SIGNBIT IN LINK SZL ///MAKE DIFFERENCE ABSOLUTE CIA /// CML RAR ///AC0=1 FOR INWARD SEEK TAD SURF ///ADD SURFACE BIT RLCA ///LOAD SEEK REGISTER AC0002 ///WILL MAKE SEEK FUNCTION JMP SEEK /// TRKCMP, 0 ///COMPARE TRCK AND TRANSFER OF OK TAD I CURTRK ///THATS THE HARDWARE TRCK AND SURFACE CLL CIA /// TAD TRCK ///COMPARE TO DESIRED TRCK SZA CLA ///MATCH ? JMP I TRKCMP ///NO, RETURN TO SEEK LOOP TAD SECTOR ///ON TRCK NOW, DO THE TRANSFER BSW ///LOAD SECTOR REGISTER RLSA /// TAD WC ///LOAD WC RLWC /// TAD SURF /// TAD CYL /// RLCA /// TAD MA ///GET BUFFER ADDRESS RLMA ///AND LOAD CURRENT ADDRESS REGISTER TAD FN ///GET FUNCTION JMS I (IO ///AND GO... FINALY...AT...LAST....... TAD MA ///UPDATE BUFFER ADDRESS TAD C200 ///FOR ONE PAGE DCA MA /// ISZ PGCT ///DONE ALL PAGES ? JMP I TRANS ///NO, RETURN FROM TRANS JMP I (DONE ///YES, END OF REQUEST /THE FOLLOWING 10 LOCS MUST! BE IN CORRECT ORDER /+ + + + + + BBLID, 0 /#0 FN, 0 /#1 OFFSET, 0 /#2 WC, 0 /#3 SECTOR, 0 /#4 TRCK, 0 /#5 MA, 0 /#6 MAPPED, 0 /#7 MAPPTR, 0 /#8 PGCT, 0 /#9 /+ + + + + + BLOCK, 0 CURTRK, 0 SURF, 0 CYL, 0 PAGE CVTAB, TAD I (BLOCK ///CONVERT TO TRACK/SECTOR FOR 'AB' AND C17 ///JUST 4 BITS FOR SECTOR CLL RTL /// TAD (-27 /// SPA /// TAD (47 /// DCA I (SECTOR ///PHYSICAL SECTOR # TAD I (BLOCK /// RTR /// RTR /// AND (377 /// JMP I (DOTRAN ///AND TRANSFER THIS BLOCK CVTC, TAD I (BLOCK ///CONVERT TO TRACK/SECTOR FOR 'C' DEVICE AND C3 /// CLL RTL /// DCA I (SECTOR /// TAD I (BLOCK /// RTR /// AND (777 /// JMP I (DOTRAN /// /SEPARATE TASK FOR RL01 'C' DEVICES /THIS SMALL TASKS DOES FUNNY THINGS WITH 'SY' SC, SNA /ENTRY POINT OF RESIDENT RLC HANDLER JMP I (SYCLOSE /IT WAS A CLOSE CALL DCA SCPNT /POINTER TO DTV AC0002 /REL BLOCK # TAD SCPNT / DCA SCTEM /FOR BLOCK ACCESS AC0002 /INDICATE 'C' DEVICE RDF /DTV FIELD BSW DCA SCFLD /STORE FFF/0C0/000/000 TAD I SCPNT /LOOK AT FUNC AND C3700 /PICK OUT PAGES SNA AC4000 /40 BLOCK TRANSFER BSW CLL IAC RAR /ROUND TO BLOCKS TAD I SCTEM /ADD TO START BLOCK REQ CDF 0 / CLL TAD (-SCLNGT-1 /OVERFLOW ? SZL CLA JMP I (SYEROR /YES, BADDIE JMS MONITOR /TRY TO RUN 'SY' RUN /IF SUCCES WE STOP IT "S^100+"Y&3777 JMP .-1 /STILL BUSY JMS MONITOR /WE ARE FIRST STOP /SET STOP BIT "S^100+"Y&3777 HLT /STOPPED WILL BE SET NEXT JMS MONITOR /RESERV SLOT FOR WAIT RESERV DCA SCTEM /SAVE SLOT # TAD SCTEM / DCA I (SYSTM /PUT SLOT # IN SYS DRIVER TAD SCPNT DCA I (SYSTEM /NOW SET POINTER DTV IN 'SY' TAD SCTEM /SLOT # AGAIN TAD SCFLD /MAKES FFF/0CS/SSS/SSS JMP I (SCENTR /AND JUMP IN 'SY' CODE /SY WILL DO AN AUTORESTART AND EXIT, WHICH CLEARS 'SC' SCPNT, 0 SCFLD, 0 SCTEM, 0 / END IFDEF SYRL01 > / END IFNDEF SYRX02 > IFDEF SYRX02 < RXDEVC=750 LCD=RXDEVC+6001 XDR=RXDEVC+6002 STR=RXDEVC+6003 SER=RXDEVC+6004 SDN=RXDEVC+6005 INTR=RXDEVC+6006 INIT=RXDEVC+6007 SZ, CLA CLL / CDF 00 / TAD I (SYSCNT / SZA CLA /ANY MORE REQUEST PENDING? JMP SZ1 /YES JMS MONITOR RETURN /FINISHED SZ1, TAD I SYSGET /FETCH CDF TO PARAMETERS BSW / AND C70 / TAD C6201 / DCA SZCDF / TAD SZCDF / DCA I (RXCDF / TAD I SYSGET /GET SLOT # AND C177 / DCA I (SYSLOT /SLOT FOR COMPLETION ISZ SYSGET /BUMP Q POINTER TAD I SYSGET /GET REQUEST ADDRESS DCA RXDTV / TAD SYSGET / IAC /BUMP POINTER PAST SECOND WORD AND (-SYSMAX-1^2+1 /WRAP AROUND IF NECCESSARY DCA SYSGET / ISZ I (SYSCNT /AND REDUCE COUNTER NOP /! ACM3 / DCA I (TRYCNT /SET RETRY COUNTER INTR /ONLY INTENA IN MONITOR WAIT SZCDF, HLT //CDF TO PARAMETERS AC0001 // AND I RXDTV //GET FUNCTION WORD CDF 0 /BACK TO OUR FIELD SNA CLA /IF UNIT 1 SKIP RXA0, JMS I (RXINIT /COMMON ENTRY ROUTINE 0402 /UNIT 0, 402 FOR CONVENIENCE NOP /MINUS SAYS WE STILL HAVE TO INIT RXA1, JMS I (RXINIT / C422, 0422 /20 SAYS UNIT 1, 402 FOR CONVENIENCE -1 SYSGET, SYSQ /'GET' POINTER FOR SYSTEM QUEUE RXDTV, 0 PAGE RXINIT, 0 TAD I RXINIT /GET UNIT #*20+402 DCA UNIT /SAVE IT ISZ RXINIT TAD I RXINIT SMA CLA /DO WE KNOW THIS FLOPPY ? JMP DENSOK /YES, NO NEED TO TEST DENSITY RXRSTR, JMS I (RXWAIT /CLEAR LAST EVENT IF ANY AND AC TAD UNIT /PICK UP UNIT , DOUBLE DENSITY+2 TAD SZC10 /MAKE READ STATUS ON PROPER UNIT LCD /IT WILL CHECK THE DENSITY JMS I (RXWAIT /WAIT FOR DONE (SECTOR TIME) XDR /GET STATUS WORD AND SZC33 /KEEP DENSITY ERROR, RX02, QUAD TAD SZC10 /SNGL=10, SNGL/DBL=40, DBL=20, QUAD=22 AND (422 /SNGL=0, SNGL/DBL=0, DBL=20, QUAD=22 DCA I RXINIT /TYPE CODE FOR EACH DRIVE SER SZC10, 10 /IGNORE ERRORS WE PROBABLY GET TAD (416 LCD /RESET FLAG DENSOK, TAD I RXINIT /GET TYPE CODE AGAIN SZA CLA /SKIP IF SNGL TAD M100 TAD M100 /SNGL=-100, DBL=-200 DCA I (COUNT /PLACE FOR LOOP CONTROL TAD I RXINIT CLL RTR /PUT QUAD BIT IN LINK SNA CLA /SKIP IF DOUBLE OR QUAD TAD SNGLMD /SNGL: 6044-4110 TAD DBLQUA /DBL&QUAD=4110 SNL /WAS IT QUAD? STL RAR /NO, SNGL=7022, DBL=6044 DCA I (LENGTH /YES, QUAD=4110 TAD I (COUNT /WAS IT DOUBLE DENSITY? CLL CMA RTL /SNGL=375, DBL=775 AND UNIT /MAKES 400*DBL + 20*UNIT DCA I (RFUNC /TO FUNCTION WORD TAD I (RXDTV /GET POINTER TO USER PARAMETERS RXCDF, HLT /AND SET FIELD JMP I (TRAN CALC, 0000 /SETUP TRACK, SECTOR FROM LOG. RECORD CLA /GETS CALLED WITH RANDOM AC TAD C7700 MQL /CLEAR DIVIDE QUOTIENT, SET COUNTER MASK TAD I RXINIT /IS IT RX03? RTR SNL CLA JMP SINGLE /NO, ONLY 1 HEAD TAD I (BLOCK /WHICH LOGICAL RECORD DO WE WANT? TAD DBLQUA /IS IT ON FIRST SIDE? SZL CLA JMP SINGLE /NO, AS IF 1 HEAD TAD I (RFUNC /GET FUNCTION BACK AND (422 /KEEP DBL, UNIT ,R/W TAD C7000 /FORCE HEAD ON (USE ONLY 1000 OF 7000) DCA I (RFUNC TAD DBLQUA /AND DECREASE LOGICAL RECORD SINGLE, TAD I (BLOCK /MAIN DIVIDE LOOP DCA RXREMD /SET INITIAL DIVIDEND TAD RX1400 /FALL IN LOOP WITH INITIAL DIVISOR/2 DCA RXDIVS RXDLUP, TAD RXDIVS /MAIN DIVIDE LOOP STL RAR /NEXT DIVISOR DCA RXDIVS TAD RXDIVS /LINK IS NOW = 0 TAD RXREMD SZL /OVERFLOW DCA RXREMD /YES UPDATE REMAINDER CLA MQA /GET QUOTIENT WITH COUNT MASK RAL /SHIFT IN DIVIDE BIT MQL /SHIFT BUSY BIT OUT AND RELOAD SZL /SKIP IF DONE JMP RXDLUP TAD I RXINIT /WAS IT DBL DENSITY? SZA CLA TAD RXREMD /YES, INTERLEAVE 3 TAD RXREMD TAD RXREMD /NO, INTERLEAVE 2 TAD RXDIVS /SHIFT AT -26, SO WE CAN SMA /REDUCE AGAIN MODULO TRACK JMP .-2 TAD SZC33 /FIRST TRACK IS 1 DCA I (SECTR /THAT'S IT (ALMOST) RAL /IF L=0, SECOND INTERLEAVE TAD I RXINIT /=0 IF SNGL SNA CLA /WAS IT BOTH? ISZ I (SECTR /YES, MAKE 2,4,6,8,.. SERIES MQA /GET TRACK IN AC (TRACK-1 THAT IS) JMP I CALC /CONSTANTS: RX1400, 1400 SZC33, 33 SNGLMD, 6044-4110 DBLQUA, 4110 RXREMD, 0 RXDIVS, 0 UNIT, 0 PAGE SZTEMP, 0 TRAN, DCA RXARGS /POINTER TO TV AC4000 TAD I RXARGS /CARRY R/W TO LINK AND C70 TAD C6201 DCA CDFBUF /PLACE CDF BUFFER IN I/O LOOP CML RTL TAD RFUNC /ADD READ=2 TO FUNCTION DCA RFUNC TAD I RXARGS /MAKE LOOP CONTROL COUNT RAL AND C7600 CIA DCA RXWC /0 FOR WHOLE FIELD ISZ RXARGS TAD I RXARGS DCA RXCA /SET BUFFER ADDRESS ISZ RXARGS TAD C100 /NOW CONVERT BLOCK# TO LOG. SECTOR TAD COUNT /WAS IT SINGLE DENSITY? SMA CLA TAD I RXARGS /YES, MULTIPLY BY 4 SMA /NEG. BLK #: FORCE LINK ON TAD I RXARGS /IF DOUBLE MULTIPLY BY 2 CLL RAL DCA BLOCK /SAVE LOGICAL SECTOR TAD LENGTH SZL /LEGAL BLK # ? JMP RXEROR /TRY 3 TIMES IF OTHER FLOPPY CDTOIF JMS I (CALC /DIVIDE A FIRST TIME (CLEARS AC) DCA RXTRCK /TRACK FROM AC TAD RFUNC RTR /IS IT READ? SZL CLA JMP READ /YES, TO MIDDLE OF LOOP TOP, TAD RFUNC /GET SILO TO LOAD-UNLOAD JMS RXCOMM TAD COUNT DCA RXWAIT CDFBUF, HLT SILOOP, TAD I RXCA /FOR WRITE FETCH WORD STR JMP .-1 /WAIT FOR INTERFACE READY XDR /TO OR FROM AC DCA I RXCA /PLACE FOR READ, REPLACE FOR WRITE ISZ RXCA SECTR, 0 ISZ RXWAIT /SILO FULL/EMPTY? JMP SILOOP TAD COUNT CMA /ADD 77 (SNGL), 177 (DOUBLE) TAD RXWC SNA JMP RXDONE /DONE FOR READ DCA RXWC /REPLACE AND GO ON READ, AC0004 /TURN SILO- INTO READ/WRITE COMMAND TAD RFUNC JMS RXCOMM TAD SECTR /LOAD SECTOR # STR JMP .-1 XDR AC0001 /START AT TRACK 1! TAD RXTRCK STR JMP .-1 XDR ISZ BLOCK /NEXT LOGICAL RECORD JMS I (CALC /CALC TRACK/SECTOR (CLEARS AC) DCA RXTRCK /TRACK FROM AC TAD (16 /READ STATUS JMS RXCOMM /FOR WAIT ISZ RXWC /IS WRITE FINISHED? JMP TOP /NO RXDONE, AND (3777 /SAFETY FIRST, EMULATOR WILL RESTORE 4000 JMS MONITOR SIGNAL SYSLOT, 0 JMP I (SZ /LOOK FOR MORE REQUESTS RXCOMM, 0 DCA SZTEMP /KEEP COMMAND A WHILE JMS RXWAIT /SYNC WITH FLAG TAD SZTEMP LCD /LOAD COMMAND NOW SER /ANY ERRORS? JMP I RXCOMM /NO, OK XDR /READ ERROR REGISTER DCA ERSTAT /AND KEEP IT FOR THE WIZARD AC0004 /HRDERR RXEROR, ISZ TRYCNT /MORE TRIES? JMP I (RXRSTR /YES, RESTART ALL SMA /DON'T LOG PIP ERRORS ISZ ERRLOG /YES, LOG IT JMP RXDONE /NO, FATAL ERROR RXWAIT, 0 CDTOIF CLA /CLEAR RANDOM AC SDN /QUICK FLAG? SKP /NO, GO WAIT JMP I RXWAIT /YES, RETURN AC0001 INTR /ENABLE INTERRUPT FOR SECTOR WAIT TAD (-DGNTICK^12/10 SECONDS TIMOUT JMS MONITOR WAIT SYS CLA INTR /TURN INTERRUPT OFF JMP I RXWAIT RXCA, 0 TRYCNT, 0 LENGTH, 0 RXARGS, 0 BLOCK, 0 RXWC, 0 RFUNC, 0 COUNT, 0 RXTRCK, 0 ERRLOG, 0 /SYSTEM ERROR LOG ERSTAT, 0 /LAST ERROR STATUS PAGE /END IFDEF SYRX02 > XLIST -LRESMOD-1&XLISTX /************************************************** /**** D I A G N O S T I C T I M E R ********* /************************************************** DGNTIM, CLA CLL TAD (HRDLST /SET UP FOR LISTSEARCH DCA DGNPNT TAD (-TOTSLOT+1 DCA DGNNUM DGN1, CIF CDF 0 ///INHIBBIT INTERRUPTS TAD I DGNPNT ///CAN BE 0; LT 0 OR GT 0 SPA CLA ///TIMEOUT SET ? ISZ I DGNPNT ///INCREMENT THE TIME-VALUE JMP DGN2 /IF NO OVFLOW:TRY NEXT ONE TAD DGNNUM /IF OVFLOW:INTERRUPT THAT SLOT TAD (TOTSLOT-1 /MAKE TRUE EVENT NUMBER DCA DGN4 AC0002 ///TAD (TIMEOUT JMS MONITOR /INTERRUPT THE TASK WITH CODE IN AC SIGNAL DGN4, 0 DGN2, CLA CLL ISZ DGNPNT /MOVE POINTER;INC COUNTER ISZ DGNPNT ISZ DGNNUM JMP DGN1 JMS I (BB /CALL BIG BROTHER ROUTINE IFNZRO BGMAX < JMS I (TICK /AND UPDATE BG ACCOUNT INFO > TAD (-DGNCNT /ALL DONE: THIS SETS OUR TICK VALUE JMS MONITOR /WAIT FOR TIMER TO FLOW OVER WAIT TIMER JMP DGNTIM DGNPNT, 0 DGNNUM, 0 PAGE IFDEF SYRL01 < XLIST -LSYSDRV-1&XLISTX /THIS BELONGS TO THE SYSTEM DRIVER... /ONE OR TWO PAGE WITH BAD BLOCK DATA FOR THAT DAMN THING. /DATA TABLE, BAD BLOCK LISTS, ETC. DRVTAB, 2000 /CURRENT TRACK BBL0 /AND BBL FOR DRIVE 0 2000 /IDEM DRIVE 1 BBL1 IFNZRO SYRL01-1&2 < 2000 /IDEM DRIVE 2 BBL2 2000 /IDEM DRIVE 3 BBL3 / > BBL0, 4321 /INVALID ID ZBLOCK 20 /BBL UNIT 0A ZBLOCK 20 /BBL UNIT 0B 4321 /INVALID ID FOR 0C ZBLOCK 20 /BBL UNIT 0C BBL1, ZBLOCK 62 /SAME ARANGEMENT FOR DRIVE 1 IFNZRO SYRL01-1&2 < BBL2, ZBLOCK 62 /SAME ARANGEMENT FOR DRIVE 2 BBL3, ZBLOCK 62 /SAME ARANGEMENT FOR DRIVE 3 > ABCLST, 0 /TRACK OFFSET -41 /WC FOR BBL READ 14 /SECTOR FOR BBL READ 0 /START OF BBL LIST CVTAB /BLOCK TO TRACK/SCTOR CONVERSION ROUTINE 1 /OFFSET FOR RUNNING BBL POINTER 400 /TRACK OFFSET FOR 'B' -41 /WC FOR BBL READ 14 /SECTOR FOR BBL READ 0 /START OF BBL LIST CVTAB /BLOCK TO TRACK/SECTOR CONVERSION ROUTINE 21 /OFFSET FOR RUNNING BBL POINTER 1 /TRACK OFFSET -21 /WC FOR BBL READ 16 /SECTOR FOR BBL READ 41 /OFFSET FOR BBL LIST CVTC /BLOCK TO TRACK/SECTOR CONVERSION ROUTINE 42 /OFFSET FOR RUNNING BBL POINTER PAGE /END OF IFDEF SYRL01 > XLIST -LRESMOD-1&XLISTX DOTF00=. FIELD 1 *DOTF10 /************************************************************ /****** FIELD 1, PAGE ZERO: REENTRANT TASK SUPPORT ********** /************************************************************ IFNZRO BGMAX < FREE, FQLAST /POINTER TO TERMINAL POOL FRECNT, POOLN /NUMBER OF BLOCKS IN FREE QUEUE BJOB, 0 /POINTER TO CURRENTLY RUNNING BG > SETBASE,0 /ROUTINE TO FETCH BLOCK# OF CURTASK CDF 00 //WHICH IS USED AS REENTRANCY BASE CML STA //BY REENTRANT, CORERESIDENT TASKS TAD I XCURTSK // DCA BASE // TAD I BASE // DCA BASE // CDF 10 / JMP I SETBASE /LINK HAS BEEN PRESERVED ! XCURTSK,CURTSK GET, 0 /GET A RELATIVE ADDRESSED VALUE TAD I GET /FETCH OFFSET ISZ GET TAD BASE /ADD BASE VALUE DCA X /USES THE X-REGISTER ! TAD I X JMP I GET /RETURN WITH VALUE IN AC PUT, 0 /ROUTINE TO STORE AC IN RELATIVE LOCATION DCA GET /SAVE THE AC TAD I PUT /FETCH OFFSET ISZ PUT TAD BASE /ADD BASE DCA X /USES THE X-REGISTER ! TAD GET /GET STORED AC DCA I X /AND DROP IN ADDRESSED LOCATION JMP I PUT /RETURN WITH AC CLEAR XLIST -LFPP-1&XLISTX IFDEF FPP < /FPP PARAMETER TABLE LOCATIONS: DFLG, 0 /0 = F.P., 1 = D.P., -3 = E.P. ADRHI, 0 /UPPER 3 BITS OF ADRESSES BASHI, 0 XRHI, 0 PCHI, 0 PC, 0 /FPP PROGRAM COUNTER XRBASE, 0 /FPP INDEX REGISTER ARRAY ADDRESS BASADR, 0 /FPP BASE PAGE ADDRESS ADRLOW, 0 /FPP INSTRUCTION OPERAND ADDRESS ACX, 0 /EXP OF FAC ACSGN, 0 /SIGN OF FAC -1:NEG 0:ZERO +1:POS XRPNT, 0 /POINTER TO XR REG IN USE INDX, 0 /BITS 6-8 OF INSTRUCTION AUTO, 0 /BIT 5 OF INSTRUCTION / > PAGE XLIST -LRESMOD-1&XLISTX IFDEF KL8E2 <KL8XX=1> IFDEF KL8A1 <KL8XX=1> IFDEF KL8XX < /REENTRANT VERSION /DEFINITIONS OF OFFSETS !MUST BE IN THIS ORDER! NOPUNCH DOTF10=. *0 TTCHAR,. TTEVNT,. TTRET,. TTTLS,. TTSAV,. IFDEF KL8A1 < TTLINE,. > TTCOUNT,. TTFCHR,. TTFILL,. TTTMP,. TTBACK,. *DOTF10 ENPUNCH TT, SNA JMP TT3 /AC=0: TAKE IMMEDIATE EXIT DCA ZTEM1 JMS SETBASE /INITIALISE 'BASE' WITH POINTER TO TTY LIST TAD ZTEM1 DCA I BASE /STORE USERS AC IN TTCHAR TAD ZTEM1 AND C177 /STRIP PARITY TAD (-11 SNA /TAB ? JMP TTTAB /YES, GO EXPAND THE TAB CHARACTER IAC SZA CLA /BACKSPACE ? JMP TT0 /NO JMS GET /BACKUP POSITION COUNTER TTCOUNT TAD M1 DCA I X / JMS GET /YES GET ALTERNATE BACKSPACE TTBACK TT0, TAD ZTEM1 JMS TTOUT /NOT TAB, PRINT THE CHARACTER TT1, ISZ X /TTFCHR AFTER TTCOUNT TAD I X /GET MINUS THE FILLCHARACTER SNA /ANY FILLERS NEEDED ? JMP TT2 /NO TAD I BASE /GET THE USERS CHARACTER AND C177 /STRIP PARITY SNA CLA /FILLCHARACTERS NEEDED ? JMP TTFLL /YES, GO THERE TT2, TAD I BASE SMA CLA /EXIT OR RETURN ? JMP TT3 JMS MONITOR RETURN /TT3, JMS MONITOR /SEE AT KK2 / EXIT TTTAB, TAD C240 /EXPAND A TAB... JMS TTOUT /START WITH ONE SPACE TAD I X /JMS GET / TTCOUNT AND C7 /ARE WE AT TAB POSITION ? SZA CLA JMP TTTAB /NOT YET JMP TT1 /DONE TTFLL, ISZ X /TTFILL AFTER TTFCHR TAD I X /GET THE DESIRED FILLCOUNT ISZ X /TTTMP AFTER TTFILL SNA JMP TT2 /ZERO=NONE DCA I X /STORE IN TTTMP ACM1 JMS TTOUT /OUTPUT A RUBOUT ISZ X /TO TTFCHR ISZ X /TO TTFILL ISZ X /TO TTTMP TAD I X IAC JMP TTFLL+3 /SEE IF DONE TTOUT, 0 /SUBROUTINE TO OUTPUT ONE CHARACTER JMS PUT /SAVE THE CHARACTER TTSAV JMS GET TTEVNT /GET THE EVENT NUMBER DCA TTOUT1 ISZ X /TTRET AFTER TTEVNT TAD TTOUT /SAVE RETURNADDRESS IN TTYLIST DCA I X /IN TTRET TAD (-DGNTICK /ONE SECOND TIMEOUT KEEPS SYSTEM GOING JMS MONITOR WAIT TTOUT1, 0 JMS SETBASE /RELOAD BASE REGISTER JMS GET TTRET /FETCH RETURN ADDRESS DCA TTOUT ISZ X /TTTLS AFTER TTRET TAD I X /GET PROPPER TLS INSTRUCTION DCA TTOUT2 ISZ X /TTSAV AFTER TTTLS TAD I X /GET THE CHARACTER TO BE PRINTED IFDEF KL8A1 < ISZ X /TTLINE AFTER TTSAV TAD I X /GET LINENUMBER^400 > ISZ X /POSITION TTCOUNT AFTER TTLINE TTOUT2, HLT /WILL BECOME A TLS AND C177 TAD (-40 SMA /CONTROL-CHAR ? ISZ I X /NO, COUNT IT NOP TAD (40-12 SZA /WAS IT LINEFEED ? TAD M3 /(12-15 SNA CLA /WAS IT CR ? DCA I X /YES, RESET POSITION COUNTER JMP I TTOUT /RETURN WITH X AT TTCOUNT > IFNDEF KL8XX < /NON-REENTRANT VERSION- TT, SNA /AC=0 ? JMP TT3 /YES, EXIT ! DCA TTSAV TAD TTSAV DCA TTCHAR /SAVE THE USERS AC, WE'LL NEED IT TAD TTSAV AND C177 TAD (-11 SNA /TAB ? JMP TTTAB /YES, GO EXPAND IT IAC SZA CLA /BACKSPACE ? JMP TT0 /NOT BACKSPACE ACM1 /BACKSPACE, BACKUP POSITION COUNTER TAD TTCOUNT DCA TTCOUNT TAD TTBACK TT0, TAD TTSAV JMS TTOUT /OUTPUT THE CHARACTER TT1, TAD TTFCHR SNA /ANY FILLERS NEEDED ? JMP TT2 /NO TAD TTCHAR /COMPARE WITH CURRENT CHARACTER AND C177 /DON'T CONSIDER PARITY SNA CLA /FILLERS NEEDED ? JMP TTFLL /MUST SUPPLY FILLERS TT2, TAD TTCHAR SMA CLA /EXIT OR RETURN ? JMP TT3 JMS MONITOR RETURN TT3, JMS MONITOR EXIT TTTAB, TAD C240 /EXPAND A TAB ... JMS TTOUT /OUTPUT A SPACE TAD TTCOUNT AND C7 SZA CLA /ARE WE AT A TAB-STOP ? JMP TTTAB /NOT YET JMP TT1 /DONE TTFLL, TAD TTFILL /GET DISIRED NUMBER OF FILL CHAR'S DCA TTTMP JMS TTOUT /OUTPUT A NULL ISZ TTTMP JMP .-2 /MORE JMP TT2 /DONE TTOUT, 0 /SINGLE CHARACTER OUTPUT ROUTINE DCA TTSAV TAD (-DGNTICK /ONE SECOND TIMEOUT KEEPS TERMINAL GOING JMS MONITOR WAIT TTY1 CLA CLL TAD TTSAV TLS /THERE GOES THE CHARACTER AND C177 /STRIP PARITY BIT TAD (-40 /CODE .LT.240 ? SMA JMP TTOU1 /NO, PRINTING CHARACTER TAD (40-12 SZA /LINEFEED ? TAD M3 /(12-15 SZA CLA /WAS IT CR ? JMP I TTOUT /NO, DON'T COUNT NON-PRINTING CHARS JMP .+4 /YES, RESET POSITION COUNTER TTOU1, CLA / TAD TTCOUNT / IAC /INCREMENT POSITION COUNTER DCA TTCOUNT JMP I TTOUT /DONE TTSAV, 0 /THE CHARACTER THAT WILL GO OUT TTCHAR, 0 /THE CHARACTER WE GOT FROM THE CALLER TTCOUNT,0 /THE CURRENT POSITION TTBACK, T1BACK-210 TTFCHR, -T1CHAR /MINUS CHARACTER THAT NEEDS FILLERS TTFILL, -T1FILL /THE NUMBER OF FILLERS TO BE SUPPLIED TTTMP, 0 /A TEMPORARY, END OF NONREENTRANT VERSION > XLIST -LRESMOD-1&XLISTX IFDEF KL8XX < /REENTRANT VERSION OF KK- /DEFINITION OF OFFSETS KKEVNT= 0 KKESCP= 1 KK, DCA ZTEM1 JMS SETBASE /INITIALISE BASE REGISTER TAD I BASE /GET SLOT NUMBER DCA .+4 TAD ZTEM1 /USE CALLERS AC AS TIMEOUT VALUE JMS MONITOR WAIT 0 /WILL BECOME PROPER SLOT NUMBER TAD M2 / SNA /TIMEOUT ? JMP KK2 /YES, EXIT WITH AC4000 TAD C2 / DCA ZTEM1 /NO, STORE THE CHARACTER JMS SETBASE /RELOAD BASE REGISTER ISZ BASE /LET BASE POINT TO ESCAPE CODE TAD I BASE /GET MINUS ESCAPE FOR THIS TERMINAL TAD ZTEM1 /AND COMPARE SNA CLA /EQUAL ? TAD (233 /YES, TRANSLATE TO TRUE ESCAPE SNA / TAD ZTEM1 /NO, FETCH ORIGINAL CHARACTER SKP KK2, AC4000 TT3, JMS MONITOR EXIT / END OF REENTRANT VERSION > IFNDEF KL8XX < /NON-REENTRANT VERSION OF KK KK, JMS MONITOR WAIT KB1 TAD M2 / SNA /TIMEOUT ? JMP KK2 /YES, TIMED OUT TAD C2 / DCA ZTEM1 /SAVE THE CHAR TAD KKESCP /GET MINUS ESCAPE FOR THIS TERMINAL TAD ZTEM1 /AND COMPARE SNA CLA /EQUAL ? TAD (233 /YES, TRANSLATE TO TRUE ESCAPE SNA / TAD ZTEM1 /NO, FETCH ORIGINAL CHARACTER SKP KK2, AC4000 JMS MONITOR EXIT /END OF NON-REENTRANT VERSION KKESCP, -T1ESCP /(MAY BE CHANGED BY CB TASK) > PAGE