IMD 1.16: 2/09/2008 13:03:47 rtx:rom 93708-00-c2 (f70800) 84-93708-00 c2 10/18/79  ž ž @0‚|†ų)€€Ŗv1½®u¦o) ˆ " ž}‚j’A ¢cœOMEGA4€MĮOM790111120000OM790111120000OM790111120000RTX:ROM      žśž¼žö›±-Mˆ@†jęjg€’ķg’čĀg@ †o G€’ņ`śkžŽ¾ļž¾¢_„C# b# ž}€BŸ€ žuŅ[¾į žųž]e‡ †JĀR¾­ęėi¾ģĄˆĘCp@€„†=€…†<€††;€ƒ †GĀ9P@ G€’ĀĘ<ą‰ęņ¾•NĘäP¾ćāŃčCHłC €ˆC ˜GČTŗą€qEžā‚ā¢'ŸĆž£ *¦½ C¦¦ÉŸxĘžē @0DAJ÷LĘ )Ą€Ŗä1½" ¦ † i¾¢€„œ+āœ fžH¾łžE `jrBˆB¾ I,Ÿv ¾°¾ €B¾  I,ŸmžĖ ž @¬E°EØF¤F)¤D¾_ÄE‚‚„Fž+ †ĖęĖH’ĘÅĘÅ@pĘP¾ĒŸv g€’nrgŸy ¾w"¾IŽ ž{žM¾q¾DŽž}žH¾.`¾,t¾žC¾) ²>¾d ¾$Ž:Ž9Ž8žy¦6ž7¾ž5¾ü¾+ž1OS:: SYS?e%OM790111120000OM790111120000OM790111120000e  @OM790111120000OM790111120000OM790111120000e$OM790111120000OM790111120000OM790111120000eOM790111120000OM790111120000OM790111120000OM790111120000OM790111120000OM790111120000e' {OM790111120000OM790111120000OM790111120000e3F,ŪOM790111120000OM790111120000OM790111120000eJ&KSOM790111120000OM790111120000OM790111120000  eŸxOM790111120000OM790111120000OM790111120000 e¢3 OM790111120000OM790111120000OM790111120000 e¢ ĮOM790111120000OM790111120000OM790111120000 e®3įOM790111120000OM790111120000OM790111120000 eČ BOM790111120000OM790111120000OM790111120000eÓ+GOM790111120000OM790111120000OM790111120000eé 7“OM790111120000OM790111120000OM790111120000e+{OM790111120000OM790111120000OM790111120000eāOM790111120000OM790111120000OM790111120000e+ ?OM790111120000OM790111120000OM790111120000eK" OM790111120000OM790111120000OM790111120000e]1„OM790111120000OM790111120000OM790111120000ev1OM790111120000OM790111120000OM790111120000 eźOM790111120000OM790111120000OM790111120000eŌOM790111120000OM790111120000OM790111120000epOM790111120000OM790111120000OM790111120000eqPOM790111120000OM790111120000OM790111120000 ’’’’’Ą’’’’’’š. GEN MACRTX MACRTXD MAC ROMINIT ASM RTX LIB RTXDOOR ASM RTXTASK ASM RTXSEMA4 ASMRTXTICK ASMRTXWALL ASMRTXOTHER ASMRTXMPMGR ASMRTXDISP ASMRTXEXPR ASMRTXMISC ASMRTXDATE ASMRTXECB ASMRTXCOMN ASMRTX:ASM JCLRTX:LIB JCLIOSTTY ASM  TITL G E N . M A C - GENERAL EQUATES & MACROS (93420-10-C1) * BIT POSITIONS * CY: EQU 0 CARRY. OV: EQU 1 OVERFLOW. BY: EQU 2 BYTE MODE. CI: EQU 4 CONSOLE INTERRUPT ENABLED. RI: EQU 5  REAL TIME CLOCK INTERRUPT ENABLED. XA: EQU 6 EXTENTED ADDRESSING MODE. INT: EQU 8 INTERRUPTS ENABLED. IM12: EQU 12 LEVEL 0 WORD INTERRUPT MASK. IM13: EQU 13 LEVEL 0 EVENT INTERRUPT MASK. UX: EQU  13 EXCEPTION RETURN FOR UNRECOVERABLE ERROR RX: EQU 14 EXCEPTION RETURN FOR RECOVERABLE ERROR * * BIT VALUES * CY:V EQU 1 CARRY. OV:V EQU 2 OVERFLOW. BY:V EQU 4 BYTE MODE. B3:V EQU :8  RESERVED STATUS BIT 3 CI:V EQU :10 CONSOLE INTERRUPT ENABLED. RI:V EQU :20 REAL TIME CLOCK INTERRUPT ENABLED. XA:V EQU :40 EXTENDED ADDRESSING. B7:V EQU :80 RESERVED STATUS BIT 7 INT:V EQU :100 INTERRUPTS ENABLED. IM12:V EQU :1000 LEVEL 0 WORD INTERRUPT MASK IM13:V EQU :2000 LEVEL 0 EVENT INTERRUPT MASK. TITL * CONTEXT BLOCK (STACK) EQUATES * LAST:L EQU 0 LAST:S EQU 1 LAST:A EQU 2 LAST:Q EQU 3 LAST:X EQU 4 LAST:Y EQU 5 LAST:P EQU 6 CBL: EQU LAST:P+1 LENGTH OF CONTEXT BLOCK TITL ** MACRO: DUP * * DUPLICATE THE GIVEN BYTE THE NUMBER OF TIMES SPECIFIED. * * CALLING SEQUENCE: * DUP 'TEXT',NUM * 'TEXT' = BYTE STRING (DUPLICATION STARTS IN COLUMN 1) * NUM = NUMBER OF TIMES TO DUPLICATE * ** SPACE 1 DUP MACRO * N::: SET  #(1,?)-1 LAST CHAR OF TEXT * IFT #(2)>0 #(1,2,N:::) N2::: SET #(2)-1 DUP #(1),N2::: ENDC * ENDM TITL * EXCHANGE MEMORY TO MEMORY MACRO - EXCH:M * CALLING SEQUENCE * EXCH:M MEM1,MEM2 * * THE CONTENTS OF MEM1 & MEM2 ARE EXCHANGED MACRO EXCH:M EXCH #1,A EXCH A,#2 EXCH  A,#1 ENDM TITL * RETURN WITH A VALUE IN THE A-REGISTER MACRO RET: COPY =#1,A RSK ENDM TITL * COPY MEMORY TO MEMORY, SECOND PARAMETER IS THE REGISTER USED MACRO COPY:M COPY #1,#2 COPY #2,#3 ENDM TITL * THE FOLLOWING SYMBOLS WORK WITH SYMATT * ABSBT: EQU :8000 ABSOLUTE RELBT: EQU :4000 RELATIVE SRLBT: EQU :2000 SCRATCH PAD EXT: EQU :1000 INDBT: EQU :800 INDIRECT LITBT: EQU :400  LITERAL NXBT: EQU :200 POST INDEXED PNXBT: EQU :100 PRE INDEXED UNDBT: SET :80 UNDEFINED NULL: EQU :40 NULL SYMER: EQU :20 AN ERROR OCC TITL * SR: -- SYSTEM REQUEST TO DOOR * * SR * SR FIELD * SR M4D12 * * WHERE FIELD IS A DIRECT OR INDIRECT REFERENCE TO * ANY LOCATION IN MEMORY. M4D12F IS ANY VALID M4D12 * ADDRESS EXPRESSION. * SR: MACRO R:DBUG MACENT :8000 R:SIG MACENT 1 R:WAIT MACENT 2 R:BGIN MACENT 3 R:END MACENT 4+:8000 R:SPRI MACENT 5 R:GPRI MACENT 6+:8000 I:IO MACENT 7 R:CINT MACENT 8+:8000 R:SEND MACENT 9 R:RECV  MACENT 10 R:ITIC MACENT 11 R:PAUS MACENT 12 R:ABUF MACENT 13 R:RBUF MACENT 14 R:STOD MACENT 15+:8000 R:GTOD MACENT 16+: 8000 R:AWAL MACENT 17 R:IWAL MACENT 18 R:CTIC MACENT 19 R:MTIC MACENT 20 R:CWAL MACENT 21 F:CREA MACENT 22 F:DELE MACENT 23 F:CONN MACENT 24 F:MONT MACENT 25 F:CFNO MACENT 26 R:GATD MACENT 27 R:SATD MACENT 28 F:DMNT MACENT 29 STVAL: SET #(0)&:FF TWOOP: SET 1 IFT #(0)&:8000 TWOOP: SET 0 ENDC ADMOD: SET 1 IFF #?=0 ADMOD: SET  0 S: SYMATT #(1) IFF NXBT:;PNXBT:&S: ADMOD: SET 1 IFT #(1,'*')=1 ADMOD: SET 2 ENDC  ENDC ENDC WORD ADMOD:%13;:1A00;STVAL: IFT TWOOP: IFF ADMOD: M4D12 #(1) ENDC  IFT ADMOD: WORD #(1) ENDC ENDC IFF TWOOP: WORD 0 ENDC IFF TWOOP:=#(?) NOTE E,'WRONG NUMBER OF OPERANDS' ENDC ENDM TITL * CONSOLE DEVICE ADDRESS AND FUNCTION CODES * CONDA: EQU 0%3  CONSOLE DEVICE ADDRESS. CSSFC: EQU 0 CONSOLE SENSE SWITCH FUNCTION CODE. CIRFC: EQU 1 CONSOLE INTERRUPT RESET FUNCTION CODE. CDR: EQU 4 CONSOLE DATA REGISTER FUNCTION CODE * * DIO INTERUPT VECTOR EQUATES * IV:AIO EQU 0 AUTO I/O IV:CNT EQU 1 BYTE COUNT IV:BUF EQU 2 BUFFER ADDR IV:JSK EQU 4 JSK $+1 IV:EOB EQU 5 EOB ADDR * * NON-PRINTING ASCII CHARACTER VALUES * PARTY: EQU 0  BIT 7 OFF NU: SET :0;PARTY: NULL LF: SET :A;PARTY: LINE FEED FF: SET :C;PARTY: FORM FEED CR: SET :D;PARTY: CARRIAGE RETURN RO: SET :7F;PARTY: RUBOUT TITL * FIXED MEMORY ADDRESS ASSIGNMENTS * PUPA: EQU :80  POWER UP ADDRESS UITA: EQU :84 UNIMPLEMENTED INSTRUCTION TRAP ADDRESS UMTA: EQU :88 UNINSTALLED MEMORY TRAP ADDRESS PFTA: EQU :8C POWER FAILURE TRAP ADDRESS EACA: EQU :90 EFFECTIVE ADDRESS CALCULATION ADDRESS RTCNC: EQU :91 REAL TIME CLOCK INCREMENT ADDRESS RTCIA: EQU :92 READ TIME CLOCK INTERRUPT ADDRESS CONIA: EQU :94 CONSOLE INTERRUPT ADDRESS CNTA: EQU :98 CHARACTER/NUMERIC EXCEPTION TRAP ADDRESS SOTA: EQU :9C  STACK OVERFLOW TRAP ADDRESS SETA: EQU :9C STACK EXCEPTION TRAP ADDRESS USTA: EQU :A0 USER TRAP ADDRESS SYTA: EQU :A4 SYSTEM TRAP ADDRESS AETA: EQU :A8 ARITHMETIC EXCEPTION TRAP ADDRESS SPACE 3 SAVE END S RTCNC: EQU :91 REAL TIME CLOCK INCREMENT ADDRESS RTCIA: EQU :92 READ TIME CLOCK INTERRUPT ADDRESS CONIA: EQU :94 CONSOLE INTERRUPT ADDRESS CNTA: EQU :98 CHARACTER/NUMERIC EXCEPTION TRAP ADDRESS SOTA: EQU :9C  STACK OVERFLOW TRAP ADDRESS SETA: EQU :9C STACK EXCEPTION TRAP ADDRESS USTA: EQU :A0 USER TRAP ADDRESS SY TITL R T X . M A C - RTX GENERAL EQUATES & MACROS (93420-11-C1) * INIT:A AR,QR,XR,YR,ECB,TDB,PRI * INIT:A AR,QR,XR,YR,ECB,TDB,PRI,AMTFREE * INIT:A AR,QR,XR,YR,ECB,TDB,PRI,AMTFREE,ADRFREE * INIT:A AR,QR,XR,YR,ECB,TDB,PRI,AMTFREE,ADRFREE,ADRERROR * INIT:A AR,QR,XR,YR,ECB,TDB,PRI,,,ADRERROR * INIT:A AR,QR,XR,YR,ECB,TDB,PRI,AMTFREE,,ADRERROR * *  AR INITIAL CONTENTS OF A REGISTER. * QR INITIAL CONTENTS OF Q REGISTER. * XR I NITIAL CONTENTS OF X REGISTER. * YR INITIAL CONTENTS OF Y REGISTER. * ECB ADDRESS OF ENVIRONMENT CONTROL BLOCK. * TDB ADDRESS OF TASK DESCRIPTOR BLOCLK. * PRI PRIORITY OF ACTIVITY OF TASK. * AMTFREE AMOUNT OF FREEPOOL SPACE (WORDS) * ADRFREE ADDRESS OF FREEPOOL. * ADRERROR ADDRESS OF ERROR ROUTINE * BLKSZ: EQU 12 MACRO INIT:A LOAD RTX: LOAD R:LOW R:INIT WORD #1,#2,#3,#4,#5,#6,#7&:7FFF WORD IN:CHK S: SET 0 SV: SYMATT #8 IFF NULL:&SV: SV: SYMATT #9 IFF NULL:&SV: WORD #8 WORD #9 ENDC IFT NULL:&SV: S: SET #8 ENDC ENDC SV: SYMATT #8 IFT NULL:&SV: S: SET 2*BLKSZ: ENDC IFT S: WORD S: WORD $+2 ENDC SV: SYMATT #10  IFF NULL:&SV: WORD #10 ENDC IFT NULL:&SV: WORD 0 ENDC IFT S: RES S:,:8080  ENDC ENDM TITL * SINGL: START,STACK * SINGL: START,STACK,FLAGS * * START START ADDRESS OF TASK * STACK AMOUNT OF STACK SPASE REQUIRED * FLAGS NONXA: - BEGIN WITHOUT EXTENDED ADDRESSING * BM:V - BEGIN WITH BYTE MODE * OV:V - BEGIN WITH OVERFLOW SET *  CY:V - BEGIN WITH CARRY SET * MACRO SINGL: EXTR R:ECB1 INIT:A 0,0,0,0,R:ECB1,R:TSK1,100,4*BLKSZ: TDB:A R:TSK1,#1,0,R:STK1,#2,#3 R:STK1 RES #2,0 LOAD UAT:S ENDM TITL * TDB:A LABEL,START,YSCRATCH,STACKAD,STACKAMT * TDB:A LABEL,START,YSCRATCH,STACKAD,STACKAMT,FLAGS * TDB:A LABEL,START,YSCRATCH,STACKAD,STACKAMT,FLAGS,USAGE * TDB:A LABEL,START,YSCRATCH,STACKAD,STACKAMT,FLAGS,USAGE,SEMA4 * * LABEL LABEL TO BE ASSIGNED TO START OF TDB. * START START ADDRESS OF TASK. * YSCRATCH AMOUNT OF Y-SCRATCHPAD USED BY TASK. * STACKAD ADDRESS OF PREALLOCATED STACK, OR ZERO. * STACKAMT AMOUNT OF STACK SPACE USED BY TASK. * FLAGS OPTIONAL FLAGS. * BM:V =BM: ON IN INITIAL STATUS * OV:V  =OV: ON IN INITIAL CONTEXT * CY:V =CY: ON IN INITIAL STATUS * USAGE NUMBER OF CONCURRENT ACTIVITIES OF THIS TASK. * SEMA4 OPTIONAL ADDRESS OF CONCURRENCY SEMAPHORE. * (WHICH MUST BE SET TO 1 OR USAGE BY USER) * MACRO TDB:A #1 CHAN R:TDBL TD:PER S: SET 0 SV: SYMATT #6 IFF NULL:&SV: IFT XA:V COMPLEMENT XA BIT IN TD:FLG WORD \XA:V ENDC IFF XA:V WORD XA:V;#6 ENDC S: SET 1 ENDC IFF S: WORD 0 TD:FLG ENDC D: SET 1 DV: SYMATT #7 IFF NULL:&DV: D: SET #7 ENDC DV: SYMATT #8 IFT NULL:&DV: WORD $+6 TD:SEM  ENDC IFF NULL:&DV: WORD #8 TD:SEM ENDC WORD D: TD:NOX WORD #3 TD:Y WORD #4  TD:AD WORD #5 TD:AMT WORD #2 TD:P IFT NULL:&DV: WORD D: CONCURRENCY SEMAPHORE   ENDC RES 2,0 WORD TD:CHK TD:CKW ENDM TITL * ECB:A LABEL,UAT * ECB:A LABEL,UAT,ENDMEM * * LABEL LABEL TO BE ASSIGNED TO START OF ECB. * UAT ADDRESS OF UNIT ASSIGNMENT TABLE. *  ENDMEM ADDRESS OF LOCATION FOLLOWING LAST WORD * OF USER'S PROGRAM. (OPTIONAL). *  MACRO ECB:A #1 CHAN R:ECBL ED:PER WORD 0 EC:FLG WORD #1 EC:EDB WORD 1  EC:LUS ALIAS EC:PRV RES 2,0 WORDS 4-5 RESERVRVED WORD 0 EC:CNT WORD 0  EC:ALH WORD 0 EC:SUB WORD 0 EC:MST WORD 0 EC:NEC WORD EC:CHK EC:CKW * REST OF ENVIRNMENT DESCRIPTOR BLOCK WORD 16 ED:EVO WORD 48 ED:MRO RES 2,0 14-15 RESERVED FOR FUTUTE USE RES 16,0 ED:EVT WORD #2 ED:UAT WORD 0 ED:LMA SV: SYMATT #3 IFF NULL:&SV: WORD #3 ED:MPA ENDC IFT NULL:&SV: WORD 0 ED:MPA ENDC WORD 0 ED:HMA WORD 0 ED:EUS WORD  :7FFF ED:PRI CHAN R:TDBL ED:TLH CHAN R:SL ED:SLH CHAN R:MBXL  ED:MLH RES 8,0 41-48 RESERVED FOR FUTURE USE * 41-43 EMPTY *  44 NUMBER OF ACTIVITY * 45 TDB OF INITIAL TASK * 46 PRIORITY OF INITIAL ACTIVITY * 47 ID OF INITIAL ACTIVITY * 48 MAP OF REGISTER TABLE ENDM TITL * BGIN:A LABEL,TASK,PRI * * LABEL ADDRESS OF ARGUMENT LIST WHICH FOLLOWS * TASK ADDRESS OF TCB AS GIVEN IN THE TDB:A MACRO * PRI PRIORITY OF THE TASK *  MACRO BGIN:A S: SET #?=3 IFF S: NOTE 'THIS MACRO CALL HAS'..#?..'PARAMETERS' ENDC  IFT S: #1 EQU $ WORD #2 WORD #3 ENDC ENDM TITL * TICK:A LABEL,TID,SEMA,TCOUNT(,EID) * *  LABEL ADDRESS OF ARGUMENT LIST WHICH FOLLOWS * TID TIMER ID TO CANCEL OR MODIFY THE REQUEST * SEMA ADDRESS OF SEMAPHORE TO BE SIGNALLED * TCOUNT NUMBER OF TICKS ELLAPSED *  EID MASTER ENVIRONMENT ID (OPTIONAL) * MACRO TICK:A S: SET 3<#?<6 IFF S:  NOTE 'THIS MACRO CALL HAS'..#?..'PARAMETERS' ENDC IFT S: V: SET 0 IFT #?=5 V: SET #5 ENDC #1 EQU $ WORD V: WORD #2 WORD #3 WORD #4 ENDC ENDM TITL * WALL:A LABEL,TID,SEMA,UPPER,LOWER(,EID) * * LABEL ADDRESS OF ARGUMENT LIST WHICH FOLLOWS * TID TIMER ID TO CANCEL OR MODIFY THE REQUEST * SEMA ADDRESS OF SEMAPHORE TO BE SIGNALLED * UPPER  TIME OF DAY UPPER * LOWER TIME OF DAY LOWER * EID MASTER ENVIRONMENT ID (OPT  IONAL) * MACRO WALL:A S: SET 4<#?<7 IFF S: NOTE 'THIS MACRO CALL HAS'..#?..'PARAMETERS'  ENDC IFT S: V: SET 0 IFT #?=6 V: SET #6 ENDC #1 EQU $ WORD V: WORD #2 WORD #3 WORD #4 WORD #5 ENDC ENDM TITL * MAIL:A LABEL,IDENT(,ENVIRONMENT) * * LABEL  ADDRESS OF ARGUMENT LIST WHICH FOLLOWS * IDENT MAILBOX ID * ENVIRONMENT ENVIRONMENT ID * MACRO MAIL:A IFF 1<#?<4 NOTE 'THIS MACRO CALL HAS'..#?..'PARAMETERS' ENDC IFT 1<#?<4 V: SET 0 IFT #?=3 V: SET #3 ENDC #1 WORD V: WORD #2 ENDC ENDM TITL *  SDB:A LABEL,VALUE * * WHERE LABEL IS THE LABEL TO BE APPLIED TO THE SEMAPHORE. * VALUE IS THE INITIAL VALUE OF THE SEMAPHORE. * MACRO SDB:A IFF 0<#?<4 NOTE 'ERROR,THIS MACRO CALL HAS'...#?...'PARAMETERS'  ENDC IFT 0<#?<4 CHAN R:SL IFT #?=1 ONLY ONE ARGUMENT WORD 0 SEMAPHORE INITIALZED TO 0 #1 WORD 0 ENDC IFT #?=2 TWO ARGUMENTS WORD #2 FLAGS SET TO 0 #1 WORD #2 SEMAPHORE INITIALIZED TO #2 ENDC IFT #?=3 3 ARGUMENTS WORD #3%8;#2  FLAGS AND INITIAL VALUE #1 WORD #2 SEMAPHORE INITIALIZED TO #2 ENDC WORD SD:CHK ENDC ENDM TITL * MDB:A IDENT(,EID) * * IDENT MAILBOX ID * EID ENVIRONMENT ID, OPTIONAL * * MACRO MDB:A IFF 0<#?<3 NOTE 'ERROR, THIS MACRO CALL HAS'...#?...'PARAMETERS' ENDC  IFT 0<#?<3 V: SET 0 IFT #?=2 V: SET #2 ENDC CHAN R:MBXL PEER POINTER WORD 0 FLAGS WORD 1 MAILBOX USAGE SEMAPHORE WORD 0 MESSAGE SIGNALLING SEAPHORE  WORD 0 A-REGISTER OF MESSAGE WORD 0 Q-REGISTER OF MESSAGE RES 3,0 RESERVED WORD V: MASTER ENVIRONMENT ID WORD #1 MAILBOX IDENTIFIER WORD MD:CHK CHECKWORD  ENDC ENDM TITL * INTERNAL BLOCK CHECK VALUE EQUATES * IN:CHK EQU :F00E TD:CHK EQU :F01E TDB CHECK VALUE (IN TD:CKW) AC:CHK EQU :F02E ACB CHECK VALUE (IN AC:CKW) SD:CHK EQU :F03E SDB CHECK VALUE (IN SD:CKW) CC:CHK EQU :F04E CCB CHECK VALUE (IN CC:CKW) EC:CHK EQU :F06E ECB CHECK VALUE ( IN EC:CKW ) MD:CHK EQU :F07E MDB CHECK VALUE (IN MD:CKW) UA:CHK EQU :F09E TITL EDB EXCEPTION VECTOR EQUATES * * EDB EXCEPTION VECTOR EQUATES * * THE FOLLOWING XV:XXXXX SYMBOLS SPECIFY LOCATIONS IN THE EXCEPTION * VECTOR LOCATIONS OF THE ENVIRONMENT DESCRIPTOR TABLE (EDB). * XV:UINTP EQU :0 UNIMPLEMENTED INSTRUCTION TRAP XV:MEMTP EQU :1 MEMORY EXCEPTION TRAP XV:CNMTP EQU :2 CHARACTER/NUMERIC EXCEPTION TRAP XV:USRTP EQU :3 USER TRAP XV:AERTP EQU :4 ARITHMETIC EXCEPTION TRAP XV:STKTP EQU :5 STACK EXCEPTION TRAP XV:STKSV EQU :6 STACK EXCEPTION REGISTER SAVE AREA XV:USTEX EQU :8 UNIMPLEMENTED STRAP EXCEPTION XV:ST0EX EQU :9 STRAP   0 EXCEPTION XV:DOREX EQU :A DOOR SERVICE EXCEPTION XV:RTXEX EQU :B RTX SYSTEM ERROR SPACE 3 * * STACK EXCEPTION REGISTER SAVE AREA EQUATES * STKSV:A EQU 0 A REGISTER SAVE AREA STKSV:Q EQU 1 Q REGISTER SAVE AREA STKSV:X EQU 2 X REGISTER SAVE AREA STKSV:Y EQU 3 Y REGISTER SAVE AREA TITL ** MACRO: EDXVT:A * * GENERATE ENTRIES IN THE EXCEPTION VECTOR TABLE OF THE EDB. * THE EXCEPTION ADDRESS SPECIFIED WILL BE JUMPED TO IF THE * SPECIFIED EXCEPTION OCCURS. * * USAGE: * EDXVT:A ECB,EXCEPTION,ADDRESS * ECB = MUST MATCH FIRST PARAMETER OF ECB MACRO * EXCEPTION = EXCEPTION VECTOR OFFSET * ADDRESS = ADDRESS OF USER SUPPLIED EXCEPTION PROCESSOR * * NOTE: * IF ENVIRONMENT EXCEPTION PROCESSING IS TO BE SPECIFIED, THE * EDXVT:A MACRO MUST FOLLOW THE ECB:A MACRO. * ** SPACE 1 MACRO EDXVT:A !LOC::: SET $ SAVE LOCATION COUNTER ORG #1+ED:EVT+#2 ORG INTO EDB WORD #3 INSERT EXCEPTION PROCESSOR ADDRESS ORG !LOC::: ORG BACK TO WHERE WE WERE ENDM SPACE 3 SAVE END EDXVT:A ECB,EXCEPTION,ADDRESS * ECB = MUST MATCH FIRST PARAMETER OF ECB MACRO * EXCEPTION = EXCEPTION VECTOR OFFSET * ADDRESS = ADDRESS OF USER SUPPLIED EXCEPTION PROCESSOR * * NOTE: * IF ENVIRONMENT EXCEPTION PROCESSING IS TO BE SPECIFIED, THE * EDXVT:A MACRO MUST FOLLOW THE EC TITL R T X D . M A C - RTX DEVELOPMENT EQUATES & MACROS (93420-12-C1) * TASK DESCRIPTOR BLOCK EQUATES * TD:PER EQU 0 PEER LINK TD:FLG EQU 1 FLAGS TD:USA EQU 2 USAGE SEMAPHORE ADDRESS TD:NOX EQU 3 NUMBER OF CONCURRENT EXECUTIONS ALLOWED TD:Y EQU 4 Y-SCRATCHPAD SPECIFICATION TD:AD EQU 5 STACK LENGTH OR ADDRESS TD:AMT EQU 6 STACK LIMIT TD:P EQU 7 ADDRESS OF START OF TASK TD:CKW EQU 11  CHECK WORD (CONTAINS TD:CHK) * * ACTIVITY CONTROL BLOCK EQUATES * AC:PER EQU 0 PEER LINK AC:FLG EQU 1 FLAFS AC:PRI EQU 2 PRIORITY AC:K EQU 3 K-REGISTER AC:Y EQU  4 Y-REGISTER AC:L EQU 5 L-REGISTER AC:LST EQU 7 ENVIRONMENT ACTIVITY LIST PEER LINK AC:TDB EQU 8 TASK DESCRIPTOR BLOCK AC:ECB EQU 9 ENVIRONMENT CONTROL BLOCK AC:ID EQU  10 IDENTIFIER AC:CKW EQU 11 CHECK WORD (CONTAINS AC:CHK) * * ACB FLAGS * ACF:OD EQU 4  INDICATES EXECUTION OUTSIDE THE DOOR. TITL * ENVIRONMENT CONTROL BLOCK EQUATES * EC:PER EQU 0  PEER LINK EC:FLG EQU 1 FLAGS EC:EDB EQU 2 ENVIRONMENT DESCRIPTOR BLOCK POINTER EC:LUS EQU  3 LOGICAL UNIT SEMAPHORE EC:CNT EQU 6 # OF ACTIVITIES EC:ALH EQU 7 ACTIVITY LIST HEAD EC:SUB EQU 8 SUBORDINATE LIST HEAD EC:MST EQU 9 MASTER ENVIRONMENT EC:NEC EQU 10  NECESSARY ENVIRONMENT EC:CKW EQU 11 CHECK WORD (CONAINS EC:CHK) * * ENVIRONMENT DESCRIPTOR BLOCK EQUATES * ED:ECB EQU 0 ECB ADDRESS *WORDS 1-11 ARE A COPY OF ECB WORDS 1-11 IN THE ECB ED:EVO EQU 12  EXCEPTION VECTOR OFFSET (16) ED:MRO EQU 13 MAP REGISTER OFFSET (48) ED:EVT EQU 16 EXCEPTION VE  CTOR TABLE ED:UAT EQU 32 UNIT ASSIGNMENT TABLE ADDRESS ED:LMA EQU 33 LOW MEMORY ADDRESS ED:MPA  EQU 34 MEMORY POOL ADDRESS ED:HMA EQU 35 HIGH MEMORY ADDRESS ED:EUS EQU 36 ENVIRONMENT USAGE SEMAPHORE ED:PRI EQU 37 MAXIMUM PRIORITY ED:TLH EQU 38 TASK LIST HEAD ED:SLH EQU  39 SEMAPHORE LIST HEAD ED:MLH EQU 40 MAILBOX LIST HEAD * * ECB FLAGS * ECF:ND EQU 15  THIS ECB NOT DISPATCHABLE ECF:DA EQU 12 ECB WAS DYNAMICALLY ALLOCATED TITL * RTX EXCEPTION VALUES * ER:RTX EQU 2 RTX ERRORS, CLASS 2 EX:RTX EQU ER:RTX%8 EX:SEM EQU 1+EX:RTX SEMAPHORE EXCEPTION EX:STP EQU  2+EX:RTX STRAP OUT OF RANGE EX:STK EQU 3+EX:RTX INSUFFICIENT STACK SPECIFICATION EXCEPTION EX:EMP EQU 4+EX:RTX  UNABLE TO FILL E.M.P. REQUEST EX:SFP EQU 5+EX:RTX UNABLE TO FILL SYSTEM FREEPOOL REQUEST EX:PRI EQU 6+EX:RTX NEGATIVE ACTIVITY PRIORITY EX:CCB EQU 7+EX:RTX CCB EXCEPTION EX:TRP EQU 8+EX:RTX HARDWARE TRAP EXCEPTION EX:TBL EQU 9+EX:RTX DEBUG VERSION TABLE ID CHECK FAILURE EXCPT EX:SYS EQU 10+EX:RTX DEBUG VERSION, SYSTEM ACTIVITY VIOLATION EX:WCB EQU 11+EX:RTX CCB EXCEPTION, WALL CLOCK EX:MBX EQU 12+EX:RTX MAILBOX ID CHECK (INVALID ID) EX:ISS EQU :800 UNIMPLEMENTED SYSTEM SERVICE. EX:DBG EQU :900 STRAP 0 (REALTIME DEBUG BREAKPOINT) EX:UMT EQU :A00 UNINSTALLED MEMORY TRAP EX:SOT EQU :B00 STACK OVERFLOW TRAP EX:CNT EQU :C00 CHARACTER/NUMERIC TRAP EX:UIT EQU :D00 UNIMPLEMENTED INSTRUCTION TRAP EX:AET EQU :E00 ARITHMETIC ERROR TRAP EX:UST EQU :F00 USER TRAP TITL * MISCELLANEOUS EQUATES * R:CHEK SET 0  SELECT NON-DEBUGGING VERSION CHKOT: SET 1 TRUE FOR INHOUSE CHECK OUT. CHKOT: SET 0 FALSE FOR RELEASE STKMN: EQU 20 MINIMUM STACK TO BEGIN A TASK. SEMAX: EQU :100 SEMAPHORE MAXIMUM VALUE TCPRI: EQU :7000  TICK CLOCK PRIORITY WCPRI: EQU :6B00 WALL CLOCK ACTIVITY PRIORITY MAXIN: EQU :7FFF MAXIMUM TIC CLOCK INTERVAL SKAMT: EQU 23 STACK AMOUNT FOR CANNED ACTIVITY WALCP: EQU 30 WALL CLOCK PERIOD (MULTIPLES OF 8.33 MS) NDWCP: EQU 25 WALL CLOCK PERIOD FOR 50HZ LF RTC * * GENERAL CONTEXT BLOCK EQUATES * PEER: EQU 0 PEER LINK FLAGS: EQU 1 FLAGS MASTR: EQU 9 MASTER IDENT: EQU 10 IDENTIFIER CHECK: EQU 11 REDUNDANCY CHECK * * BEGIN CONTEXT BLOCK EQUATES * BEG:A EQU 1 A REGISTER BEG:Q EQU  2 Q REGISTER BEG:X EQU 3 X REGISTER BEG:Y EQU 4 Y REGISTER BEG:EC EQU 5 ECB ADDRESS BEG:TD EQU 6 TDB ADDRESS BEG:PR EQU 7 PRIORITY TITL * R:INIT BLOCK EQUATES * IN:A EQU 0  INITIAL A VALUE IN:Q EQU 1 INITIAL Q VALUE IN:X EQU 2 INITIAL X VALUE IN:Y EQU 3 INITIAL Y VALUE IN:ECB EQU 4 ECB ADDRESS FOR INITIAL ACTIVITY IN:TDB EQU 5   INITIAL TASK TO BE STARTED IN:PRI EQU 6 PRIORITY TO START INITIAL TASK AT IN:AID EQU 7 INITIALIZATION BLOCK ID IN:FPL EQU 8 FREEPOOL LENGTH (WORDS) IN:FPA EQU 9 FREEPOOL ADDRESS IN:EOM EQU 10 END-OF-MEMORY ADDRESS * * ENVIRONMENT MEMORY POOL EQUATES * EM:LEN EQU 0 IFT R:CHEK EM:XTR EQU 2 LEAVE TWO WORDS FOR DEBUG INFO ENDC IFF R:CHEK EM:XTR EQU 0 NOT DEBUG VERSION, NO EXTRAS NEEDED ENDC EM:PTR EQU EM:XTR+1 POINTER TO NEXT BLOCK TITL * CLOCK CONTROL BLOCK EQUATES * CC:PER EQU 0 PEER LINK CC:FLG EQU 1 FLAGS CC:TU EQU 2 WALL CLOCK EXPIRATION -- UPPER CC:TIC EQU CC:TU TICK CLOCK EXPIRATION CC:TL EQU 3 WALL CLOCK EXPIRATION -- LOWER CC:STS EQU 4 SEMAPHORE OR ADDRESS OF SEMAPHORE CC:BBA EQU CC:STS BEGIN BLOCK ADDRESS CC:ECB EQU 9  MASTER ENVIRONMENT CC:ID EQU 10 IDENTIFIER CC:CKW EQU 11 CHECK WORD (CONTAINS CC:CHK) TITL * SEMAPHORE DEFINITION BLOCK (SDB) EQUATES * SD:PER EQU 0 PEER LINK SD:FLG EQU 1  FLAGS SD:SEM EQU 2 SEMAPHORE SD:CKW EQU 3 CHECK WORD (CONTAINS SD:CHK) * * SEMAPHORE CONTROL EQUATES * SC:SEM EQU 0 SEMAPHORE WORD SC:CKW EQU 1 CHECKWORD * * MAILBOX DEFINITION BLOCK (MDB) EQUATES * MD:PER EQU 0 PEER POINTER MD:FLG EQU 1 FLAGS MD:MBX EQU 2  MAILBOX USAGE SEMAPHORE (IV=1) MD:MSG EQU 3 MESSAGE SIGNALLING SEMAPHORE (IV=0) MD:A EQU 4  A-REGISTER OF MESSAGE MD:Q EQU 5 Q-REGISTER OF MESSAGE MD:ECB EQU 9 MASTER ENVIRONMENT MD:ID EQU 10 IDENTIFIER MD:CKW EQU 11 CHECK WORD (CONTAINS MD:CHK) TITL * DEFBP: LABEL DEFINE LOCATION IN RTX BASE PAGE, * DEFBP: LABEL,N DEFINE N LOCATIONS IN RTX BASE PAGE, * * WHERE LABEL IS LABEL TO BE APPLIED TO LOCATION, * N IS OPTIONAL NUMBER OF CELLS. * MACRO DEFBP: #1 EQU BPLC: IFT #?=1 BPLC: SET BPLC:+1 ENDC IFF #?=1 BPLC: SET BPLC:+#2 ENDC ENDM * * * * CHKBP: LABEL CHECKS THAT THE LABEL CORRESPONDS TO * ITS ALLOCATION IN RTX BASE PAGE, * * WHERE LABEL IS THE LABEL ASSIGNED TO THE CURRENT * LOCATION COUNTER VALUE IN RTX BASE PAGE. * MACRO CHKBP: IFT #1-$ NOTE B,'ERROR IN BASE PAGE ALLOCATION' ENDC ENDM TITL * RTX BASE PAGE DEFINITIONS * R:SCRA EQU :20 START OF RTX SCRATCH PAD USAGE BPLC: SET R:SCRA DEFBP: R:ECBH DEFBP: R:ACT CURRENT ACTIVITY POINTER DEFBP: R:RDY READY LIST HEAD DEFBP: R:INTQ INTERRUPT QUEUE LIST HEAD  DEFBP: R:EMEM END OF REAL MEMORY DEFBP: R:FPH FREEPOOL LIST HEAD DEFBP: R:FPT FREEPOOL LIST TAIL DEFBP: R:NSRT R:WAIT DEFBP: R:SEMX RM:SEM X TEMPCELL DEFBP: R:SEMY RM:SEM Y TEMPCELL DEFBP : R:SVA STACK EXCEPTION, HOLDS A DEFBP: R:CCBH CCB LIST HEAD FOR TICK CLOCK REQUESTS DEFBP: R:WCBH  CCB LIST HEAD FOR WALL CLOCK REQUESTS DEFBP: R:INVL CURRENT TIC CLOCK INTERVAL DEFBP: R:CLKS TICK CLOCK WAIT SEMAPHORE DEFBP: R:NUIN TIC CLOCK INTERVAL TEMP CELL DEFBP: R:TODU TIME OF DAY UPPER DEFBP: R:TODL TIME OF DAY LOWER DEFBP: R:CHKQ CHK: MACRO TEMP CELL BPLC: SET :39 DEFBP: R:SAVE,6 CONTEXT SAVE ROUTINE DEFBP: R:SA12 INTERRUPT CONTEXT SAVE ROUTINE * * SYSTEM FREEPOOL BLOCK SIZE * BLKSZ: EQU 12 TITL * PUSH: -- PUSH REGISTER(S) ON STACK. * * PUSH: 4REG SIZE=5 * PUSH:  4REG,4REG =7,9 * PUSH: 4REG,4REG,4REG =9,11 * PUSH: 4REG,4REG,4REG,4REG  =13 * * WHERE 4REG IS ANY OF (A,Q,X,Y). NO REGISTER VALUES * EXCEPT K WILL CHANGE. STACK EXCEPTION MAY OCCUR. *  SIN WILL COVER NEXT INSTRUCTION. USES MACRO PUSH:1. * SECOND SIZE IS IF BOTH X AND Y ARE PUSHED. * MACRO PUSH:  PUSH:C #?,#1,#2,#3,#4 DETERMINE X AND Y USAGE. DUP ' JSK $+1',#? GET STACK SPACE SIN PUSH:X&PUSH:Y%1+#?+2 PROTECT THE SEQUENCE. PUSH:E EXCHANGE K AND INDEX REGISTER. PUSH:R #1,#?-1 PUSH FIRST. IFT #?>1 PUSH:R #2,#?-2 PUSH SECOND. ENDC IFT #?>2 PUSH:R #3,#?-3 PUSH THIRD. ENDC  IFT #?>3 PUSH:R #4,#?-4 PUSH FOURTH. ENDC PUSH:E RESTORE K AND INDEX REGISTER.  ENDM TITL * POP: -- POP REGISTER(S) FROM STACK. * * POP: 4REG SIZE=5 * POP: 4REG,4REG  =6,8 * POP: 4REG,4REG,4REG =7,9 * POP: 4REG,4REG,4REG,4REG =10 * * WHERE 4REG IS ANY OF (A,Q,X,Y). NO REGISTER VALUES * EXCEPT K WILL CHANGE. REGISTERS ARE POP:ED IN * REVERSE ORDER FROM LIST SO CORRESPONDING PUSH: AND * POP: CAN HAVE SAME ARGUMENT LIST. * SECOND SIZE IS IF BOTH X AND Y ARE PUSHED. *  MACRO POP: PUSH:C #?,#1,#2,#3,#4 DETERMINE X AND Y USAGE. SIN PUSH:X&PUSH:Y%1+#?+3 PROTECT THE SEQUENCE PUSH:E POP:R #1,#?-1 IFT #?>1 POP:R #2,#?-2 ENDC IFT #?>2 POP:R #3,#?-3 ENDC IFT #?=4 POP:R #4,#?-4 ENDC IFT PUSH:Y ADD =#?,X ENDC IFF PUSH:Y ADD =#?,Y ENDC PUSH:E ENDM TITL * COPY: -- COPY WITH K-RELATIVE ADDRESSING. * *  COPY: OFFSET(K),4REG * COPY: 4REG,OFFSET(K) * * WHERE OFFSET IS AN EXPRESSION FOR THE RELATIVE * LOCATION ON THE STACK. FOR EXAMPLE, OFFSET=0 IS * THE TOP OF THE STACK. (K) MEANS INDEXED BY K. * 4REG IS ANY OF (A,Q,X,Y). *  MACRO COPY: COPY:B COPY,#1,#2 ENDM TITL * EXCH: -- EXCH WITH K-RELATIVE ADDRESSING. * * EXCH: OFFSET(K),4REG * EXCH: 4REG,OFFSET(K) * * SEE DESCRIPTION OF COPY: * MACRO EXCH: COPY:B EXCH,#1,#2 ENDM TITL * ASTAK: -- ALLOCATE TEMP CELLS ON STACK. * * ASTAK: 4REG * ASTAK: NUMBER * WHERE NUMBER IS THE NUMBE R OF TEMP CELLS DESIRED. * 4REG IS ANY OF (A,Q,X,Y) WHICH CONTAINS NUMBER. * IF 4REG IS GIVEN, IT WILL BE USED AS WORKING CELL. * IF NUMBER IS GIVEN, INTERRUPTS WILL BE DISABLED. * AFTER ASTAK:, K POINTS TO BLOCK OF TEMP CELLS. *  MACRO ASTAK: R:4REG #1 FIND OUT IF ARG IS NUMBER OR 4REG. IFT R:REG JSK $+1 4REG.  SUB =1,#1 JNE #1,$-2 ENDC IFF R:REG ASTA:N SET #1/6*6 DIVIDE BY 6 LOCATIONS PER PUSH. ASTA:N SET #1-ASTA:N REMAINDER IS NUMBER OF JSK'S. IFT #1/6 IF MORE THAN 6 LOCATIONS, DUP ' PUSH :40',#1/6 ENDC IFT ASTA:N PERFORM REQUIRED NUMBER OF JSK'S. DUP ' JSK $+1',ASTA:N ENDC ENDC ENDM TITL * RSTAK: -- RELEASE TEMP CELLS TO STACK. * * RSTAK: 4REG * RSTAK: NUMBER * * WHERE NUMBER IS THE NUMBER OF TEMP CELLS TO BE RELEASED. * 4REG IS ANY OF (A,Q,X,Y) WHICH CONTAINS NUMBER. * MACRO RSTAK: R:4REG #1 FIND OUT IF ARG IS NUMBER OR 4REG. IFT R:REG ADD #1,K 4REG. ENDC IFF R:REG SIN 3 NUMBER. EXCH A,K ADD =#1,A EXCH A,K ENDC ENDM TITL * PUSH:R -- STORE A REGISTER IN THE STACK. * * PUSH:R 4REG,RELK * * WHERE 4REG IS ANY OF (A,Q,X,Y). RELK IS RELATIVE *  POSITION IN STACK WHERE REGISTER IS STORED (0-3). * MACRO PUSH:R IFT PUSH:Y IS X REGISTER BEING USED AS INDEX? IFT #(1,'X')>0 EXCH A,K YES, K CONTAINS USER'S X. COPY A,#2(X) EXCH A,K  ENDC IFT #(1,'X')=0 COPY #1,#2(X) NO, PUSH SPECIFIED REGISTER. ENDC ENDC IFF PUSH:Y IS Y REGISTER BEING USED AS INDEX? IFT #(1,'Y')>0 EXCH A,K YES, K CONTAINS USER'S Y. COPY A,#2(Y) EXCH A,K ENDC IFT #(1,'Y')=0 COPY #1,#2(Y) NO, COPY SPECIFIED REGISTER. ENDC ENDC ENDM TITL * POP:R -- REMOVE A REGISTER FROM THE STACK. * * POP:R 4REG,RELK * * WHERE 4REG IS ANY OF (A,Q,X,Y). RELK IS RELATIVE * POSITION IN STACK. * MACRO POP:R IFT PUSH:Y IS X BEING USED AS INDEX? IFT #(1,'X')>0 COPY A,K YES, POP INTO K INSTEAD. COPY #2(X),A EXCH A,K  ENDC IFT #(1,'X')=0 COPY #2(X),#1 ENDC ENDC IFF PUSH:Y IS Y BEING USED AS INDEX? IFT #(1,'Y')>0 COPY A,K YES, POP INTO K INSTEAD. COPY #2(Y),A EXCH A,K ENDC IFT #(1,'Y')=0 COPY #2(Y),#1 ENDC ENDC ENDM TITL * PUSH:E -- EXCHANGE STACK POINTER AND INDEX REGISTER. * * PUSH:E * * PUSH:Y INDICATES WHETHER Y IS BEING PUSHED. * MACRO PUSH:E IFT PUSH:Y IS Y BEING PUSHED? EXCH X,K YES, USE X FOR PUSHING. ENDC IFF PUSH:Y NO, USE Y FOR PUSHING. EXCH Y,K ENDC ENDM TITL * PUSH:C -- CHECK FOR INDEX REGISTER USAGE * * PUSH:C #?,#1,#2,#3,#4 * * DETERMINES IF ARGUMENTS TO PUSH: OR POP: INCLUDE X OR Y. * PUSH:X=0 IFF NO REFERENCE TO X. * PUSH:Y =0 IFF NO REFERENCE TO Y. MACRO PUSH:C PUSH:X SET 0 RESET BOTH FLAGS. PUSH:Y SET 0 IFT #(2,'X')>0 PUSH:X SET 1 ENDC IFT #(2,'Y')>0 PUSH:Y SET 1 ENDC IFT #1=2 IS THERE A SECOND?  IFT #(3,'X')>0 PUSH:X SET 1 ENDC IFT #(3,'Y')>0 PUSH:Y SET 1 ENDC ENDC IFT #1=3 IS THERE A THIRD? IFT #(4,'X')>0 PUSH:X SET 1 ENDC IFT #(4,'Y')>0 PUSH:Y SET  1 ENDC ENDC IFT #1=4 IS THERE A FOURTH? PUSH:X SET 1 YES, UNLESS REGISTERS ARE DUPLICATED, PUSH:Y SET 1 THEN BOTH X AND Y MUST BE PRESENT. ENDC ENDM TITL MACRO COPY:B SIN  3 COPY:L SET #(2,'(K)')-1 IFT COPY:L>0 IFT #(3,'Y')>0 EXCH K,X #(1) #(2,1,COPY:L)(X),Y EXCH K,X ENDC IFF #(3,'Y')>0 EXCH K,Y #(1) #(2,1,COPY:L)(Y),#(3)  EXCH K,Y ENDC ENDC IFF COPY:L>0 COPY:L SET #(3,'(K)')-1 IFT #(2,'Y')  EXCH K,X #(1) #(3,1,COPY:L)(X),Y EXCH K,X ENDC IFF #(2,'Y') EXCH K,Y #(1) #(3,1,COPY:L)(Y),#(3) EXCH K,Y ENDC ENDC ENDM TITL * R:4REG -- DETERMINE IF AN ARGUMENT IS A 4REG. * * R:4REG #N * * WHERE #N IS THE ARGUMENT TO BE TESTED. * R:REG=1 IFF ARGUMENT IS ANY OF (A,Q,X,Y). * MACRO R:4REG R:REG SET 0 IFT #(1,?)=1 TEST FOR ONLY ONE CHARACTER IFT #(1,'A')+#(1,'Q')+#(1,'X')+#(1,'Y')>0 R:REG SET 1 ENDC ENDC ENDM TITL * CHK: -- MAKE SURE A BLOCK IS OF THE CORRECT TYPE. * * CHK: 4REG,CKW,(OFFSET) * * WHERE 4REG IS ANY OF (A,Q,X,Y), WHICH CONTAINS THE ADDRESS OF * A BLOCK WHICH IS TO BE VERIFIED. OFFSET IS OPTIONAL. IT * SPECIFIES THE DISPLACEMENT OF THE CHECKWORD FROM THE BEGINNING *  OF THE BLOCK, THE DEFAULT VALUE IS CHECK:. CHW MAY BE EITHER * THE LABEL OF A LOCATION CONTAINING THE CHECK VALUE, OR A LITERAL * PRECEDED BY AN EQUAL SIGN. * MACRO CHK: IFT R:CHEK CS: SET CHECK: IFT #?=3 CS: SET #3 ENDC * IFT #(1,'X');#(1,'Y') SIN 3 COPY Q,R:CHKQ COPY #2,Q  CSK Q,CS:(#1) SIN 1 JST R:TABL COPY R:CHKQ,Q ENDC * IFF #(1,'X');#(1,'Y') EXCH #1,X SIN 3 COPY Q,R:CHKQ COPY #2,Q CSK Q,CS:(X) SIN  1 JST R:TABL COPY R:CHKQ,Q EXCH #1,X ENDC ENDC ENDM TITL * SYS:A -- GENERATE CANNED ACTIVITY ACB AND STACK * * SYS:A ACB,PRI,START,R:L,R:K * * WHERE ACB IS ADDRESS OF THE ACTIVITY ACB *  PRI IS THE PRIORITY OF THE ACTIVITY * START IS THE BEGIN EXECUTION ADDRESS * R:L IS THE ACTIVITY STACK LIMIT *  R:K IS THE INITIAL K REGISTER VALUE * * NOTE: * SKAMT: IS THE STACK AMOUNT ALLOCATED TO A * CANNED SYSTEM ACTIVITY * MACRO SYS:A * ACTIVITY STACK #4 EQU $ STACK LIMIT RES SKAMT:-CBL: RESERVED F OR STACK EXPANSION * INITIAL CONTEXT #5 WORD #4 L-REGISTER WORD XA:V STATUS RES 4,0  ALL REGISTER 0 WORD #3 P-REGISTER * * ACTIVITY ACB * #1 EQU $ ACB LABEL  RES 2,0 DUMMY PEER POINTER,FLAGS WORD #2 PRIORITY WORD #5 K OF INITIAL CONTEXT RES 1,0 NO Y-SCRACH PAD WORD #4 STACK LIMIT RES 5,0 DUMMY ECB,TCB,.... WORD AC:CHK DEBUG TABLE ID ENDM SPACE 3 SAVE END XA:V STATUS RES 4,0  ALL REGISTER 0 WORD #3 P-REGISTER * * ACTIVITY ACB * #1 EQU $ ACB LABEL / / RTX:ASM --- ASSEMBLE ALL RTX FILES (93411-70-C1) / /MACRO RTXCOMN(D=GEN(L)+RTX(L)+RTXD(L,S),NOO), RTXDOOR(NOO), RTXTASK(NOO), RTXSEMA4(NOO), RTXTICK(NOO), RTXWALL(NOO), RTXOTHER(NOO), RTXMPMGR(NOO), RTXDISP(NOO), RTXEXPR(NOO), RTXDATE(NOO), RTXECB(NOO), RTXMISC(NOO) / OM790111120000OM790111120000OM790111120000/ RTX:LIB --- CREATE RTX LIBRARY (93411-71-C1) / ALL OBJECT FILES ASSUMED TO BE ON UF / CREATES LIBRARY ON UF / /DE RTX.LIB /CO RTX.LIB=RTXCOMN.OBJ /CO RTX.LIB=RTX.LIB+DEBUG4.OBJ /CO RTX.LIB=RTX.LIB+RTXDOOR.OBJ /CO RTX.LIB=RTX.LIB+RTXTASK.OBJ /CO RTX.LIB=RTX.LIB+RTXSEMA4.OBJ /CO RTX.LIB=RTX.LIB+RTXTICK.OBJ /CO RTX.LIB=RTX.LIB+RTXWALL.OBJ /CO RTX.LIB=RTX.LIB+RTXOTHER.OBJ /CO RTX.LIB=RTX.LIB+RTXMPMGR.OBJ /CO RTX.LIB=RTX.LIB+RTXDISP.OBJ /CO RTX.LIB=RTX.LIB+RTXEXPR.OBJ /CO RTX.LIB=RTX.LIB+RTXDATE.OBJ /CO RTX.LIB=RTX.LIB+RTXECB.OBJ /CO RTX.LIB=RTX.LIB+RTXMISC.OBJ ASSUMED TO BE ON UF / CREATES LIBRARY ON UF / /DE RTX.LIB /CO RTX.LIB=RTXCOMN.OBJ /CO RTX.LIB=RTX.LIB+DEBUG4.OBJ /CO RTX.LIB=RTX.LIB+RTXDOOR.OBJ /CO RTX.LIB=RTX.LIB+RTXTASK.OBJ /CO RTX.LIB=RTX.LIB+RTXSEMA4.OBJ /CO RTX.LIB=RTX.LIB+RTXTICK.OBJ /CO RTX.LIB=RTX.LIB+RTXWALL.OBJ /CO RTX.LIB=RTX.LIB+RTXOTHER.OBJ /CO RTX.LIB=RTX.LIB+RTXMPMGR.OBJ /CO RTX.LIB=RTX.LIB+RTXDISP.OBJ /CO RTX.LIB=RTX.LIB+RTXEXPR.OBJ /CO RTX.LIB=RTXNAM BUF:N BUF:N EQU #1 DUP ' BUF:R1',#1 ENDM * * BUF:R1 - GENERATES BUFFERS, CALLED ONLY BY BUF:R MACRO * MACRO BUF:R1 CHAN BUF: CHAIN LINK CHAN BUF:: STATIC LINK RES  4,0 WORD BUF:LN LENGTH RES 2,0 SECTOR RES 7,0 SPARES RES BUF:LN/2,0 ENDM * IOB:A IOB,LUN,OPC,OPM,BCT,BUF,CGI,OPO * * * IOB LABEL TO BE ASSIGNED TO START OF IOB * LUN LOGICAL UNIT NAME OR NUMBER * OPC OPERATION CODE * RE: EQU 0 READ * AR: EQU 1 WRITE *  PO: EQU 2 POSITION * FU: EQU 3 FUNCTION * OPM OPERATION MODIFIER * UF: EQU 0 UNFORMATTED * FA: EQU 1 FORMATTED ALPHANUMERIC * FB: EQU 2 FORMATTED BINARY * DA: EQU 3 DIRECT FORMATTED ALPHA * DB: EQU 4 DIRECT FORMATTED BINARY * WP: EQU 5 WRITE PROMPT * * BCT  REQUESTED BYTE COUNT * BUF I/O BUFFER ADDRESS * CGI ADDRESS OF CURRENT GRANULE INDEX OR ZERO * OPO OPTIONAL MODE OF OPERATION * SB: EQU 11 START IN SECOND BYTE OF BUFFER * * MACRO IOB:A IFT #?<7  NOTE 5,'NOT ENOUGH PARAMETERS' ENDC #1 WORD #2 LOGICAL UNIT NAME /NUMBER WORD 0 DEVICE DEDICATION NUMBER WORD #7 OPTIONAL ADDRESS OF CGI S: SYMVAL #8 IFF S:=0 IFT #8>15 S: SET #8 VALUE, NOT BIT EQUATE ENDC IFF #8>15 S: SET 1%#8 ENDC ENDC WORD #3%4+#4+S: WORD #5  BYTE COUNT WORD #6 I/O BUFFER ADDRESS WORD 0 ACTUAL COUNT PROCESSED WORD 0 SOFTWARE STATUS ENDM TITL * INPUT/OUTPUT BLOCK (IOB) * IO:LUN EQU 0 LOGICAL UNIT NAME/NUMBER IO:DDN EQU 1 DEVICE DEDICATION NUMBER IO:CRI EQU 2 ADDRESS OF CURRENT RECORD INDEX IO:CFI EQU IO:CRI CURRENT FILE INDEX POINTER IO:FC EQU 3 FUNCTION CODE IO:BCT EQU 4 BYTE COUNT REQUESTED IO:BUF EQU 5 I/O BUFFER ADDRESS IO:ACT EQU 6 ACTUAL COUNT PROCESSED IO:ST EQU 7 SOFTWARE STATUS * * FUNCTION CODE BITS * * BITS 15-6 MODE OF OPERATION ER: EQU 12 DON'T CALL DOIO ERROR ROUTINE,GO TO USER SB: EQU 11 START ON SECOND BYTE OF BUFFER HA: EQU 10 USED BY HALT I/O FUNCTION. UD: EQU 9 UN-DEDICATE DEVICE AFTER PERFORMING I/O * ER:V EQU 1%ER: SB:V EQU 1%SB: * * RE: EQU 0 READ WR: EQU 1 WRITE PO: EQU 2 POSITION FU: EQU  3 FUNCTION OPEN: EQU 4 OPEN CLOSE: EQU 5 CLOSE * * * BITS 3-0 OPERATION MODIFIER * READ & WRITE UF: EQU 0 UNFORMATTED FA: EQU :B FORMATTED ALPHANUMERIC FB: EQU :A FORMATTED BINARY FS: EQU :8 FORMATTED STREAM WP: EQU 1 WRITE PROMPT DA: EQU :F  DIRECT ALPHANUMERIC DB: EQU 6 DIRECT BINARY DS: EQU :C DIRECT STREAM BS: EQU FS:  SEQUENTIAL STREAM BINARY SA: EQU :9 SEQUENTIAL STREAM ALPHA RB: EQU FB: SEQUENTIAL RECORD BINARY RA: EQU FA: SEQUENTIAL RECORD ALPHA DSB: EQU DS: DIRECT STREAM BINARY DSA:  EQU :D DIRECT STREAM ALPHA DRB: EQU :E DIRECT RECORD BINARY DRA: EQU DA: DIRECT RECORD ALPHA * * FOR POSITION * * FOR POSITION (PO:) * FAB: EQU 0 FILE POINTER ABSOLUTE BYTES FRB: EQU 1 FILE POINTER RELATIVE BYTES WAB: EQU 2 WRITE POINTER ABSOLUTE BYTES WRB: EQU 3  WRITE POINTER RELATIVE BYTES AR: EQU 4 ABSOLUTE RECORDS RR: EQU 5 RELATIVE RECORDS RFP: EQU 6 READ FILE POINTER RWP: EQU 7 READ WRITE POINTER * * FOR FUNCTION OP: EQU 0 OPEN CL: EQU 1 CLOSE PL: EQU 2 PUNCH LEADER WF: EQU 3 WRITE FILE MARK DF: EQU 4 DEVICE DEPENDENT FUNCTION SS: EQU 5 SELECT HARDWARE STATUS TF: EQU 6 TO P OF FORM SC: EQU 7 SOFTWARE CONTROL * * FOR OPEN BL: EQU 1 BLOCK I/O * * SOFTWARE STATUS * IOERR: EQU 15  ERROR CAUSED I/O TERMINATION * BITS 13-12 DESCRIBE CONCURRENT CONDITIONS TFORM: EQU 1%12 TOP OF FORM BFORM: EQU 2%12 BOTTOM OF FORM * RETRY: EQU 11 A RETRY WAS REQUIRED TO PERFORM THE OPERAT EOM:  EQU 10 END OF MEDIUM ENCOUNTERED DURING OPERATION DELDA: EQU 9 DELETED DATA READ FROM FLOPPY DISK * *  IOS4 ERROR CODES * BITS 0-5 OF STATUS WORD CONTAIN LOWER BYTE OF ORROR CODE * BIT 6 SET FOR UNRECOVERABLE *  ERROR CLASSES ER:IOR EQU 0 I/O RECOVERABLE ER:IOU EQU 1 I/O UNRECOVERABLE SPACE 3 *  NORMAL RETURN CODES NORML: EQU 0 NORMAL I/O COMPLETION EOF: EQU 1 END OF FILE (GOING FORWARD) BOF: SET 3 SPACE 3 * MACROS FOR IOS4 ERROR CODES * IOU: FOR UNRECOVERABLE, IOR: FOR RECOVERABLE MACRO IOU: #1 EQU 1%6+#2 ENDM MACRO IOR: #1 EQU #2 ENDM SPACE 3 * ERROR CODES IOR: HALTD:,1 I/O HALTED IOR: NORDY:,2 NOT READY IOR: WRTPR:,3 WRITE PROTECT IOR: TIMOT:,4 TIME OUT IOR: PWRFL:,5 POWER FAIL & UNABLE TO RECOVER  IOR: DDTNA:,6 DDT NOT AVAILABLE,CFM ONLY IOR: VOLNU:,7 VOLUME NOT ON UNIT IOR: VOLNF:,8  VOLUME NOT FOUND IOR: NOREL:,9 LOGICAL UNIT NOT RELEASED IOR: AGAIN:,10 TRY AGAIN SPACE 3 IOU: CKSUM:,1 BAD CHECK SUM IOU: UNDEV:,2 UNASSIGNED DEVICE IOU: NIUAT:,3  LUN NOT IN UAT IOU: REOM:,4 REACHED END OF MEDIA IOU: HARDW:,5 HARDWARE ERROR IOU:  ILLOP:,6 ILLEGAL OPERATION FOR THIS DEVICE IOU: NEMEM:,7 NON-EXISTANT MEMORY ADDR IOU: INRTX:,8 MEMORY ADDR IN SYSTEM ARTEA IOU: DIRFL:,9 DIRECTORY FULL IOU: NOLAB:,10 DISK NOT LABELED  IOU: FAOV:,11 FILE ADDR OVERFLOW IOU: ILLAU:,12 ILLEGAL AU IOU: AUNF:,13 AU NOT FOUND IOU: WDEOF:,14 WRITE DIRECT HIT EOF IOU: NOTXT:,15 NOT EXTENDABLE IOU: ILLFA:,16  ILLEGAL FILE ADDR IOU: ALOFU:,17 ALLOCATION TABLE FOULED UP IOU: SYSUG:,18 SYSTEM USAGE ONLY  IOU: FCBCH:,19 FCB CHAIN BAD IOU: FILEO:,20 FILE OPEN IOU: NOPEN:,21 FILE NOT OPEN  IOU: FNOP:,21 FILE NOT OPEN IOU: OONWR:,22 OLD OR NEW WRONG, CFM ONLY IOU: ILLFP:,22 ILLEGAL FILE POINTER IOU: NOUNT:,23 UNIT NOT GIVEN IOU: UNFCB:,24 UNASSIGNED FCB IOU: BUFWP:,25 BUFFER HAS WRITE PENDING IOU: NOAU:,26 NO MORE FREE AU'S IOU: BADTC:,27 BAD TYPE CODE IOU: ABORT:,28 ABORT IOU: RTXER:,63 RTX ERROR SPACE 3 * * I/O ERROR BLOCK EQUATES SPACE 3 IOE:AC EQU 0 ACB ADDR OF ERROR ACTIVITY IOE:EC EQU 1 ERROR CODE IOE:K E QU 2 K-REG OF ACTIVITY WITH ERROR IOE:DI EQU 3 DIB ADDR IOE:TI EQU 4 TIB ADDR  SPACE 3 SAVE END WRITE PENDING IOU: NOAU:,26 NO MORE FREE AU'S IOU: BADTC:,27 BAD TYPE CODE IOU: ABORT:,28 ABORT IOU: RTXER:,63 RTX ERROR SPACE 3 * * I/O ERROR BLOCK EQUATES SPACE 3 IOE:AC EQU 0 ACB ADDR OF ERROR ACTIVITY IOE:EC EQU 1 ERROR CODE IOE:K E TITL I O S D . M A C - IOS DEVELOPMENT EQUATES & MACROS (93420-14-C1) * I/O ERROR BLOCK EQUATES * IOE:AC EQU 0  ACB ADDR OF ERROR ACTIVITY IOE:EC EQU 1 ERROR CODE IOE:K EQU 2 K-REG OF ACTIVITY WITH ERROR IOE:DI EQU 3 DIB ADDR IOE:TI EQU 4 TIB ADDR TITL * DEVICE INFORMATION BLOCK (DIB) * DI:PER EQU 0 PEER POINTER DI:FLG EQU 1 DIB FLAGWORD DI:CIB EQU 2 MASTER CIB ADDRESS DI:FCB EQU 3 FILE CONTROL BLOCK LIST HEAD DI:NAM EQU 4 DEVICE NAME (4 CHARACTERS) DI:DN EQU 6 DEDICATION NUMBER DI:DS EQU 7 DEDICATION SEMAPHORE DI:SPB EQU 8 WATCHDOG TIMER -- NUMBER OF SHIFTS PER BYT DI:WBT EQU 9 WATCHDOG TIMER -- BASE TIME DI:DSW EQU 10 DEVICE SPECIFICATION WORDS (10-13) *  14-15 RESERVED * * DIB FLAGWORD * EQU 15 ALWAYS ZERO FOR DIB DIF:ND EQU 14  NO DEDICATION ON THIS DEVICE DIF:DP EQU 13 DI:DDN IS A POINTER TO A DEDICATION NUMBER DIF:NT EQU 12  NO TIMER FOR READ DIF:RT EQU 11 RETRY ON POWER FAIL DIF:FC EQU 10 FORM CONTROL DIF:OP EQU 9 DEVICE IS OPEN. DIF:UI EQU 1 DEVICE SUPPORTS UNSOLICITED INPUT DIF:BF EQU 0 BUFFER FLAG FOR CARD READER DIF:MT EQU 0 DISK IS MOUNTED DIF:NM EQU 1 NO AUTOMATIC MOUNT ON DISK TITL * DEVICE INFORMATION BLOCK FOR CHARACTER DEVICES * DI:CPL EQU 16 CHARACTERS PER LINE DI:LPP EQU 17 BOTTOM OF FORM COUNT/LINES PER PAGE DI:BMI EQU 18 BRANCH/MODE WORD FOR INPUT DI:BMO EQU 19 BRANCH/MODE WORD FOR OUTPUT DI:EOL EQU 20 POINTER TO END OF LINE SEQUENCE DI:TOF EQU 21 POINTER TO TOP OF FORM SEQUENCE DI:ERM EQU 22 ERROR MASK FOR STATUS DI:LC EQU 23 LINE COUNTER DI:EDT EQU 24  EDIT CHARACTER DI:ELI EQU 25 END OF LINE SEQUENCE FOR INPUT DI:BUF EQU 26 POINTER TO 2 WORD INTERNAL BUFFER DI:PU EQU 27 POINTER TO POWER UP SEQUENCE * * DEVICE INFORMATION BLOCK FOR CARD READER * *I:CPL EQU 16 CHARACTERS PER CARD *I:LPP EQU 17 =0, NOPAGES ON CARD READER *I:BMI EQU 18  BRANCH/MODE WORD FOR INPUT DI:CBA EQU 19 CURRENT BUFFER ADDR DI:ABA EQU 20 ALTERNATE BUFFER ADDR, =0 FOR NO DOBLE BUF DI:TRT EQU 21 TRANSLATION TABLE ADDR *I:ERM EQU 22 ERROR MASK FOR STATSUS TITL * DEVICE INFORMATION BLOCK FOR DISKS * DI:BPS EQU 16 BYTES PER SECTOR DI:SPT EQU 17   SECTORS PER TRACK DI:TPC EQU 18 TRACKS PER CYLINDER DI:CPD EQU 19 CYLINDERS PER DISK DI:SPA EQU 20 SECTORS PER ALLOCATION UNIT DI:CYL EQU 21 CUURRENT CYLINDER FOR FLOPPY DI:TRY EQU 22  HARD/RATE ERROR RETYR COUNT DI:VTS EQU 23 VTOC SEMAPHORE DI:ATS EQU 24 ALLOCATION TABLE SEMAPHORE DI:HOS EQU 25 HEAD OFFSET DI:HSA EQU 26 HEAD SEMAPHORE ADDR DI:SCS EQU 27  SEEK COMPLETE SEMAPHORE ADDR DI:FLP EQU 28 FLIST POINTER IN AU DI:FLN EQU 29 FLIST LENGTH IN SECTORS DI:ALO EQU 30 ALLOCATION TABLE SECTOR ADDR DI:APD EQU 31 AU PER DISK DI:BPA EQU 32 BYTES PER AU DI:SBF EQU 33 SECTORS PER BUFFER DI:SAU EQU 34 DI:BIT EQU 35 BIT # DI:CUR EQU 36 CURRENT COUNT DI:REQ EQU 37 REQUESTED NUMBER OF AUS DI:FND EQU 38  NUMBER FOUND DI:FAU EQU 39 FOUND AU START TITL * CONTROLLER INFORMATION BLOCK (CIB) * CI:PER EQU 0 PEER POINTER CI:FLG EQU 1 CIB FLAGWORD CI:MST EQU 2 MASTER LINK CI:DIB EQU 3  SUBORDINATE LINK (DIB LIST HEAD) CI:PRI EQU 4 REQUEST PRIORITY CI:DA EQU 5 DEVICE ADDRESS CI:IV EQU  6 DEVICE INTERRUPT VECTOR LOCATION CI:RD EQU 8 ENTRY POINT TO READ CI:WRT EQU 9 ENTRY POINT TO WRITE CI:POS EQU 10 ENTRY POINT TO POSITION CI:FUN EQU 11 ENTRY POINT TO FUNCTION CI:EOB EQU 12 12-15 EOB SEQUENCE * JST R:SA12 USE SYSTEM STACK * COPY TIB,Y  TIB ADDR OBVIOUSLY * JMP *$+1 * DATA I:EOB EOB ADDR CI:T1 EQU 16 TEMP CI:T2 EQU  17 TEMP CI:APR EQU 18 SAVEED PRIORITY OF ACTIVITY USING CIB CI:TIB EQU 19 TIB ADDR CI:USM EQU 20 CONTROLLER USAGE SEMAPHORE CI:TIM EQU 21 WATCH DOG TIMER CALCULATED INTERVAL CI:CSM EQU 22 COMPLETION SEMAPHORE CI:CFL EQU 23 COMPLETION FLAG * * CIB FLAGWORD * CIF:PU EQU 14 POWER UP OCCURED CIF:TO EQU 13 TIME OUT CAUSED COMPLETION CIF:OO EQU 12 OVERLAPPED OPERATIONS TITL * CONTROLLER INFORMATION BLOCK FOR DISK * CI:RAT EQU 24 RATE ERROR RETRY COUNT CI:HRD EQU 25 HARD ERROR RETRY COUNTER CI:OPC EQU 27 OP CODE CI:DCB EQU CI:OPC  START OF DISK CONTROL BLOCK CI:UNT EQU 28 UNIT CI:CYL EQU 29 CYLINDER CI:SEK EQU 30  RELATIVE SEEK COUNT CI:SEC EQU 31 SECTOR CI:CNT EQU 32 WORD COUNT CI:BUF EQU 33  BUFFER ADDR CI:IEA EQU 34 INTERUPT ENABLE & ADDR * * CONTROLLER INFORMATION BLOCK FOR HIGH CAPACITY DISK * CI:IOB EQU 35 NEXT IOB ADDR CI:WP EQU 36 WORDS PROCESSED CI:CST EQU 37  CONTROLLER SATTUS CI:DST EQU 38 DRIVE STATUS CI:DIV EQU 39 INTERUPT VECTOR, JSK CI:EOB CI:SSA E QU 40 SEEK COMPLETE SEMAPHORE ADDR * * FLOPPY DISK CONTROLLER INFORMATION BLOCK * CI:FWP EQU 35  WORDS PROCESSED CI:FST EQU 36 STATUS CI:FIV EQU 37 INTERUPT VECTOR CI:FT1 EQU 38  TEMP CI:EIV EQU 39 ERROR INTERUPT VECTOR TITL * TEMPORARY INPUT BLOCK (TIB) - USER'S STACK * TI:IOB EQU 0 IOB ADDRESS TI:FCB EQU 1 FCB ADDR TI:DIB EQU 2 DIB ADDRESS TI:CIB EQU 3 CIB ADDRESS TI:BCT EQU 4 REQUESTED BYTE COUNT TI:BUF EQU 5 BUFFER ADDRESS TI:FC EQU 6 FUNCTION CODE TI:SOF EQU 7 SOFTWARE STATUS TI:PRI EQU 13 TEMPOARY SAVE FOR ACTIVITIES PRIORITY. * * TIB ON ENTRY TO HANDLERS * TI:CRI EQU 12 ADDR OF CURRENT RECORD INDEX * *  TIB FOR DIO * TI:TIM EQU 8 WATCHDOG TIMER VAQLUE TI:ACT EQU 9 ACTUAL BYTE COUNT TI:BMW EQU  10 BRANCH/MODE WORD TI:IBF EQU 11 INTERMEDIATE BUFFER ADDR * * TIB FOR DISKS * *TI:TIM EQU 8 WATCHDOG TIMER VAQLUE TI:SEC EQU 9 SECTOR NUMBER TI:TRK EQU 10 TRACK NUMBER (HEAD NUMBER) TI:CYL EQU 11 CYLINDER NUMBER * * TIB ON RETURN FROM HANDLERS * *TI:ACT EQU 9  ACTUAL BYTE COUNT TI:HWS EQU 10 HARDWARE STATUS (TWO WORDS) TI:HW2 EQU 11 HARDWARE STATUS WORD 2 * * TIB EQUATES * TI:T1 EQU 14 TEMP CELL TI:T2 EQU 15 TEMP CELL TI:T3 EQU 16  TEMP CELL TI:T4 EQU 17 TEMP CELL TI:QUO EQU 18 RELATIVE AU TI:REM EQU 19 REMIANDER OF SECTOR OR AU CALCULATION TI:RAU EQU 20 EXTENT RELATIVE AU BASE TI:PAU EQU 21 EXTENT PHYSICAL AU BASE TI:NAU EQU 22 NUMBER OF AUS IN EXTENT TI:FP1 EQU 23 WORKING FILE POINTER TI:FP2 EQU 24 WORKING FILE POINTER TI:WRQ EQU 25 WORKING REQUEST COUNT TI:PL EQU TI:WRQ PARAMETER LIST ADDR TI:WAC EQU 26 WORKING ACTUAL COUNT TI:FNO EQU TI:WAC FNO TI:WSF EQU 27 WOKING SOFTWARE STATUS TI:UBX EQU 28 USERS BUFFER INDEX TI:CAU EQU 29 CURRENT AU TI:CNX EQU 30 CURRENT INDEX TI:T5 EQU 31 TEMP CELL TI:T6 EQU 32 TEMP CELL TI:FCS EQU 33 FUNCTION CODE SAVE TI:BCS EQU 34 BYTE COUNT SAVE TI:BUS EQU 35 BUFFER ADDR SAVE TIBLN: EQU 36 TIB LENGTH TITL * DISTRIBUTED I/O * IODAD: SET :F IOD ADDRESS (MAY ONLY BE :C,:D,:E OR :F) IODIB: SET :C0 IOD INTERRUPT ADDRESS BASE * CRCN: SET 0  CARD READER CHANNEL NUMBER CRDA: SET IODAD:%3+CRCN:%1 . DEVICE ADDRESS CRIA: SET CRCN:%3+IODIB: . INTERRUPT ADDRESS * MTCN: SET 1 MAGNETIC TAPE CONTROLLER CHANNEL NUMBER MTDA: SET IODAD:%3+MTCN:%1 . DEVICE ADDRESS MTIA: SET MTCN:%3+IODIB: . INTERRUPT ADDRESS * TVCN: SET 2 CRT CHANNEL NUMBER TVDA: SET IODAD:%3+TVCN:%1 .   DEVICE ADDRESS TVIA: SET TVCN:%3+IODIB: . INTERRUPT ADDRESS * IECN: SET 3 IEEE INTELLIGENT CABLE CHANNEL NUMBER IEDA: SET IODAD:%3+IECN:%1 . DEVICE ADDRESS IEIA: SET IECN:%3+IODIB: . INTERRUPT ADDRESS * TYCN: SET 4 TELETYPEWRITER CHANNEL NUMBER TYDA: SET IODAD:%3+TYCN:%1 . DEVICE ADDRESS TYIA: SET TYCN:%3+IODIB: . INTERRUPT ADDRESS * PRCN: SET 5 HIGH SPEED PAPER TAPE READER CHANNEL NUMBER PRDA: SET IODAD:%3+PRCN:%1 . DEVICE ADDRESS PRIA: SET PRCN:%3+IODIB: . INTERRUPT ADDRESS * PPCN: SET 6 HIGH SPEED PAPER TAPE PUNCH CHANNEL NUMBER PPDA: SET IODAD:%3+PPCN:%1 . DEVICE ADDRESS PPIA: SET PPCN:%3+IODIB: .  INTERRUPT ADDRESS * LPCN: SET 7 LINE PRINTER CHANNEL NUMBER LPDA: SET IODAD:%3+LPCN:%1 . DEVICE ADDRESS LPIA: SET LPCN:%3+IODIB: . INTERRUPT ADDRESS TITL *  NON-DIO * DFCN: SET :11 DISK, FLOPPY DFDA: SET DFCN:%3 . DEVICE ADDRESS * DMCN: SET :14 DISK, MEDIUM CAPACITY DMDA: SET DMCN:%3 . DEVICE ADDRESS * DHCN: SET :15  DISK, HIGH CAPACITY DHDA: SET DHCN:%3 . DEVICE ADDRESS TITL * MISCELLANEOUS EQUATES * CI:EOB EQU :C R:SA12 EQU :3F LF: EQU :A FF: EQU :C CR: EQU :D * * BUILD A WORD OF BITS MACRO * BIT:WORD MACRO WORD MACLAB BIT:EQU MACENT EQU MACLAB BIT:SET MACENT SET MACLAB BIT:SET SET 0 * BIT:LOOP MACENT NULL IFT #(1,?) BIT:SET SET 1//#(1)++BIT:SET BIT:LOOP #(2),#(3),#(4),#(5),#(6),#(7),#(8) ENDC IFF '##(0,1,1)'='N' #(-1) #(0) BIT:SET ENDC ENDM TITL * MACRO FOR INTERUPT SEQUENCE * INT:SEQ MACRO EXTR I:EOB JST R:SA12  COPY =$-CI:EOB-1,X CIN ADDR JMP *$+1 WORD I:EOB ENDM * * PATCH MACRO * PATCH:  MACRO CORG: SET $ ORG #(1) WORD #(2) ORG CORG: ENDM * * STANDARD DIB MACRO * DIB:ST MACRO LOAD D:#(1) ENDM TITL * MEDIUM/HIGH CAPACITY DISK DIB MACRO * DIB:DM MACRO DM DIB:DH MACENT DH MB: SYMVAL #2 MEGABYTES IFT #(0,'DM') SPT: SET 12 SECTORS PER TRACK TPC: SET 2 TRACKS PER CYLINDER SPA: SET 1 SECTORS PER AU CPD: SET 203 CYLINDERS PER DISK, 5MB IFT MB:=10 CPD: SET 406 ENDC ENDC IFT #(0,'DH') TPC: SET 5 SPT: SET 32 CPD: SET 823 SPA: SET 8 IFT MB:=40 CPD: SET 411 SPA: SET 4 ENDC IFT MB:=150 TPC: SET 19 CPD: SET 411 ENDC IFT MB:=300 SPA: SET 16 TPC: SET 19 ENDC ENDC APD: SET SPT:*TPC:*CPD:/SPA: AU'S PEWR DISK NAM D:#(1) D:#(1) CHAN #(0):  DI:PER WORD 0 DI:FLG WORD C:#(1,1,3) DI:CIB CHAN Z:#(1) DI:FCB  BYTE '##(1)' DI:NAM RES 1,0 DI:DN WORD 0 DI:DS WORD -9   DI:SPB WORD 1*8 DI:WBT BIT:WORD FA:,FB:,DA:,DB:,UF: BIT:WORD FA:,FB:,DA:,DB:,UF: BIT:WORD  BIT:WORD OP:,CL: RES 2,0 WORD 512 DI:BPS WORD SPT: DI:SPT WORD TPC: DI:TPC WORD CPD: DI:CPD WORD SPA: DI:SPA WORD -1 DI:CYL  BYTE 3,10 DI:TRY WORD 1 DI:VTS WORD 1 DI:ATS IFT #(0,'DM')  BYTE 1,'##(1,4,4)'-'0'&1*2 DI:HOS ENDC IFT #(0,'DH') WORD 0 DI:HOS ENDC WORD 0,0 WORD APD:/2 DI:FLP WORD CPD: DI:FLN WORD APD:/2+CPD: WORD APD: DI:APD WORD 512*SPA: DI:BPA WORD 1 DI:SBF RES 6,0 ENDM TITL * MEDIUM/HIGH CAPACITY DISK CIB MACRO * CIB:DM MACRO DM CIB:DH MACENT DH DEVAD: SYMVAL #(2) IFT #(2,?)=0 DEVAD: SET #(0)DA: STANDARD DEVICE ADDR ENDC IFT DEVAD:<:20 DEVAD: SET DEVAD:%3 ENDC NAM C:#(1,1,3) EXTR DK:RD,DK:WRT,DK:FUN C:#(1,1,3) CHAN CIB: CI:PER RES 2,0 CHAN #(0): CI:DIB WORD :7600 CI:PRI WORD DEVAD: WORD 0,0 WORD DK:RD,DK:WRT,0,DK:FUN  INT:SEQ CI:EOB RES 4,0 WORD 1 CI:USM WORD 0,0,0 RES 15,0  JSK C:#(1,1,3)+CI:EOB LPOOL ENDM TITL * LINE PRINTER DIB MACRO * DIB:LP MACRO LP CPL: SET  80 CHARACTERS PER LINE LPP: SET 57 LINES PER PAGE BOF: SET 3 BOTTOM OF FORM COUNT IFF #(2,?)=0 CPL: SET #(2) ENDC IFF #(3,?)=0 LPP: SET #(3) ENDC  NAM D:#(1) D:#(1) CHAN #(1,1,3): BIT:WORD DIF:FC DI:FLG - FLAG WORD EXTR C:#(1,1,3) WORD C:#(1,1,3) WORD 0 BYTE '##(1)' RES 1,0 WORD 0 WORD -3 WORD 4*8 BIT:WORD BIT:WORD FA:,UF: BIT:WORD BIT:WORD OP:,CL:,WF:,SC:,TF: RES 2,0 WORD CPL: BYTE BOF:,LPP:  WORD 0 WORD :1210 WORD !LP:CR WORD !LP:TF WORD :3202 WORD -LPP:  WORD 0 WORD 0 WORD !LP:BF WORD !LP:PU !LP:PU WORD 3 BYTE :FF,CR:,LF:,0 !LP:CR WORD 2 IFT #(4,?)=0 BYTE ' ',CR: ENDC IFF #(4,?)=0 BYTE CR:,#4 ENDC !LP:TF WORD 2  BYTE FF:,CR: !LP:BF RES 2,0 ENDM SPACE 3 SAVE END WORD CPL: BYTE BOF:,LPP:  WORD 0 WORD :1210 WORD !LP:CR WORD !LP:TF WORD :3202 WORD -LPP:  WORD 0 WORD 0 WORD !LP:BF WORD !LP:PU !LP:PU WORD 3 BYTE :FF,CR:,LF:,0 ! TITL RTX THE DOOR - RTXDOOR - 93411-10 C1 ***************************************************************** * * PROGRAM HISTORY * * REV B3 - START HISTORY * * REV C1 - ADDED F:DMNT (DISMOUNT) TO DOOR TABLE E.W. 1/16/79 * ********* ********************************************************* NAM R:IDOR,R:ODOR EXTR R:SERB,R:SERL EXTR R:EXPT,R:BEGX EXTR R:TABL,R:RTXEX EXTR R:DOOREX DOOR EXIT EXCEPTION PROCESSOR EXTR R:USTREX UNIMPLEMENTED STRAP EXCEPTION PROCESSOR TITL * * THE DOOR IS THE ONLY MEANS OF USER ACCESS TO * THE USER SERVICE ROUTINES. CONTROL COMES TO * R:IDOR FROM THE SYSTEM INTERRUPT LOCATION. SPACE 1 ROM REL SPACE 1 R:IDOR EQU $ PUSH XA:V  SAVE CALLERS CONTEXT, TURN ON XA SIN 1 COPY SYTA:,X GET CALLERS P COUNT COPY SYTA:+1,Q  GET STRAP INSTRUCTION WORD (PERM ASG) COPY 0(X),A CALLERS PARAMETER ADD =1,X STEP OVER PARAMETER COPY K,Y STACK ADDRESS(PERM ASG) COPY X,LAST:P(Y) PUT IT ON THE STACK COPY A,X CALLERS PARAMETER TO X TITL * * EVALUATE STRAP ADDRESSING MODE * TBIT 14,Q JF OV,RB14 IF M4D12 OR DIRECT ADDRESS TBIT 13,Q IS IT INDIRECT OR ? JF OV,INDIR IF INDIRECT * * 11 - CASE * NOTE: AN R2 FIELD OF 3 IS UNDEFINED 1/5/77 * JMP ERROR INVALID ADDRESS MODE IS STRAP * * 10 - CASE * INDIRECT ADDRESSING * INDIR COPY 0(X),X GET THE CONTENTS OF THE ADDRESSED LOCATION JMP GOTX NOW DO THE INDEXED JUMP CALCULATION * * BIT 14 WAS ZERO * RB14 EQU $ * * 01 - CASE * DIRECT ADDRESS * TBIT 13,Q JT OV,GOTX IF DIRECT, CALCULATION IS DONE TITL * * 00 - CASE * M4D12 PARAMETER DECODING - A IS CUMULATIVE REGISTER * NOTE A,X CONTAIN SAME VALUE WHEN COMING HERE * AND =:0FFF,A ISOLATE D12 EXCH A,X SWAP SO D12 IN X, ORIGINAL IN A TBIT 12,A PUT BIT 12 IN OV JLT A,M4REL JUMP IF BIT 15 SET * * ABSOLUTE DISPLACEMENT * JF OV,M4IDR IF NO Y-INDEX  ADD LAST:Y(Y),X ADD Y VALUE TO DISPL JMP M4IDR GO DO INDIRECTION CHECK * * RELATIVE DISPLACEMENT * M4REL EQU $ JF OV,$+2 IF POSITIVE DISPLACEMENT NEG X,X MAKE NEGATIVE DISPLACEMENT ADD LAST:P(Y),X ADD (P)+1 TO DISPLACEMENT * * NOW TEST INDIRECT BIT * M4IDR EQU $ TBIT  14,A INDIRECT BIT TO OV JF OV,$+2 IF DIRECT GO ON TO INDEXING COPY 0(X),X GET CONTENTS OF LOCATION TBIT 13,A X INDEXING BIT JF OV,$+2 IF NO X-INDEXING ADD LAST:X(Y),X  ADD CALLERS X TITL * * COMPLETED DECODE OF PARAMETER * NOW GOTO THE SERVICE REQUESTED, Q CONTAINS STRAP * GOTX EQU $ AND =:FF,Q GET THE INDEX COPY R:SERL,A GET THE SERVICE TABLE LENGTH SUB Q,A  IS INDEX VALID JLT A,ERROR IF TOO BIG COPY =R:SERB,Y GET TABLE BASE ADDRESS ADD Q,Y ADD INDEX JSK *0(Y) GO TO REQUESTED SERVICE JMP R:ODOR GOTO OUT DOOR PROCESS * INVALID STRAP ERROR EQU $ JMP R:USTREX UNIMPLEMENTED STRAP EXCEPTION LPOOL * TITL * * THIS IS THE ONLY MEANS OF USER RETURN FROM A * SYSTEM SERVICE ROUTINE. A CHECK IS MADE FOR * AN EXCEPTION, IF ONE OCCURRE D THE EXCEPTION * PROCESSING IS INITIATED. IF THERE WAS NOT AN * EXCEPTION OR IF THE EXCEPTION IS HANDLED BY * THE EXCEPTION TASK, CONTROL RETURNS TO THE * USER. * R:ODOR EQU $ JGE A,TOUSR IF NO EXCEPTION JMP R:DOOREX DOOR EXIT EXCEPTION * * TOUSR EQU $ * RESTORE USERS CONTEXT POP * RETURN TO USER RSK  LPOOL END TITL RM:DOR -- THE DOOR S4141* 93414-1* TITL RM:SER -- SERVICE REQUEST TABLE NAM R:SERL,R:SERB EXTR R:STR0EX STRAP 0 EXCEPTION PROCESSOR EXTR R:BGIN,R:END,R:SIG,R:WAIT EXTR R:SEND,R:RECV EXTR R:CINT,R:ITIC EXTR R:GPRI,R:SPRI EXTR I:IO EXTR R:PAUS EXTR R:ABUF,R:RBUF EXTR R:STOD,R:GTOD,R:IWAL,R:AWAL EXTR R:CTIC,R:MTIC,R:CWAL SEXT F:CONN SEXT F:DELE SEXT F:CREA SEXT F:MONT SEXT F:CFNO SEXT R:GATD SEXT R:SATD SEXT F:DMNT SPACE 1 ROM REL 0 SPACE 1 R:SERB EQU $ WORD R:STR0EX STRAP 0 EXCEPTION WORD R:SIG SIGNAL SERVICE ADDRESS WORD R:WAIT WAIT SERVICE ADDRESS WORD R:BGIN BEGIN SERVICE ADDRESS WORD R:END END SERVICE ADDRESS WORD R:SPRI SET PRIORITY WORD R:GPRI GET PRIORITY WORD I:IO I/O SYSTEM CALLS WORD R:CINT  CONSOLE INTERRUPT SERVICE WORD R:SEND MAILBOX SEND ROUTINE WORD R:RECV MAILBOX RECIEVE ROUTINE WORD  R:ITIC IN TICK WORD R:PAUS ROUND ROBIN SERVICE WORD R:ABUF ALLOCATES A BUFFER FROM THE ENVIRONMENT MEMORY WORD R:RBUF RETURTNS A BUFFER TO THE ENVIRONMENT MEMORY POOL WORD R:STOD SET TIME OF DAY WORD R:GTOD  GET TIME OF DAY WORD R:AWAL ABSOLUTE TIME REQUEST WORD R:IWAL INTERVAL TIME REQ VEST WORD R:CTIC  CANCELL TICK CLOCK REQUEST WORD R:MTIC MODIFY TICK CLOCK REQUEST WORD R:CWAL CANCELL WALL CLOCK REQUEST WORD F:CREA SFM CREATE SERVICE WORD F:DELE SFM DELETE SERVICE WORD F:CONN SFM CONNECT SERVICE WORD F:MONT SFM MOUNT SERVICE WORD F:CFNO SFM CONNECT FNO SERVICE WORD R:GATD GET ASCII TIME OF DAY WORD R:SATD SET ASCII TIME OF DAY WORD F:DMNT SFM DISMOUNT SERVICE * R:SERE EQU $ R:SERL WORD R:SERE-R:SERB LENGTH OF SERVICE JUMP TABLE END TICK CLOCK REQUEST WORD R:CWAL CANCELL WALL CLOCK TITL RTX TASK CONTROL - RTXTASK - 93411-11 B3 NAM R:BEGI,R:END,R:BGIN NAM R:PRID EXTR R:GPR EXTR R:BTC1 EXTR R:GVSH,R:GVST,R:GTS EXTR R:GETM,R:GIVM EXTR R:IACB EXTR R:SACT,R:ODOR,R:DISP EXTR R:DA,R:DAQX EXTR R:TABL EXTR R:RTXEX FATAL RTX EXCEPTION PROCESSOR TITL R:BGIN -- BEGINS AN ACTIVITY * * THIS SERVICE SETS UP THE ACB AND OBTAINS THE RESOURCES * FOR AN ACTIVITY TO BE CREATED. * * WHEN CONTROL IS RECIEVED FROM THE DOOR THE X REGISTER * WILL CONTAIN THE ADDRESS OF AN ARGUMENT LIST AS FOLLOWS: * TDB: EQU 0 INDEX TO TASK DESCRIPTOR BLOCK ADDRESS * 0(X)=ADDRESS OF TASK DECRIPTOR BLOCK PRI: EQU 1 INDEX TO PRIORITY DESCRI PTOR * 1(X)=PRIORITY DESCRIPTOR TO START TASK AT * SPACE 1 ROM REL SPACE 1 IFT CHKOT: G:B EQU $ ENDC R:BGIN EQU $ COPY X,Y SAVE ARGUMENT LIST ADDRESS JSK R:GTS GET A SYSTEM FREEPOOL BLOCK JGE A,FPOK0 IF NO EXCEPTION RSK * SET UP BEGIN CONTEXT INFO BLOCK FPOK0 EQU $ IFT R:CHEK COPY =1,A COPY A,CHECK:(X) PUT PHONY ID INTO BLOCK ENDC EXCH X,Y COPY:M TDB:(X),A,BEG:TD(Y) TDB ADDRESS TO BEGIN CONTEXT BLOC COPY PRI:(X),Q SET UP PRIORUTY EVALUATION CALL JSK R:PRID EVALUATE PRIORITY DESCRIPTOR JGE A,PRIOK IF LEGAL PRIORITY COPY Y,X PRIORITY EXCEPTION, RETURN RESOURCES COPY A,Y SAVE EXCEPTION CODE JSK R:GVSH RETURN CONTEXT BLOCK TO FREEPOOL COPY Y,A RELOAD EXCEPTION CODE RSK RETURN * PRIOK EQU $  COPY Q,BEG:PR(Y) PUT PRIORITY INTO BEGIN CONTEXT BLOCK COPY Y,X CONTEXT ADDRESS TO X COPY K,Y COPY:M LAST:A+1(Y),A,BEG:A(X) A REGISTER COPY:M LAST:Q+1(Y),A,BEG:Q(X) Q REGISTER COPY:M LAST:X+1(Y),A,BEG:X(X) X REGISTER COPY:M LAST:Y+1(Y),A,BEG:Y(X) Y REGISTER COPY R:ACT,Y CURRENT ACTIVITIES ACB COPY:M AC:ECB(Y),A,BEG:EC(X) ECB ADDRESS JSK R:BEGI FINISH BEGINNING ACTIVITY RSK  LPOOL TITL * * BEGINS AN ACTIVITY * CALLED WITH X = ADDRESS OF BEGIN CONTEXT FREEPOOL BLOCK * * BEGIN CONTEXT BLOCK DEFINITION * * WORD 0 -- RESERVED * * WORD 1 -- A REGISTER FOR NEW ACTIVITY * * WORD 2 Q REGISTER FOR NEW ACTIVITY * * WORD 3 X REGISTER FOR NEW ACTIVITY * * WORD 4 Y REGISTER FOR NEW ACTIVITY * * WORD 5 ECB ADDRESS * * WORD 6 TDB ADDRESS * * WORD 7 PRIORITY TO BEGIN ACTIVITY AT * * R:BEGI EQU $  PUSH: Y FREE UP Y REGISTER COPY X,Y COPY BEG:TD(Y),X CHK: X,=TD:CHK DEBUG CHECK FOR TDB TABLE ID COPY TD:AMT(X),A GET STACK SIZE JLT A,STKOK A < 0 => SIZE > 32K SUB =STKMN:,A CHECK TO SEE IF > MIN JGE A,STKOK IF IT PASSES COPY =-EX:STK,A EXCEPTION - TO SMALL STACK SPEC JMP BEGX1 TITL * SET UP ACB STKOK EQU $ JSK R:GTS GET FREEPOOL BLOCK FOR THE ACB JLT A,BEGX1 IF EXCEPTION IFT R:CHEK IF DEBUG VERSION COPY:M =AC:CHK,A,AC:CKW(X) SET UP ACB TABLE ID WORD ENDC COPY:M BEG:TD(Y),A,AC:TDB(X) COPY:M BEG:EC(Y),A,AC:ECB(X) ECB ADDRESS COPY:M BEG:PR(Y),A,AC:PRI(X) JGE A,PRIOK1 JSK R:GVSH COPY =-EX:PRI,A LOAD PRIORITY ERROR BEGX1 EQU $ COPY Y,X FREEPOOL BLOCK ADDRESS COPY A,Y SAVE EXCEPTION CODE JSK R:GVSH COPY Y,A RELOAD EXCEPTION CODE POP: Y RSK TITL PRIOK1 EQU $ COPY Y,AC:K(X) JSK R:SACT MUST BE SYSTEM ACT TO DO REST OF BEGIN WORD R:BEGS CODE TO BE EXECUTED AS SY S.ACT. POP: Y RESTORE CALLERS Y REG RSK LPOOL TITL * FINISH BEGINNING ACTIVITY * SYSTEM ACTIVITY -- MUST BE ON THE SYSTEM STACK * X= CALLERS K AFTER CONTEXT SAVE IN R:SACT * LAST:X OF CALLERS STACK IS THE NEW ACB'S ADDRESS * R:BEGS EQU $ COPY LAST:X(X),X ACB ADDRESS CHK: X,=AC:CHK DEBUG TABLE ID CHECK, ACB COPY AC:TDB(X),Y TDB ADDRESS CHK: Y,=TD:CHK DEBUG TABLE ID CHECK, TDB COPY *TD:USA(Y),A CAN AN ACTIVITY OF THIS TASK BE STARTED JLE A,NOTAV IF NOT AVAILABLE SUB =SEMAX:,A JGT A,NOTAV IF SOMEONE IS WAITING ALREADY ADD =SEMAX:-1,A DECREMENT SEMAPHORE COPY A,*TD:USA(Y)  PUT NEW VALUE BACK JMP R:BG2A * NOTAV EQU $ COPY *TD:USA(Y),Q TASK SEMAPHORE TO Q JSK R:IACB PUT ACB INTO TASK WAIT LIST COPY Q,*TD:USA(Y) PUT TASK SEMAPHORE BACK JMP R:DISP TITL * THE TASK IS AVAILABLE * R:END ENTERS HERE IF ACTIVITY IS WAITING * MUST BE ON SYSTEM STACK * X CONTAINS ACB ADDRESS R:BG2A EQU  $ CHK: X,=AC:CHK DEBUG CHECK FOR ACB TABLE ID COPY X,R:BTC1 SAVE ACB ADDRESS COPY =0,A COPY A,AC:FLG(X) CLEAR FLAG WORD COPY AC:TDB(X),Y GET TDB ADDRESS COPY TD:AD(Y),X GET STACK ALLOCATION REQUIREMENTS JNE X,GOTSTK IF TASK DEFINED STACK COPY TD:AMT(Y),A REQUEST SIZE TO A COPY R:BTC1,X GET ACB ADDRESS COPY AC:ECB(X),X ECB TO GET MEMORY FROM JSK R:GETM  GET STACK SPACE FROM EMP; X=ADDRESS JGE A,GOTSTK IF REQUEST WAS FILLED COPY AC:K(X),X GET ACB ADDRESS COPY A,Y SAVE EXCEPTION CODE JSK R:GVSH RETURN ACB BLOCK TO FREEPOOL COPY R:BTC1,X GET CONTEXT BLOCK ADDRESS JSK R:GVSH RETURN CONTEXT BLOCK COPY Y,A NOSUP EQU  $ JMP R:DA A TO CALLERS CONTEXT,, TO DISPATCHER * TITL * GOTSTK EQU $ COPY R:BTC1,Y ADDRESS OF ACB BEING BEGAN COPY X,AC:L(Y) PUT STACK ADDRESS IN ACB COPY X,A SAVE NEW STACK L  COPY AC:TDB(Y),X TDB ADDRESS ADD TD:AMT(X),A CALCULATE NEW K COPY A,X EXCH X,AC:K(Y) SAVE USERS K, GET INITIAL CONTEXT BLK ADDR COPY A,Y USERS STACK K SUB =7,Y MAKE ROOM FOR INITIAL CONTEXT ON STACK * SET UP NEW ACTIVITIES CONTEXT COPY:M BEG:A(X),A,LAST:A(Y) A REGISTER COPY:M BEG:Q(X),A,LAST:Q(Y) Q REGISTER COPY:M BEG:X(X),A,LAST:X(Y) X REGISTER COPY:M BEG:Y(X),A,LAST:Y(Y) Y REGISTER SUB =7,Y MAKE ROOM ON STACK FOR WORKING CONTEXT JSK R:GVSH RETURN INITIAL CONTEXT BLOCK TO SFP TITL * SET UP WORK CONTEXT IN NEW ACB COPY R:BTC1,X ACB ADDRESS OF NEW ACB COPY Y,AC:K(X) PUT K IN ACB COPY AC:L(X),A PUT L ON NEW STACK COPY A,LAST:L(Y) COPY A,LAST:P+LAST:L+1(Y) L FOR STARTING USER COPY S,A PUT S ON NEW STACK COPY A,LAST:S(Y) USERS INIT IAL S COPY =NUACT,A COPY A,LAST:P(Y) SET P TO START AT NUACT SIN 2 NO INTERRUPTS WHILE IN R:INTQ LIST COPY R:INTQ,Q INSERT THE ACB INTO R:INTQ COPY Q,AC:PER(X) COPY X,R:INTQ  JMP R:DISP * END OF SYSTEM ACTIVITY LPOOL * TITL NUACT -- INITIAL SEQUENCE OF NEW ACTIVITY * * NUACT  EQU $ COPY =R:ODOR,A SET UP EXIT THROUGH THE DOOR PUSH: A JSK R:SACT CREATE SYSTEM ACTIVITY TO GET ACTIVITIES WORD SNUACT . Y-SCRATCH PAD * EXIT TO THE DOOR; THEN TO START OF NEW ACTIVITY CODE  RSK TITL * * BEGINNING OF SYSTEM ACTIVITY * * THSI ACTIVITY --- * INCREMENTS THE ECB ACTIVITY COUNT *  SETA UP THE Y- SCRATCHPAD POINTER AC:Y AND INITIAL CONTEXT * SETS UP THE S AND P REGISTERS IN THE INITIAL CONTEXT N EQU 8 DEPTH TO LAST CONTEXT ON STACK * SNUACT EQU $ COPY R:ACT,Y GET CURRENT ACB ADDRESS  COPY AC:ECB(Y),X ECB ADDRESS IMS EC:CNT(X) BUMP ACTIVITY COUNT COPY AC:TDB(Y),X TDB ADDRESS COPY TD:Y(X),A TASKS Y-SCRATCHPAD SPECIFICATION COPY AC:K(Y),X USERS K COPY LAST:Y+N(X),X Y FORM ACTIVITY THAT STARTED THIS TASK JEQ A,GOTY IF USING STARTERS Y AREA COPY AC:ECB(Y),X  ECB TO GET MEMORY FROM JSK R:GETM GET Y SPACE FROM EMP JGE A,GOTY IF REQUEST WAS FILLED * EXCEPTION -- REQUEST FOR SCRATCHPAD SPACE COUNLD NOT BE FILLED JMP R:DAQX A,Q,X TO CALLERS CONTEXT, TO DISPATCHER TITL GOTY EQU $ COPY X,A SAVE Y ADDRESS COPY A,AC:Y(Y) Y INTO ACB  COPY AC:K(Y),X USERS K COPY A,LAST:Y+N(X) PUT Y INTO USERS INIT CONTEXT COPY AC:TDB(Y),Y TDB ADDRESS CHK: Y,=TD:CHK TABLE ID CHECK FOR DEBUG VERSION COPY TD:P(Y),A USERS INITIAL P COPY A,LAST:P+N(X) . TO INITIAL CONTEXT * GET INITIAL STATUS BITS COPY TD:FLG(Y),A AND =B7:V;XA:V;B3:V;BY:V;OV:V;CY:V,A COPY A,LAST:S+N(X) PUT STATUS IN INITIAL CONTEXT JMP R:DISP * END OF SYSTEM ACTIVITY TITL R:END -- ENDS AN ACTIVITY * * * R:END EQU $ * NOTHING OF VALUE IN X JSK R:SACT CREATE SYSTEM ACTIVITY TO DO END WORD SYSEND SYSTEM ACTIVITY START ADDRESS HLT TITL * BEGINNING OF SYSTEM ACTIVITY M EQU 8 DEPTH IN STACK TO LAST CONTEXT SYSEND EQU $ COPY R:ACT,Y GET ACB ADDRESS OF ACTIVITY TO BE ENDED COPY AC:ECB(Y),X ECB ADDRESS CHK: X,=EC:CHK COPY EC:CNT(X),A DECREMENT THE ACTIVITY COUNT SUB =1,A COPY A,EC:CNT(X) * REMOVE ACB FROM R:RDY LIST COPY AC:PER(Y),A GET CURRENT ACB'S LINK COPY A,R:RDY MAKE THIS HEAD OF LIST * WAS ACTIVITY'S Y-SCRATCHPAD SYSTEM ALLOCATED COPY AC:TDB(Y),X GET TDB ADDRESS CHK: X,=TD:CHK COPY TD:Y(X),A Y-SCRATCHPAD SPEC JEQ A,END1 IF NOT SYSTEM ALLOCATED * STACK WAS SYSTEM ALLOCATED, RETURN IT TO EMP ? COPY AC:Y(Y),A GET Y-SCRATCHPAD ADDRESS   COPY AC:ECB(Y),X ECB TO RETURN IT TO JSK R:GIVM RETURN BLOCK TO E.M.P. * PUT ADDRESS OF END REQUEST IN ACB END1 EQU $ COPY AC:K(Y),X STACK ADDRESS COPY LAST:P+M(X),A USERS REQUEST ADDRESS  COPY A,AC:K(Y) INTO ACB TITL * WAS STACK SYSTEM ALLOCATED? COPY AC:TDB(Y),X TDB ADDRESS CHK: X,=TD:CHK DEBUG CHECK FOR TDB TABLE ID COPY X,R:BTC1 SAVE TDB ADDRESS COPY TD:AD(X),A  STACK ADDRESS JNE A,END2 IF NOT SYSTEM ALLOCATED * STACK WAS SYSTEM ALLOCATED- RETURN SPACE COPY AC:L(Y),A STACK BLOCK ADDRESS COPY AC:ECB(Y),X ECB TO RETURN IT TO JSK R:GIVM RETURN BLOCK TO E.M.P. * RETURN ACB TO SYSTEM FREEPOOL END2 EQU $ COPY Y,X MOVE ACB ADDRESS JSK R:GVST  RETURN ACB TO SYSTEM FREEPOOL TAIL * TEST TDB SEMAPHORE COPY R:BTC1,Y TDB ADDRESS COPY *TD:USA(Y),A SEMAPHORE JLT A,WAITR IF ACTIVITY IS WAITING SUB =SEMAX:,A JGT A,WAITR IF ACTIVITY IS WAITING JLT A,NOWT IF NOT EQUAL TO 127 COPY =EX:SEM,A SEMAPHORE EXCEPTION JST R:RTXEX REPORT EXCEPTION NOWT EQU $ IMS *TD:USA(Y) INCREMENT SEMAPHORE JMP R:DISP RETURN TO DISPATCHER * TITL * SOMEONE WAS WAITING FOR TASK, MUST BEGIN HIM. WAITR EQU $ SIN 3 PROTECT LIST COPY *TD:USA(Y),X COPY AC:PER(X),A GET FIRST ACB OFF SEMAPHORE LIST COPY A,*TD:USA(Y) REPLACE LINK CHK: X,=AC:CHK DEBUG CHECK FOR VALID TABLE ID JMP R:BG2A GO START UP THIS ACTIVITY  LPOOL * TITL R:PRID -- EVALUATES PRIORITY DESCRIPTOR * * CALL: Q= PRIORITY DESCRIPTOR * JSK R:PRID * RETURN: Q = VALUE OF PRIORITY * X = ACB ADDRESS * R:PRID EQU $ TBIT 15,Q REL / ABS BIT JF  OV,PRIABS SHIFT Q,LO,1 PROPAGATE 15 BIT SIGNED INTEGER SHIFT Q,RA,1 . TO 16 BIT SIGNED INTEGER JSK R:GPR CURRENT PRIORITY TO A, LEAVES Q INTACT ADD A,Q CALCULATE RELATIVE PRIORITY PRIABS EQU $ COPY =0,A ASSUME GOOD STATUS JGE Q,PRIDRT IF NOT NEGATIVE PRIORITY  COPY =-EX:PRI,A LOAD EXCEPTION STATUS PRIDRT EQU $ RSK LPOOL END REL / ABS BIT JF  TITL RTX SEMAPHORE - RTXSEMA4 - 93411-12 B3 NAM R:SIG,R:ISIG,R:SSIG NAM R:WAIT,R:IWAI,R:SWAI  EXTR R:SACT,R:DISP EXTR R:IACB EXTR R:DA EXTR R:TABL TITL R:SIG -- SIGNAL SERVICE ROUTINE * * THIS ROUTINE SIGNALS THE SEMAPHORE ADDRESSED * BY THE X REGISTER. * * SPACE 1 ROM REL SPACE 1 R:SIG EQU $ CHK: X,=SD:CHK,SC:CKW VERIFY ID * INTERNAL CALLS ENTER HERE R:ISIG EQU $ JSK R:SACT CREATE A SYSTEM ACTIVITY (SYSTEM STACK) WORD USIGN TO START AT USIGN AND DO THE SIGNAL * SIGNAL IS DONE, RETURN TO CALLER RSK * BEGINING OF SYSTEM ACTIVITY * THIS CAN ONLY BE EXECUTED ON THE SYSTEM STACK * USIGN CALLS THE SIGNAL SUBROUTINE AND UPD ATE THE USERS A REGISTER * X CONTAINS THE CALLERS STACK ADDRESS USIGN EQU $ COPY LAST:X(X),X GET SEMAPHORE ADDRESS OUT OF CONTEXT JSK R:SSIG DO THE ACTUAL SIGNAL OPERATION JMP R:DA A TO CALLERS CONTEXT,, TO DISPATCHER * END OF SYSTEM ACTIVITY LPOOL * TITL R:SIGI -- INTERNAL SIGNAL ROUTINE * * IMPORTANT * * MUST BE ON THE SYSTEM STACK * * * ENTRY : X CONTAINS THE SEMAPHORE ADDRESS * * R:SSIG EQU $ COPY X,A  SAVE SEMAPHORE ADDRESS SIN 7 COPY 0(X),Q SEMAPHORE TO Q JLT Q,AWAIT IF ANY WAITS ; MEG MUST BE ADDRESS SUB =SEMAX:,Q IS ANYONE WAITING? JGT Q,AWAIT IF ANY WAITS * NO ONE IS WAITING ON THE SEMAPHORE JEQ Q,SEMEX IF ALREADY 127 IMS 0(X) INCREMENT THE SEMAPHORE  JMP SIGRT GO RETURN TITL * * SOMEONE IS WAITING ON THIS SEMAPHORE AWAIT EQU $ * REMOVE FIRST ACB FROM SEMAPHORE COPY 0(X),X FIRST ACB ADDRESS COPY AC:PER(X),Q SAVE LINK POINTER EXCH A,X SEMAPHORE ADDRESS COPY Q,0(X) LINKOUT ACB COPY A,X ADDRESS OF ACB CHK: X,=AC:CHK DEBUG CHECK FOR VALID TABLE ID SIN 2 COPY R:INTQ,Q INSERT THE ACB INTO R:INTQ  COPY Q,AC:PER(X) EXCH R:INTQ,X SIGRT EQU $ COPY =0,A RETURN SUCCESS STATUS * RETURN  RSK SEMEX EQU $ COPY =-EX:SEM,A RETURN EXCEPTION CODE,X=SEMAPHORE ADDRESS * RETURN RSK  LPOOL TITL * * WAITS ON THE SEMAPHORE ADDRESSED BY -X- REGISTER * R:WAIT EQU $ CHK: X,=SD:CHK,SC:CKW VERIFY ID * INTERNAL CALLS ENTER HERE R:IWAI EQU $ JSK R:SACT CREATE A SYSTEM ACTIVITY WORD IWAIT  TO DO THE WAIT * REUTRN TO USER WHEN DONE RSK * BEGINNING OF SYSTEM ACTIVITY * X=CALLERS STACK ADDRESS OF THE LAST CONTEXT * LAST:X(X) = ADDRESS OF SEMAPHORE TO WAIT ON IWAIT EQU $ COPY LAST:X(X),X SEMAPHORE ADDRESS COPY =R:IACB,A SET UP INSERT ROUTINE LINKAGE COPY A,R:NSRT JSK R:SWAI GO DO A WAIT JMP R:DA A TO CALLERS CONTEXT,, TO DISPATCHER TITL * X=SEMAPHORE ADDRESS * MUST BE ON SYSTEM STACK R:SWAI EQU $ COPY Y,R:SEMY SAVE CALLERS Y COPY =0,Y COPY =-SEMAX:,Q MAX SEMAPHORE VALUE  SIN 5 EXCH Y,0(X) SEMAPHORE VALUE AND 0 JLE Y,WAIT IF REQUEST MUST BE QUEUED ADD Y,Q TEST IF SEMAPHORE HAS BEEN SIGNALLED JGT Q,WAIT IF REQUEST MUST BE QUEUED * REQUEST DOES NOT NEED TO WAIT SUB =1,Y DECREMENT SEMAPHORE VALUE EXCH Y,0(X) PUT SEMAPHORE BACK  JMP EXIT GO TO DISPATCHER TO END SYS ACTIVITY * REQUEST MUST BE QUEUED WAIT EQU $ COPY X,R:SEMX  SAVE SEMAPHORE ADDRESS COPY R:RDY,X REMOVE FIRST ACB FROM R:RDY LIST COPY AC:PER(X),Q COPY Q,R:RDY LINK IT OUT OF LIST CHK: X,=AC:CHK TABLE ID CHECK FOR DEBUG VERSION COPY Y,Q   SET UP TO INSERT BLOCK X INTO LIST Q JSK *R:NSRT INSERT ACB INTO LIST, CALLER SUPLIED LINK COPY Q,Y RESTORE HEAD POINTER COPY R:SEMX,X GET SEMAPHORE ADDRESS EXCH Y,0(X) PUT SEMAPHORE LIST BACK, GET TEMP SEM TITL * * CHECK IF ANYONE SIGNALLED THE SEMAPHORE WHILE WAIT WAS BEING PROCESSED * CKSEM EQU $  JEQ Y,EXIT IF NO ONE SIGNALLED * SOMEONE SIGNALLED WHILE PROCESSING WAIT EXCH Y,0(X) GET ORIGINAL SEMAPHORE, PUT TEMP BACK AGN JEQ Y,EXIT IF NO ONE ELSE IS WAITING COPY X,A SAVE SEM ADDRESS COPY Y,X REMOVE FIRST ACB FROM SEMAPHORE CHK: X,=AC:CHK DEBUG CHECK FOR VALID TABLE ID  COPY AC:PER(X),Y X HAS ACB ADDRESS SIN 2 COPY R:INTQ,Q PUT WAITING ACB INTO R:INTQ  COPY Q,AC:PER(X) EXCH R:INTQ,X COPY A,X GET SEMAPHORE ADDRESS EXCH Y,0(X) PUT BACK REAL SEMAPHORE, GET TEMP SEM. SUB =1,Y DECREMENT TEMP FOR ONE JUST PUT IN R:INTQ JMP CKSEM  NOW DID ANYONE ELSE SNEAK A SIGNAL IN? EXIT EQU $ COPY R:SEMY,Y GOOD STATUS COPY =0,A  GOOD STATUS RSK RETURN LPOOL END COPY R:INTQ,Q PUT WAITING ACB INTO R:INTQ  COPY Q,AC:PER(X) EXCH R:INTQ,X COPY A,X GET SEMAPHORE ADDRESS EXCH Y,0(X) PUT TITL RTX TICK CLOCK - RTXTICK - 93411-13 B3 * * CONTAINS ALL ROUTINES RELATED TO THE TICK CLOCK TIMER. * IFT CHKOT: NAM G:T ENDC NAM R:LTIC,R:KTIC NAM R:ITIC NAM R:TKAC NAM R:TICI  NAM R:TICP EXTR R:SPRI,R:GPR EXTR R:ISIG,R:IWAI EXTR R:SSIG EXTR R:RE12 EXTR R:GVSH,R:GTS EXTR R:TABL EXTR R:DCHK EXTR R:RTXEX FATAL RTX EXCEPTION PROCESSOR * R:ITIC CALL LIST INDEXES EID EQU 0 ENVIRONMENT ID TID EQU 1 TIMER ID SEM EQU 2 SEMAPHORE ADDRESS TICS EQU 3 NUMBER OF TICKS TITL R:ITIC -- SIGNALS SEMAPHORE IN N TICKS * * THE SEMAPHORE ADDRESSED IN THE CALLERS PARAMETER LIST * IS SIGNALLED WHEN THE SPECIFIED NUMBER OF REAL-TIME * CLOCK TICS HAVE OCCURRED. * * CALLED WITH: * X= ADDRESS OF PARAMETERS * EID(X)=ENVIRONMENT ID * TID(X)=TIMER ID * SEM(X)= ADDRESS OF SEMAPHRE TO BE SIGNALLED * TICS(X)= NUMBER OF TICKS TO OCCUR BEFROE SIGNALLING SEMAP+OE * * SPACE 1 ROM REL SPACE 1 R:ITIC EQU $ PUSH: Y  FREE Y-REGISTER COPY X,Y SAVE PARAMETER LIST ADDRESS JSK R:GPR GET CURRENT ACT. PRIORITY IN A REGISTER PUSH: A SAVE IT COPY =R:TKAC,X SET TO SAME PRIORITY COPY AC:PRI(X),X JSK R:SPRI . TO INSURE FIFO LIST JSK R:GTS GET FREEPOOL BLOCK FOR CCB JGE A,FPOK0 IF FREEPOOL REQUEST FILLED COPY A,Y SAVE EXCEPTION CODE JMP ITICEX EXCEPTION EXIT LPOOL TITL * BUILD NEW CCB FPOK0 EQU $ IFT R:CHEK COPY:M =CC:CHK,A,CC:CKW(X) !  TABLE ID FOR DEBUG VERSION ENDC COPY:M EID(Y),A,CC:ECB(X) PUT ENVIRONMENT ID INTO CCB COPY:M TID(Y),A,CC:ID(X) PUT TIMER ID INTO CCB COPY SEM(Y),A SEMAPHORE BLOCK ADDRESS CHK: A,=SD:CHK,SC:CKW VERIFY ID COPY A,CC:STS(X) PUT ADDRESS IN CCB COPY:M TICS(Y),A,CC:TIC(X) NUMBER OF TICKS  COPY X,Y SET Y TO CCB ADDRESS COPY R:CCBH,X PICK UP CCB LIST HEAD JEQ X,EMPTY IF CCB LIST IS EMPTY * * CHECK FOR DUPLICATE ID * COPY =R:CCBH,X PICK UP ADDRESS OF CCB LIST HEAD JSK R:DCHK CHECK DUPLICATE IDS JLT A,DUPFND NEGATIVE IN A,DUPLICATE FOUND JMP NODUP  NO DUPLICATE FOUND * TITL * * CC:ID IS UNIQUE -- PUT NEW CCB INTO LIST NODUP EQU $ SIN 7 COPY RTCNC:,Q # OF TICS LEFT ON CURRENT INTERVAL(NEG) ADD CC:TIC(Y),Q ADD NEW REQUEST SIZE JLT Q,SMALLR IF NEW REQUEST SMALLER THAN REMAINING TICS ADD R:INVL,Q COMPENSATE NEW REQUEST FOR PORTION OF COPY Q,CC:TIC(Y) . CURRENT INTERVAL ALREADY EXPIRED. JMP INSERT LPOOL TITL * LIST WAS EMPTY, SET UP AS SMALLER1REQUEST CASE EMPTY EQU $ SIN 7 COPY X,R:INVL ZERO INTERVAL COPY X,RTCNC: . AND TICK COUNT, THEY ARE INACCURRATE COPY CC:TIC(Y),Q * NEW REQUEST IS SMALLER THAN CURRENT TICS REMAINING * CALCULATE NEW INTERVAL LENGTH * NEW INTERVAL EQUALS OLD INTERVAL MINUS TICKS ALREADY GONE * PLUS NEW REQUEST SMALLR EQU $ ADD R:INVL,Q COPY Q,R:INVL COPY CC:TIC(Y),Q NEG Q,Q COPY Q,RTCNC: SET UP AS NEW INTERVAL * READY TO INSERT NEW ECB IN LIST -- LIST IS UNORDERED, PUT AT HEAD INSERT EQU $ COPY Y,Q BLOCK ADDRESS  EXCH R:CCBH,Q PUT AT HEAD OF LIST COPY Q,CC:PER(Y) LINK TO REST OF LIST SBIT RI:,S ENABLE REALTIME CLOCK COPY =0,Y GOOD STATUS JMP ITICEX TO EXIT SEQUENCE LPOOL  TITL * FOUND DUPLICATE CC:ID IN LIST -- GIVE EXCEPTION DUPFND EQU $ COPY Y,X CCB ADDRESS TO X  COPY =-EX:CCB,Y EXCEPTION CODE TO Y JSK R:GVSH RELEASE CCB BLOCK ITICEX EQU $ POP: X  RELOAD ORIGINAL PRIORITY JSK R:SPRI SET PRIORITY TO ORIG COPY Y,A STATUS CODE TO A POP: Y RESTORE CALLERS Y RSK LPOOL TITL * * POSTS TIMER EXPIRATION BY SIGNALLING INTERRUPT PROCESSOR ROUTINE * R:TICI EQU $ JST R:SA12 SAVE CONTEXT, INHIBIT EOB INTERRUPTS *  . GET ON SYSTEM STACK COPY =R:CLKS,X CLOCK SERVICE SEMAPHORE JSK R:SSIG  SIGNAL INTERRUPT SERVICE ROUTINE JMP R:RE12 ENABLE EOB'S AND RESUME * LPOOL TITL R:TICP -- TICK CLOCK INTERRUPT PROCESSOR ACTIVITY * * THIS IS A CANNED ACTIVITY WHICH PROCESSES THE INTERUPTS POSTED BY * R:TICI THROUGH THE SEMAPHORE R:CLKS. THIS ACTIVITY IS INITIATED * DURING THE INITIALIZATION OF THE SYSTEM. ITS PRIORITY IS TCPRI:. * * * * R:TI" CP EQU $ * * FIND AND SIGNAL ALL EXPIRED REQUEST SEMAPHORES * FIND AND INITIATE SMALLEST REMAINING REQUEST. * * GOT LIST CONTROL BEGLST EQU $ COPY =R:CCBH,X HEAD OF CCB LIST COPY =MAXIN:,A SET UP MAXIMUM INTERVAL SMLINV EQU $ COPY A,R:NUIN SET AS NEW INTERVAL NXTCCB EQU $ COPY X,Y Y IS PRIOR CCB ADDRESS COPY CC:PER(X),X X IS CURRENT CCB ADDRESS JEQ X,ENDLST IF END OF LIST CHK: X,=CC:CHK COPY CC:TIC(X),A GET TIME SUB R:INVL,A SUB THE INTERVAL JLE A,EXPIRD IF THIS CCB EXPIRED COPY A,CC:TIC(X) PUT REMAINING TIME BACK COPY R:NUIN,Q FIND SMALLEST INTERVAL LEFT IN LIST CSM A,Q DO COMPARISON JMP SMLINV LT - IF SMALLEST INTERVAL IN LIST JMP NXTCCB GT - JMP NXTCCB EQ - LPOOL TITL * * CURRENT CCB TIME HAS EXPIRED * EXPIRD EQU $ COPY  CC:STS(X),X JSK R:ISIG SIGNAL THE TIMERS SEMAPHORE JGE A,REMOVE IF SUCCESSFULL SIGNAL  JST R:RTXEX SEMAPHORE ERROR, REPORT IT * REMOVE CCB FROM LIST REMOVE EQU $ COPY CC:PER(Y),X GET EXPIRED CCB ADDRESS COPY:M CC:PER(X),Q,CC:PER(Y) LINK OUT CCB JSK R:GVSH RETURN IT TO FREEPOOL  COPY Y,X RESTORE CCB ADDRESS JMP NXTCCB DO NEXT CCB * * END OF LIST -- SET UP NEW INTERVAL * ENDLST EQU $ COPY R:NUIN,A SET UP NEW INTERVAL SIN 3 NO INTERRUPTS WHILE SWITCHING TIME COPY A,R:INVL NEW INTERVAL NEG A,A ADD RTCNC:,A # OF TICS SINCE THE EOB COPY A,RTCNC: SET UP THE NEW COUNT JGE A,BEGLST IF THIS INTERVAL IS ALREADY UP NXTTIC EQU $ COPY =R:CLKS,X JSK R:IWAI WAIT FOR TIC INTERVAL EXPIRATION JMP R:TICP TIMER EXPIRED, GO PROCESS IT  LPOOL TITL * * TIK CLOCK ACTIVITY CANNED HERE * SPACE 1 REL SPACE 1 SYS:A R:TKAC,TCPRI:,R:TICP,R:LTIC,R:KTIC END TITL RM:TIK -- TICK CLOCK TITL R:CTIC -- CANCEL TICK CLOCK REQUEST NAM R:CTIC,R:MTIC EXTR R:ITIC EXTR R:XPTE EXTR R:GVST EXTR R:DCHK EXTR R:SPRI,R:GPR EXTR  R:TKAC * N EQU 1 * * N=OFFSET TO USER STACK * * * THIS SERVICE CANCELS A R:ITIC REQUEST WHICH HAS BEEN *  POSTED PREVIOUSLY.RETURN STATUS INDICATES WHETHER THE * CCB IS FOUND IN THE CCB LIST. * * * CALLED WITH: *  X=ADDRESS OF ARGUMENT LIST,WHERE * WORD0: ENVIRONMENT ID * WORD1: TIMER ID * * RETURN STATUS IN A REGISTER OF USER CONTEXT: * * 0 INDICATES REQUEST IS RMOVED FROM CCB LIST * -1 INDICATES NO CCB WITH THE IDS IS FOUND * SPACE 1 ROM REL SPACE 1 R:CTIC EQU $ JSK R:CTIP CANCEL REQUEST COPY K,X  GET USER'S CONTEXT COPY A,LAST:A+N(X) TO USER CONTEXT COPY =0,A SET GOOD STATUS RSK RETURN * * INTERNAL CALL ENTER HERE * RETURN STATUS IN A REGISTER * R:CTIP EQU $ PUSH:#  Y COPY X,Y SAVE PARAMETER ADDRESS JSK R:GPR GET CURRENT PRIORITY PUSH: A  SAVE PRIORITY COPY =R:TKAC,X SET TO PRIORITY OF TICK ACTIVITY COPY AC:PRI(X),X TO INSURE FIFO ACCESS TO CCB LIST JSK R:SPRI SUB =CC:ECB,Y IN Y REGISTER COPY =R:CCBH,X IN X REGISTER JSK R:DCHK SEARCH CCB JLT A,DUPFND IF FOUND,CANCEL IT JMP NODUP RETURN STATUS DUPFND EQU $ COPY X,Y SAVE CCB ADDRESS COPY CC:PER(Y),Y GET NEXT CCB ADDRESS  EXCH Y,Q EXCHANGE WITH PRIOR CCB ADDRESS COPY Q,CC:PER(Y) LINK NEXT CCB TO PRIOR CCB JSK  R:GVST RETURN CONTROL BLOCK TO FREE POOL COPY =0,Y STATUS CODE TO Y JMP EXIT1 TO EXIT SEQUENCE * NODUP EQU $ COPY =-1,Y STATUS CODE TO Y JMP EXIT1 TO EXIT SEQUENCE * EXIT1 EQU $ POP: X POP USER PRIORITY JSK R:SPRI RESTORE USER PRIORITY  COPY Y,A STATUS CODE TO A POP: Y RESTORE CALLER'S Y RSK RETURN  TITL * * THIS SERVICE MODIFIES A R:ITIC REQUEST WHICH HAS BEEN * POSTED PREVIOUSLY.RETURN STATUS INDICATES WHETHER THE * CCB IS FOUND IN THE CCB LIST. * * CALLED WITH: * X=ADDRESS OF ARGUMENT LIST,WHERE *  WORD0: ENVIRONMENT ID * WORD1: TIMER ID * WORD2: SEMAPHORE ADDRESS * WORD3: TICK COUNT * *  RETURN STATUS IN A REGISTER OF USER CONTEXT * * 0 INDICATES REQUEST HAS BEEN MODIFIED * -1 INDICATES NO CCB WITH THE IDS IS FOUND. * NO NEW REQUEST IS POSTED R:MTIC EQU $ PUSH: X SAVE PARAMETER ADDRESS JSK R:CTIP CANCELL REQUEST POP: X RSTORE PARAMETER ADDRESS JLT A,EXIT2 CCB NOT FOUND,RETURN NEGATIVE STATUS * TO EXIT SEQUENCE JSK R:ITIC  MAKE TIMER REQUEST JGE A,$+2 IF NO PROBLEM,RETURN JST R:XPTE OTHERWISE , TO EXCEPTION ROUTINE COPY =0,A RETURN STATUS CODE * TO EXIT SEQUENCE * EXIT2 EQU $  COPY K,X GET USER CONTEXT COPY A,LAST:A+N(X) TO USER CONTEXT COPY =0,A SET GOOD STATUS RSK RETURN LPOOL END TO EXIT SEQUENCE JSK R:ITIC  MAKE TIMER REQUEST JGE A,$+2 IF NO PROBLEM,RETURN JST R:XPTE OTHERWISE , TO EXCEP TITL RTX WALL CLOCK - RTXWALL - 93411-14 B3 TITL R:RWAL -- WALL CLOCK ACTIVITY INITIALIZATION CODE * * NO WALL CLOCK ACTIVITY * WALL CLOCK WAIT SEMAPHORE INITIALIZED TO 0 * NAM NOWAL: SNAM R:WLAC SNAM  R:RWAL EXTR R:WLKS LOAD STTLF: SPACE 1 ROM REL SPACE 1 NOWAL: EQU $ R:WLAC EQU $ R:RWAL EQU $ COPY =0,A ZERO WALL CLOCK WAIT SEMAPHORE COPY A,R:WLKS RSK RETURN LPOOL EN$ D * NAM R:WLAC NAM TTLF4: NAM R:RWAL IFT CHKOT: NAM G:W ENDC EXTR R:WLKS EXTR R:ITIC EXTR R:ISIG,R:IWAI EXTR R:GVST EXTR R:RTXEX FATAL RTX EXCEPTION PROCESSOR  EXTR R:TABL LOAD STTLF: * * WALL CLOCK ACTIVITY LOADED * THIS ROUTINE RE-INITIALIZES THE WALL CLOCK ACTIVITY *  SPACE 1 ROM REL SPACE 1 R:RWAL EQU $ COPY =R:KWAL,Y SET Y POINTS TO INITIAL CONTEXT COPY:M =R:LWAL,A,LAST:L(Y) L COPY:M =XA:V,A,LAST:S(Y) S COPY =0,A COPY A,LAST:A(Y) A COPY A,LAST:Q(Y) Q COPY A,LAST:X(Y) X COPY A,LAST:Y(Y) Y COPY:M =R:WLCP,A,LAST:P(Y) P COPY =R:WLAC,X ADDRESS OF WALL CLOCK ACB COPY =0,A ZERO COPY A,AC:PER(X) PEER POINTER  COPY A,AC:FLG(X) FLAGS COPY Y,AC:K(X) INITIALIZE K COPY X,R:WLKS HANG ACB ON WALL CLOCK WAIT SEMAPHORE RSK RETURN LPOOL TITL * * WALL CLOCK ACTIVITY CANNED HERE * SPACE 1 REL SPACE 1 SYS:A R:WLAC,WCPRI:,R:WLCP,R:LWAL,R:KWAL * * THIS IS A CANNED ACTIVITY WHICH PROCESSES WALL CLOCK * REQUESTS EVERY 1/4 SEC INTERVAL. THIS ACTIVITY IS * INITITIATED DURING THE INITIALIZATION OF THE SYSTEM. * PRIORITY IS WLPRI:. LOADING OF THIS ACTIVITY CAN BE CONTROLLED * BY LOAD DIRECTIVE* * SPACE 1 ROM REL SPACE 1 R:WLCP EQU $ COPY =0,A INITIALIZE TIME OF DAY COPY A,R:TODU SET HIGH ORDER WORD TO 0 COPY A,R:TODL SET LOW ORDER WORD TO 0 * COPY =TICALL,X SET X TO TIMER REQUEST PARAMETER ADRESS JSK R:ITIC  MAKE TIMER REQUEST JGE A,$+2 IF NO PROBLEM JMP FATAL BAD STATUS, EXCEPTION  COPY =R:WLKS,X WAIT FOR 1/4 SEC JSK R:IWAI WAIT FOR 1/4 SEC * REPEAT LOOP EQU $ SIN 4 UPDATE TIME OF DAY IMS R:TODL INCREMENT LOW ORDER WORD JMP $+2 NO CARRY IMS R:TODU CARRY TO HIGH ORDER WORD COPY R:WCBH,Y IF NO WALL CLOCK REQUEST JEQ Y,WAIT WAIT ANOTHER 1/4 SEC * OTHERWISE PROCESS CCB LIST COPY =R:WCBH,Q Q POINTS TO LAST CCB, INITIALIZED TO R:WCB CONT EQU $ COPY CC:TU(Y),A GET WALL CLOCK EXPIRATION UPPER COPY R:TODU,X CSM A,X TOD: UPPER JMP WAKMUP LESS- WAKE HIM UP  JMP NOTYET GREATER- NOT YET COPY CC:TL(Y),A EQUAL, CHECK LOW ORDER WORD COPY R:TODL,X  CSM A,X COMPARE TOD: LOWER JMP WAKMUP LESS- WAKE HIM UP JMP NOTYET GREATER- NOT YET * WAKMUP EQU $ COPY CC:STS(Y),X TIME TO WAKE UP,GET SEMAPHORE ADDRESS CHK: X,=SD:CHK,SC:CKW CHECK SEMAPHORE BLOCK JSK R:ISIG SIGNAL THE SEMAPHORE JLT A,FATAL IF RETURN STATUS IS GOOD COPY Y,X SAVE CURRENT CCB ADDRESS COPY CC:PER(Y),Y GET NEXT CCB AS CURRENT PUSH: Q%  R:GVST USES Q, SAVE IT JSK R:GVST RETURN LAST CCB TO SYSTEM FREEPOOL POP: Q  RESTORE Q JGT Y,CONT CHECK THE CCB FOR EXPIRATION * END OF CCB LIST EXCH Q,Y MARK CCB LIST TAIL COPY Q,CC:PER(Y) JMP WAIT WAIT 1/4 SEC * NOTYET EQU $  EXCH Y,Q GET LAST CCB COPY Q,CC:PER(Y) RETAIN CURRENT CCB IN CCB LIST COPY Q,Y  GET CURRENT CCB ADDRESS COPY CC:PER(Y),Y GET NEXT CCB ADDRESS JGT Y,CONT CHECK THE CCB FOR EXPIRATION * END OF CCB LIST EXCH Q,Y MARK CCB LIST TAIL COPY Q,CC:PER(Y) JMP WAIT WAIT 1/4 SEC * * END PROCESSING WALL CLOCK CCB LIST,WAIT 1/4 SEC AND DO IT AGAIN * WAIT  EQU $ COPY =TICALL,X TIMER REQUEST PARMETER JSK R:ITIC MAKE TIMER REQUEST JGE A,$+2 IF NO PROBLEMS JMP FATAL IF EXCEPTION COPY =R:WLKS,X SET SEMAPHORE ADDRESS JSK R:IWAI WAIT FOR 1/4 SEC JGE A,LOOP REPEAT LOOP AGAIN FATAL EQU $ JST R:RTXEX  TO EXCEPTION ROUTINE * * TIMER REQUEST CALL LIST * SPACE 1 REL SPACE 1 TICALL WORD 0 ENVIRONMENT ID (DUMMY) WORD $ TIMER ID WORD R:WLKS ADDRESS OF WALL CLOCK WAIT SEMAPHORE TTLF4: WORD WALCP:  WALL CLOCK PERIOD * END TITL RM:WAL -- WALL CLOCK SERVICE TITL R:STOD -- SET TIME OF DAY NAM  R:STOD,R:GTOD,R:AWAL,R:IWAL EXTR R:GTS,R:SPRI,R:GVSH EXTR R:ISIG EXTR R:TABL EXTR R:GPR  EXTR R:WLAC EXTR R:DCHK * N EQU 1 * * N=OFFSET TO USER'S CONTEXT (FROM TOP OF STACK) * * * THE TIME OF DAY IS SET TO THE DOUBLE PRECISION INTEGER (BINARY) * SPECIFIED IN A AND Q REGISTERS OF CALLER'S CONTEXT , THE Q *  REGISTER CONTAINS THE LEAST SIGNIFICANT BITS * SPACE 1 ROM REL SPACE 1 R:STOD EQU $ COPY K,X GET STACK INDEX SIN 5 INHIBIT INTERRUPT TEMPORARILY COPY LAST:Q+N(X),A SET TOD LOWER COPY A,R:TODL COPY LAST:A+N(X),A SET TOD UPPER COPY A,R:TODU COPY =0,A NO EXCEPTION RSK RETURN TITL R:GTOD -- GET TIME OF DAY * * THE TIME OF DAY IS RETURNED IN THE A,Q REGISTERS OF CALLER'S , * AS A DOUBLE PRECISION INTEGER REPRESENTING THE NUMBER OF 1/4 * SEC WHICH HAVE ELLAPSED SINCE 1,MARCH 1976. THE Q REGISTER * CONTAINS THE LEAST SIGNIFICANT BITS * R:GTOD EQU $ COPY K,X GET STACK INDEX  SIN 4 INHIBIT INTERUPT TEMPORARILY COPY R:TODL,A GET TOD LOWER COPY A,LAST:Q+N(X)  COPY R:TODU,A GET TOD UPPER COPY A,LAST:A+N(X) COPY =0,A NO EXCEPTION RSK RETURN TITL R:AWAL ENTRY * * PARAMETER OFFSETS * EID EQU 0 TID EQU 1 SEM EQU 2 TU EQU 3 TL EQU 4 * * * THIS ENTRY REQUESTS THE WALL CLOCK ACTIVITY TO SIGNAL * ON A SEMAPHORE(PROVIDED BY THE CALLER) A& T AN ABSOLUTE TIME * (PROVIDED BY THE CALLER). * * CALL WITH: * X=ADDRESS OF PARAMETER LIST * EID(X)=ENVIRNMENT ID * TID(X)=TIMER ID * SEM(X)=ADDRESS OF SEMAPHORE TO BE SIGNALLED * TU(X) =EXPIRATION TIME (ABSOLUTE) UPPERT * TL(X) =EXPIRATION TIME (ABSOLUTE) LOWER R:AWAL EQU $ PUSH: Y FREE Y-REGISTER COPY X,Y SAVE PARAMETER LIST ADDRESS JSK R:GTS GET FREEPOOL BLOCK FOR CCB JGE  A,FPOKA IF FREEPOOL REQUEST IS FILLED PUSH: A SAVE EXCEPTION CODE ON STACK JMP IWALEX EXCEPTION EXIT * * BUILD NEW CCB (X CONTAINS ADDRESS OF CCB) * FPOKA EQU $ COPY:M =CC:CHK,A,CC:CKW(X) TABLE ID FOR DEBUG VERSION COPY:M EID(Y),A,CC:ECB(X) PUT EID INTO CCB COPY:M TID(Y),A,CC:ID(X) PUT TID INTO CCB COPY SEM(Y),A SEMAPHORE BLOCK ADDRESS CHK: A,=SD:CHK,SC:CKW VERIFY SEMAPHORE BLOCK COPY A,CC:STS(X) PUT ADDRESS IN CCB COPY TL(Y),A SET EXPIRATION LOWER  COPY A,CC:TL(X) COPY TU(Y),A SET EXPIRATION UPPER COPY A,CC:TU(X) JMP POST  POST REQUEST LPOOL * * THIS ENTRY REQUESTS THE WALL CLOCK ACTIVITY TO SIGNAL * ON A SEMAPHORE(PROVIDED BY THE CALLER) AFTER A TIME INTERVAL * (ALSO PROVIDED BY THE CALLER) HAS ELLAPSED * * CALL WITH: * X=ADDRESS OF PARAMETER LIST * EID(X)=ENVIRNMENT ID * TID(X)=TIMER ID * SEM(X)=ADDRESS OF SEMAPHORE TO BE SIGNALLED * TU(X) =EXPIRATION TIME (INTERVAL) UPPER * TL(X) =EXPIRATION TIME (INTERVAL) LOWER R:IWAL EQU $ PUSH: Y FREE Y-REGISTER COPY X,Y SAVE PARAMETER LIST ADDRESS JSK R:GTS GET FREEPOOL BLOCK FOR CCB JGE A,FPOKI IF FREEPOOL REQUEST FILLED PUSH: A SAVE EXCEPTION CODE ON STACK JMP IWALEX EXCEPTION EXIT * * BUILD NEW CCB (X CONTAINS ADDRESS OF CCB) * FPOKI EQU $  COPY:M =CC:CHK,A,CC:CKW(X) TABLE ID FOR DEBUG VERSION COPY:M EID(Y),A,CC:ECB(X) PUT EID INTO CCB COPY:M TID(Y),A,CC:ID(X) PUT TID INTO CCB COPY SEM(Y),A SEMAPHORE BLOCK ADDRESS CHK: A,=SD:CHK,SC:CKW VERIFY SEMAPHORE BLOCK COPY A,CC:STS(X) PUT ADDRESS IN CCB SIN 2  GET TIME OF DAY COPY R:TODU,A UPPER COPY R:TODL,Q LOWER RBIT 0,S ADDC  TL(Y),Q ADD INTERVAL LOWER TO CURRENT LOWER COPY Q,CC:TL(X) ADDC TU(Y),A ADD INTERVAL UPPER TO CURRENT UPPER COPY A,CC:TU(X) SET EXPIRATION UPPER TITL * * POST WALL CLOCK REQUEST, CCB ADDRESS IN X * POST EQU  $ COPY X,Y SAVE CCB ADDRESS IN Y JSK R:GPR GET CURRENT PRIORITY PUSH: A  SAVE IT COPY =R:WLAC,X SET REQUEST TO A HIGH PRIORITY COPY AC:PRI(X),X TO ENSURE EXCLUSIVE USE OF CCB LIST JSK R:SPRI * * CHECK FOR DUPLICATE ID * COPY =R:WCBH,X PICK UP ADDRESS OF CCB LIS' T HEAD JSK R:DCHK CHECK DUPLICATE IDS JLT A,DUPFND NEGATIVE IN A,DUPLICATE FOUND JMP  NODUP NO DUPLICATE FOUND * * NO DUPLICATE FOUND * NODUP EQU $ COPY R:WCBH,A NO DUPLICATE FOUND COPY A,CC:PER(Y) INSERT NEW CCB INTO CCB LIST COPY Y,R:WCBH COPY =0,Y NO EXCEPTION JMP IWALEX TO EXIT SEQUENCE * * DUPLICATE FOUND * DUPFND EQU $ COPY Y,X CCB ADDRESS TO X COPY =-EX:WCB,Y EXCEPTION CODE TO Y JSK R:GVSH RELEASE CCB BLOCK JMP IWALEX TO EXIT SEQUENCE * * EXIT SEQUENCE, EXCEPTION CODE IN A * IWALEX EQU $ POP: X RELOAD ORIGINAL PRIORITY JSK R:SPRI SET PRIORITY TO ORIG COPY Y,A STATUS CODE TO A POP:  Y RESTORE CALLERS Y RSK LPOOL END TITL RM:WAL -- WALL CLOCK SERVICE TITL R:CWAL -- CANCEL WALL CLOCK REQUEST NAM R:CWAL EXTR R:GVST EXTR R:DCHK EXTR R:SPRI,R:GPR  EXTR R:WLAC * N EQU 1 * * N=OFFSET TO USER STACK * * * THIS SERVICE CANCELS A R:AWAL OR R:IWAL REQUEST WHICH * HAS BEEN POSTED PREVIOUSLY.RETURN STATUS INDICATES * WHETHER THE CCB IS FOUND IN THE CCB LIST * * CALLED WITH: * X=ADDRESS OF ARGUMENT LIST,WHERE * WORD0: ENVIRONMENT ID * WORD1: TIMER ID * * RETURN STATUS IN A REGISTER OF USER CONTEXT: * * O INDICATES REQUEST IS REMOVED FROM CCB LIST * -1 INDICATES NO CCB WITH THE IDS IS FOUND * * SPACE 1 ROM REL SPACE 1 R:CWAL EQU $ JSK R:CWLP CANCEL REQUEST COPY K,X GET USER'S CONTEXT COPY A,LAST:A+N(X) TO USER CONTEXT COPY =0,A SET GOOD STATUS RSK RETURN * * INTERNAL CALL ENTERS HERE * RETURN STATUS IN A REGISTER * R:CWLP EQU  $ PUSH: Y FREE Y REGISTER COPY X,Y SAVE PARAMETER ADDRESS JSK R:GPR  GET CURRENT PRIORITY PUSH: A SAVE PRIORITY COPY =R:WLAC,X SET PRIORITY TO THAT OF WALL ACTIVITY COPY AC:PRI(X),X TO INSURE FIFO ACCESS TO CCB LIST JSK R:SPRI SUB =CC:ECB,Y IN Y REGISTER COPY =R:WCBH,X IN X REGISTER JSK R:DCHK SEARCH CCB LIST JLT A,DUPFND  IF FOUND,CANCEL IT JMP NODUP RETURN STATUS * DUPFND EQU $ COPY X,Y SAVE CCB ADDRESS COPY CC:PER(Y),Y GET NEXT CCB ADDRESS EXCH Y,Q EXCHANGE WITH PRIOR CCB ADDRESS COPY Q,CC:PER(Y) LINK CCB TO PRIOR CCB JSK R:GVST RETURN CONTROL BLOCK TO FREE POOL COPY =0,Y  STATUS CODE TO Y JMP EXIT TO EXIT SEQUENCE * NODUP EQU $ COPY =-1,Y STATUS CODE TO Y JMP EXIT TO EXIT SEQUENCE * EXIT EQU $ POP: X POP USER PRIORITY  JSK R:SPRI RESTORE USER PRIORITY COPY Y,A STATUS CODE TO A POP: Y REST( ORE CALLER'S Y RSK RETURN LPOOL END * * SET WALL CLOCK PERIOD * NAM CLK50: SNAM STTLF: EXTR TTLF4: SPACE 1 ROM REL SPACE 1 CLK50: EQU $ STTLF: COPY:M =NDWCP:,A,TTLF4:  SET WALL CLOCK PERIOD RSK RETURN LPOOL END * NAM STTLF: SPACE 1 ROM REL SPACE 1 STTLF: EQU  $ RSK RETURN LPOOL END COPY Y,A STATUS CODE TO A POP: Y REST TITL RTX OTHER SERVICES - RTXOTHER - 93411-15 B3 IFT CHKOT: NAM G:P ENDC NAM R:GPRI,R:GPR NAM R:SPRI EXTR R:PRID EXTR R:SACT EXTR R:DISP SPACE 4 TITL G:PRI -- GET PRIORITY OF CURRENT ACTIVITY * * GETS THE CURRENT PRIORITY AND PUTS IT INTO * THE CALLERS DOOR CONTEXT AS THE A REGISTER SPACE 1 ROM REL SPACE 1 IFT CHKOT: G:P EQU $ ENDC R:GPRI EQU $ JSK R:GPR GET CURRENT PRIORITY IN A COPY K,X GET STACK ADDRESS COPY A,LAST:A+1(X) PUT A INTO USER CONTEXT  RSK * * GET USER PRIORITY INTO THE A REGISTER * R:GPR EQU $ COPY R:ACT,X CURRENT ACB ADDRESS  COPY AC:PRI(X),A PRIORITY OF CURRENT ACTIVITY RSK * LPOOL TITL R:SPRI -- SET CURRENT ACTIVITY,S PRIORITY * * TAKES THE PRIORITY DESCRIPTOR IN X REGISTER * AND EVALUATES IT. BEGINS A SYSTEM ACTIVITY * WHICH SETS THE CURRENT ACB TO THIS PRIORITY AND INSERTS * THE ACB INTO THE R:INTQ. IT THEN EXITS TO THE DISPATCHER. * THIS ROUTINE THEN RETURNS TO THE CALLER * R:SPRI EQU $ COPY X,Q PRIORITY DESCRIPTOR TO Q JSK R:PRID  EVALUATE DESCRIPTOR RESULT IN Q JGE A,SPRIOK IF NO PRIORITY PROBLEM RSK IF PRIORITY DESCRIPTOR EXCEPTION * SPRIOK EQU $ JSK R:SACT BEGIN SYSTEM ACTIVITY WORD ISPRI ACTIVITY TO BE STARTED RSK RETURN TO CALLER TITL * * * SYSTEM ACTIVITY BEGINNING * * * X= BEGINNERS STACK ADDRESS ISPRI EQU $ COPY LAST:Q(X),Q GET PRIORITY VLAUE COPY R:ACT,X REMOVE COPY AC:PER(X),A . CURRENT ACB FROM COPY A,R:RDY . THE R:RDY LIST COPY Q,AC:PRI(X) SET THE CALLERS PRIORITY SIN 2 COPY R:INTQ,A PUT HIM INTO R:INTQ COPY A,AC:PER(X) COPY X,R:INTQ JMP R:DISP END THE SYSTEM ACTIVITY * * END OF SYSTEM ACTIVITY LPOOL END TITL RM:OTH -- OTHER SERVICES S4151* 93415-1* TITL R:WCI -- WAIT ON CONSOLE INTERRUPT EXTR R:ITIC IFT CHKOT: NAM G:W ENDC NAM R:CINT NAM R:CNSL EXTR R:IWAI,R:SSIG EXTR R:DISP EXTR R:RTXEX EXTR R:RE12 EXTR R:CNTK EXTR R:CNSM TITL * * THIS SERVICE PERFORMS A WAIT ON THE CONSOLE INTERRUPT. * ONLY ONE ACTIVITY MAY WAIT FOR THIS INTERRUPT AT A TIME * SUBSEQUENT WAIT REWUQESTS WILL CAUSE THE PREVIOUSLY WAINTING * ACTIVITY TO BE LOST * SPACE 1 ROM REL SPACE 1 IFT CHKOT: G:W EQU $ ENDC R:) CINT EQU $ COPY =TICALL,X TIMER REQUEST PARAMATER ADDRESS JSK R:ITIC MAKE TIMER REQUEST  JGE A,$+2 IF NO PROBLEMS RSK IF EXCEPTION COPY =R:CNTK,X WAIT FOR TIMER TO EXPIRE JSK R:IWAI WAIT FOR TIMER TO EXPIRE JGE A,WCI1 IF GOOD WAIT RSK IF EXCEPTION, PASS SSTATUS UP * * CONSOLE SEMAPHORE SHOULD NEVER BE SIGNALLED IS NO ONE IS WAITING WCI1 EQU $ COPY =0,A  COPY =SEMAX:,Q MAX SEMAPHORE VALUE SIN 4 EXCH R:CNSM,A ZERO SEMAPHORE, GET CONTENTS  CSM A,Q TEST IF SIGNALLED JMP $+3 YES LEAVE ZERO NOP COPY A,R:CNSM OUT A,CIRFC:+CONDA: CLEAR CONSOLE INT; TURNS OFF LIGHT SBIT CI:,S ENABLE CONSOLE INTERRUPT COPY  =R:CNSM,X GET CONSOLE SEMAPHORE ADDRESS JSK R:IWAI COPY =0,A GOOD STATUS RSK LPOOL * TIMER REQUEST CALL LIST SPACE 1 REL SPACE 1 TICALL WORD 0 ENVIRONMENT ID (DUMMY) WORD $  TIMER ID WORD R:CNTK SEMAPHORE ADDRESS OF CONSOLE INTERUPT TIME WORD 1 TICKS * TITL R:CNSL -- CONSOLE INTERRUPT HANDLING ROUTINE ROM REL SPACE 1 R:CNSL EQU $ SIN 1 RBIT CI:,S DISABLE CONSOLE INTERRUPT JST R:SA12 SWITCH TO SYSTEM STACK COPY =R:CNSM,X GET CONSOLE INT. SEMAPHORE ADDRESS JSK R:SSIG SIGNAL THE CONSOLE INT SEMAPHORE JLT A,FATAL IF EXCEPTION OCCURRED  JMP R:RE12 RESUME EXECUTION FATAL EQU $ * JST R:RTXEX CONSOLE INTRERRUPT EXCEPTION IS FATAL LPOOL END TITL RM:OTH -- OTHER SERVICES S4151* 93415-1* IFT CHKOT: NAM G:M ENDC NAM R:SEND,R:ISND NAM R:RECV,R:IRCV EXTR R:ISIG,R:IWAI EXTR R:TABL * * MESSAGE CONTROL BLOCK (MCB) LOCAL EQUATES * MC:CHK EQU MD:CHK CHECK VALUE MC:PER EQU MD:PER PEER LINK MC:FLG EQU MD:FLG FLAGS MC:MBX EQU MD:MBX MAILBOX USAGE SEMAPHORE MC:MSG EQU MD:MSG MESSAGE SIGNALLING SEMAPHORE MC:A EQU MD:A A-REGISTER OF MESSAGE MC:Q EQU MD:Q Q-REGISTER OF MESSAGE * *  PARAMETER EQUATES * EID EQU 0 MID EQU 1 * * THIS ROUTINE IS CALLED BY A USER THROUGH THE DOOR ONLY! * THIS ROUTINE PROVIDES THE INTERFACE TO R:SNDI FOR A USER REQUEST. * THIS ROUTINE IS ENTERED WITH: * X= ADDRESS OF PARAMETER LIST *  EID(X) = ENVIRONMENT ID * MID(X) = MAILBOX ID * * LAST:A+N(K) = FIRST WORD OF MESSAGE * LAST:Q+N(K) = SECOND WORD OF MESSAGE * * * N EQU 1 SPACE 1 ROM REL SPACE 1 IFT CHKOT: G:M EQU $ ENDC R:SEND EQU $ COPY X,Y SAVE PARAMETER ADDRESS COPY EID(X),X CHECK ENVIRONMENT ID JNE X,$+2  JSK GETEA IT'S ME, GET CURRENT ENVIRONMENT COPY X,EID(Y) STUFF ENVIRONMENT ID COPY Y,X PARAMETER ADDRESS TO X JSK GETMA GET MAILBOX ADDRESS COPY X,A CHECK RETUR* N STATUS JGE A,$+2 IF MAILBOX NOT FOUND RSK RETURN COPY K,Y GET USER STACK CONTEXT COPY LAST:A+N(Y),A COPY LAST:Q+N(Y),Q * X STILL HOLDS MCB ADDRESS JSK R:ISND  USE INTERNAL SEND PROCESSOR RSK TITL R:SNDI -- INTERNAL SEND PROCESSOR * * REQUEST ACCESS TO MAILBOX (MC:MBX),PLACES A AND Q IN MAILBOX * AND SIGNALS MESSAGE SEMAPHORE (MC:MSG) * CALLED WITH: * X= ADDRESS OF MAILBOX (MCB) * A= FIRST WORD OF MESSAGE * Q= SECOND WORD OF MESSAGE * R:ISND EQU $ CHK: X,=MC:CHK DEBUG CHECK FOR TABLE ID PUSH: Y,A,Q FREE Y, SAVE MESSAGE COPY X,Y MCB ADDRESS ADD =MC:MBX,X  JSK R:IWAI REQUEST USE OF MAILBOX JGE A,STUFF IF NO PROBLEM RSTAK: 2 EXCEPTION-- CLEAN UP STACK JMP SNDIEX TAKE EXCEPTION EXIT * HAVE CONTROL MAILBOX STUFF EQU $ POP: A,Q  GET BACK MESSAGE COPY A,MC:A(Y) PUT MESSAGE IN MAILBOX COPY Q,MC:Q(Y) COPY Y,X ADD  =MC:MSG,X JSK R:ISIG SIGNAL--MESSAGE DELIVERED SNDIEX EQU $ POP: Y RESTORE CALLERS Y REG RSK RETURN LPOOL TITL * * THIS ROUTINE IS CALLED BY THE USER THROUGH THE DOOR ONLY! * THIS ROUTINE PROVIDES THE INTERFACE TO THE INTERNAL RECIEVE * ROUTINE - R:RCVI. * CALLED WITH: * X= ADDRESS OF PARAMETER LIST * EID(X) = ENVIRONMENT ID * MID(X) = MAILBOX ID * * EXITS WITH: * LAST:A(K)= FIRST WORD OF MESSAGE * LAST:Q(K)= SECOND WORD OF MESSAGE * R:RECV EQU $ COPY X,Y SAVE PARAMETER ADDRESS COPY EID(X),X CHECK ENVIRONMENT ID JNE X,$+2 JSK GETEA IT'S ME, GET CURRENT ENVIRONMENT COPY X,EID(Y) STUFF ENVIRONMENT ID COPY Y,X PARAMETER ADDRESS TO X JSK GETMA GET MAILBOX ADDRESS COPY X,A CHECK RETURN STATUS JGE A,$+2 IF MAILBOX NOT FOUND RSK RETURN JSK R:IRCV DOES RECEIVE JLT A,RECVEX IF EXCEPTION COPY K,Y PUT MAIL INTO CALLERS CONTEXT COPY X,LAST:A+N(Y) COPY Q,LAST:Q+N(Y) COPY =0,A  GOOD STATUS RECVEX EQU $ RSK LPOOL TITL R:IRCV INTERNAL-RETRIEVES MESSAGE FROM MAILBOX * * RETRIEVE MESSAGE FROM THE MAILBOX AND RETURNS IT TO CALLER * CALLED WITH: * X= MAILBOX CONTROL BLOCK (MCB) ADDRESS * RETURNS WITH: * X= FIRST WORD OF MESSAGE * Q= SECOND WORD OF MESSAGE * R:IRCV EQU $ CHK: X,=MC:CHK DEBUG CHECK FOR TABLE ID PUSH: Y FREE UP Y REGISTER COPY X,Y MCB ADDRESS ADD =MC:MSG,X MESSAGE SEMAPHORE ADDRESS TO X JSK R:IWAI WAIT FOR MESSAGE JLT A,RCVIEX IF EXCEPTION OCCURRED COPY MC:A(Y),X SAVE FIRST WORD OF MESSAGE COPY MC:Q(Y),Q SECOND WORD OF MESSAGE PUSH: X,Q COPY Y,X ADD =MC:MBX,X JSK R:ISIG SIGNAL -- MESSAGE RECEIVED P+ OP: X,Q RELOAD MESSAGE COPY =0,A GOOD STATUS RCVIEX EQU $ POP: Y RESTORE CALLERS Y RSK RETURN LPOOL TITL * THIS ROUTINE RETURNS THE ADDRESS OF THE MDB WITH THE * SPECIFIED ENVIRONMENT ID AND THE MAILBOX ID * * CALL WITH: * X=ADDRESS OF PARAMETER LIST * EID(X)=ENVIRONMENT ID * MID(X)=MAILBOX ID * * * RETURN MDB ADDRESS IN X REGISTER; A NEGATIVE VALUE * INDICATES MAILBOX NOT FOUND * GETMA EQU $ COPY Y,Q SAVEW Y REGISTER COPY X,Y Y HAS THE PARAMETER LIST ADDRESS COPY EID(Y),X GET ECB ADDRESS COPY ED:MLH(X),X GET MAIL BOX LIST HEAD * REPEAT EQU $ JEQ X,NOTFND END OF LIST REACHED, MAILBOX NOT FOUND COPY MD:ID(X),A GET MAILBOX ID CSK  A,MID(Y) CHECK MAILBOX ID JMP NEXT NO MATCH, CHECK NEXT MAILBOX JMP NEXT NO MATCH, CHECK NEXT MAILBOX JMP FOUND FOUND, RETURN MAILBOX ADDRESS NEXT EQU $ COPY MD:PER(X),X  FETCH NEXT MDB JMP REPEAT KEEP CHECKING * NOTFND EQU $ COPY =-EX:MBX,X SET ERROR FLAG FOUND EQU $ COPY Q,Y RESTORE Y REGISTER RSK RETURN TITL * THIS ROUTINE RETURNS THE CURRENT ECB 'S ADDRESS * IN THE X REGISTER * GETEA EQU $ COPY R:ACT,X GET CURRENT ACB ADDRESS COPY AC:ECB(X),X GET CURRENT ECB ADDRESS RSK RETURN LPOOL END X  FETCH NEXT MDB JMP REPEAT KEEP CHECKING * NOTFND EQU $ COPY =-EX:MBX,X SET ERROR FLAG FOUN TITL RTX MEMORY POOL MANAGER - RTXMPMGR - 93411-16 B3 NAM R:GETM,R:GIVM EXTR R:TABL,R:RTXEX EXTR R:MPM1,R:MPM2 * TITL * * THIS ROUTINE GETS A BLOCK OF THE SPECFIED NUMBER OF * WORDS FROM THE CURRENT ACTIVITIES ENVIRONMENT MEMORY * POOL. ALLOCATION IS DONE BY A FIRST FIT ALGORITHM. *.CALL SEQUENCE: * X=ADDRESS OF ECB TO GET MEMORY FROM * A= NUMBER OF WORDS * JSK R:GETM * RETURN HERE WITH: X= ADDRESS OF BLOCK * A=0 IF REQUEST WAS FILLED,A<0 EXCEPTION * * * * *MUST BE ON SYSTEM STACK* * * SPACE 1 ROM REL SPACE 1 R:GETM EQU $ JNE A,GETIT  IF NOT A NULL REQUEST COPY =0,X NULL REQUEST GETS 0 AS BLOCK ADDRESS JMP GETMX EXIT ROUTINE, VALID STATUS GETIT EQU $ COPY Y,R:MPM1 SAVE CALLERS Y ADD =EM:PTR+1,A ALLOW FOR OVERHEAD CELLS. NXTECB EQU $ CHK: X,=EC:CHK DEBUG CHECK FOR TABLE ID COPY ED:MPA(X),X GET EMP HEAD ADDRESS TITL TOSMAL EQU $ COPY X,Y Y IS TRAILING POINTER COPY EM:PTR(X),X X IS CURRENT POINTER JEQ X,NOTFND IF NO MORE BLOCKS COPY EM:LEN(X),Q LENGTH OF THIS BLOCK CSM Q,A  IS BLOCK BIG ENOUGH JMP TOSMAL LT, TO SMALL TRY NEXT BLOCK * FOUND BLOCK BIG ENOUGH JMP AROND GT, YES, SEE IF IT CAN BE FRAGMENTED. JMP TAKEIT EQ, YES, EXACT FIT, TAKE IT. AROND SUB =EM:, PTR+1,Q CAN WE SQUEEZE IN ANOTHER HEADER? CSM Q,A IS BLOCK MINUS HEADER SIZE STILL BIG ENUF? JMP TAKEIT NO, USE ENTIRE BLOCK. NOP YES, BREAK UP THE BLOCK. ADD =EM:PTR+1,Q ALLOW FOR HEADER * BLOCK IS LARGE ENOUGH TO BE SPLIT UP INTO TWO BLOCKS COPY Y,R:MPM2 SAVE BLOCK ADDRESS COPY X,Y MAKE Y POINTER TO NEW BLOCK ADD A,Y LENGTH OF BLOCK BING ALLOCATED SUB A,Q (REA # 4022) COPY Q,EM:LEN(Y) PUT LENGHT IN NEW BLOCK COPY:M EM:PTR(X),Q,EM:PTR(Y) LINK UP THE NEW BLOCK  COPY Y,EM:PTR(X) COPY A,EM:LEN(X) GIVE OLD BLOCK SIZE COPY R:MPM2,Y RESTORE OLD BLOCK SIZE * ALLOCATE BLOCK POINTED TO BY X REG TAKEIT EQU $ COPY EM:PTR(X),Q TAKE OUT BLOCK BY COPY Q,EM:PTR(Y)  RELINK AROUND IT ADD =EM:PTR+1,X MAKE USER POINTER. GETMX EQU $ COPY =0,A LOAD SUCCESS STATUS TAG EQU $ COPY R:MPM1,Y RESTORE CALLERS Y * RETURN RSK TITL * NOTFND EQU $  COPY =-EX:EMP,A LOAD EXCEPTION CODE JMP TAG LPOOL * TITL * RETURNS A BLOCK TO THE E.M.P. * CALLED WIH * X=ADDRESS OF ECB TO RETURN IT TO * A=ADDRESS OF BLOCK * * * MUST BE ON SYSTEM STACK WHEN CALLED * * R:GIVM EQU $ COPY Y,R:MPM1 SAVE CALLERS Y SUB =EM:PTR+1,A ADJUST POINTER TO OVERHEAD CELLS. CHK: X,=EC:CHK DEBUG CHECK FOR TABLE ID COPY ED:MPA(X),X GET EMP HEAD ADDRESS COPY EM:LEN(X),Q  ADD LOWER LIMIT OF EMP TO EMP LENGTH ADD X,Q TO GET UPPER LIMIT OF EMP CSM A,Q MAKE SURE THE BUFFER LIES WITHIN THE EMP. CSM A,X JMP WRGEMP WRONG EMP. NOP JMP RITEMP RIGHT EMP. SUB X,Q CHECK IF IN THIS EMP JLT Q,WRGEMP IF LESS THAN START OF EMP,CAN'T BE IN IT COPY X,Q CALCULATE END OF ADD EM:LEN(X),Q . THIS EMP SUB A,Q  IS THE BLOCK IN THIS EMP JGT Q,RITEMP IF LESS THAN END OF EMP, THIS IS IT! WRGEMP EQU $ * SOMEBODY CLOBBERED SOMETHING, THIS BLOCK DOES NOT FIT IN ANY OF * THE CURRENT EMP'S. I GIVE UP! COPY =-EX:EMP,A EMP EXCEPTION  JST R:RTXEX REPORT EXCEPTION * TITL * RITEMP EQU $ COPY X,R:MPM2 SAVE EMP DESCRIPTOR ADDRESS NOTIT EQU $ COPY X,Y Y IS TRAILING POINTER COPY EM:PTR(X),X X IS CURRENT POINTER JEQ X,GOTIT IF END OF FREELIST,HANG IT ON END CSM X,A IS IT BEFORE THE BLOCK WE ARE AT JMP NOTIT IF NOT PAST KEEP GOING JMP GOTIT IF ADDRESS IS PAST BLOCK BEING RETRUNED  COPY =-EX:EMP,A IF EQUAL SOMETHING IS CLOBBERRED, JST R:RTXEX . CANNOT RETURN A BLOCK THAT IS STILL * A BLOCK CAN'T BE RETURNED IF IT IS STILL * ON THE FREE LIST !!!!  TITL * FOUND WHERE THE BLOCK BELONGS,LINK IT IN GOTIT EQU $ EXCH X,A ADDRESS OF RETURNED BLOCK A- ND ITS NEXT COPY A,EM:PTR(X) . POINTER. BLOCK GETS NEXT PTR COPY X,EM:PTR(Y) . LAST BLOCK GET RETURNED BLOCK ADDRESS COPY =-2,Q ONLY COMBINE TWICE * NOW CONSOLIDATE BLOCKS IF POSSIBLE COPY R:MPM2,X  DESCRIPTOR ADDRESS CSN Y,X CHEKC NODE JMP NXTONE CAN'T COMBINE DESCRIPTOR AGAIN EQU $ COPY EM:PTR(Y),X GET NEXT BLOCKS ADDRESS JEQ X,GIVMEX IF NO NEXT BLOCK COPY Y,A  ADD EM:LEN(Y),A CALCULATE END OF THIS BLOCK CSN A,X IS IT START OF NEXT JMP COMBIN  YES, COMBINE THEM NXTONE EQU $ CAN'T COMBINE THOSE COPY X,Y MOVE TO NEXT NODE NEXT EQU $ IJEQ Q,GIVMEX HAVE WE TRIED TWICE YET JMP AGAIN NO COMBIN EQU $ COPY:M EM:PTR(X),A,EM:PTR(Y) LINK OUT NEXT BLOCK COPY EM:LEN(X),A ADD LENGTHS TOGETHER ADD EM:LEN(Y),A  COPY A,EM:LEN(Y) MAKE NEW LENGTH OF COMBINED JMP NEXT GO TRY AGAIN TITL GIVMEX EQU $  COPY R:MPM1,Y RESTORE CALLERS Y COPY =0,A GOOD STATUS * RETURN RSK END  NAM R:ABUF,R:RBUF EXTR R:SACT,R:GIVM,R:GETM,R:DISP * SPACE 4 * R:ABUF AMOUNT * ADDRESS RETURNED IN X REGISTER * ALLOCATES A BUFFER FROM THE ENVIRONMENT MEMORY POOL. * THE AMOUNT TO BE ALLOCATED IS PROVIDED AS AN ARGUMENT. * THE ADDRESS OF THE ALLOCATED BUFFER IS RETURNED IN THE X REGISTER * ENTRY- AMOUNT OF BUFFER TO BE ALLOCATED TO X * EXIT- ADDRESS FOF BUFFER RETURNED IN X SPACE 1 ROM REL SPACE 1 R:ABUF EQU $ JSK R:SACT BEGIN SYSTEM ACTIVITY WORD RABUF ACTIVITY TO BE STARTED RSK RETURN TO CALLER * SYSTEM ACTIVITY BEGINNING * X= BEGINNERS STACK ADDRESS RABUF EQU $ COPY 4(X),A (REA # 3931) COPY R:ACT,Y GET CURRENT ACB ADDRESS COPY AC:ECB(Y),X ECB TO GET MEMORY FROM JSK R:GETM X=ADDRESS OF BLOCK,A=NO.OF WORDS COPY R:ACT,Y COPY AC:K(Y),Y COPY X,LAST:X+8(Y) PASS X TO CALLER JMP R:DISP GO TO DISPATCHER * TITL R:RBUF- RETURNS A BUFFER TO THE ENVIRONMENT MEMORY POOL * R:RBUF ADDRESS * ENTRY-ADDRESS OF BUFFER TO BE RETURNED IN X * RETURNS A BUFFER TO THE ENVIRONMENT MEMORY POOL FOR USE BY ANOTHE * ACTIVITY. ONLY THE ADDRESS OF THE BUFFER NEED BE PROVIDED AS THE * ARGUMENT TO THE REQUEST. R:RBUF EQU $ JSK R:SACT BEGIN SYSTEM ACTIVITY WORD  RRBUF ACTIVITY TO BE STARTED RSK * * SYSTEM ACTIVITY BEGINNING * X= BEGINNERS STACK ADDRESS RRBUF EQU $ COPY 4(X),A COPY R:ACT,Y COPY AC:ECB(Y),X ECB TO GET MEMORY FROM JSK R:GIVM X=ADDRESS OF ECB TO RETURN BUFFER TO,A=ADDR. OF BLK JMP R:DISP GO TO DISPATCHER LPOOL END . ONLY THE ADDRESS OF THE BUFFER NEED BE PROVIDED AS THE * ARGUMENT TO THE REQUEST. R:RBUF EQU $ JSK R:SACT BEGIN SYSTEM ACTIVITY WORD  RRBUF ACTIVITY TO BE STARTED RSK * * SYSTEM ACTIVITY BEGINNING * X= BEGINNERS STACK ADDRESS RRBUF EQU .  TITL RTX DISPATHER - RTXDISP - 93411-17 B3 NAM G:Z NAM R:DISP NAM R:IACB NAM R:DA,R:DAQX NAM R:RE12,R:SACT EXTR R:KSTK,R:LSTK EXTR R:TABL EXTR R:SYSX * TITL R:RE12 -- ENABLE EOB INTERRUPTS; TO DISPATCHER * * INTERRUPT PROCESSING ROUTINES SHOULD END BY ENTERING THE * DISPATCHER THROUGH THIS ROUTINE. THIS ROUTINE RE-ENABLES * EOB INTERRUPTS (STATUS BIT 12) AND THEN GOES TO THE DISPATCHER. * *** MUST BE ON THE SYSTEM STACK SPACE 1 ROM REL SPACE 1 G:Z EQU $ * R:RE12 EQU $ RBIT 12,S ALLOW EOB INTERRUPTS UIS SEND NEW INTERRUPT STATUS TO CONTROLLERS JMP R:DISP TO DISPATTCHER * * ENTRY HERE PUTS THE CURRENT A,Q, AND X REGISTERS * INTO THE CURRENT USERS CONTEXT AND GOES TOTHE DISPATCHER * NOTE MUST BE ON SYSTEM STACK * R:DAQX EQU $ COPY R:ACT,Y CURRENT ACB COPY AC:K(Y),Y USERS STACK COPY X,LAST:X(Y) X TO USERS STACK CONTEXT COPY Q,LAST:Q(Y) Q TO USERS STACK CONTEXT * * ENTRY HERE SAVES THE A REGISTER IN THE USERS CONTEXT * NOTE MUST BE ON SYSTEM STACK * R:DA EQU $ COPY R:ACT,Y CURRETNT ACB COPY AC:K(Y),Y CURRENT USERS STACK COPY A,LAST:A(Y) A TOI USER CONTEXT JMP R:DISP * TITL * * NOTE: MUST BE ON SYSTEM STACK * R:DISP EQU $ SBIT INT:,S TURN ON INTERRUPTS COPY =R:KSTK,A  GET INITIAL SYSTEM STACK K VALUE CSN A,K IS ANYONE ELSE ON SYSTEM STACK JMP INTQ NO, GO MERGE R:INTQ AND R:RDY LISTS * SOMEONE IS ON SYSTEM STACK, DISPATCH HIM * LOAD CONTEXT POP *  RESUME EXECUTION RSK INTQ EQU $ SIN 3 COPY R:INTQ,Y ADDRESS OF FIRST ACB IN R:INTQ  JEQ Y,REDY IF EMPTY LIST COPY AC:PER(Y),X LINK OUT ACB COPY X,R:INTQ NEW HEAD OF INTQ  CHK: Y,=AC:CHK DEBUG CHECK OF TABLE ID TITL * INSERT ACB FROM R:INTQ INTO R:RDY COPY =R:RDY,Q  Q IS TRAILING POINTER COPY R:RDY,X FIRST ACB ON LIST COPY AC:PRI(Y),A GET PRIORITY OF ACF TO BE INSERTED TEST EQU $ JEQ X,HERE IF PEER LINK=0 INSERT ACB CSK A,AC:PRI(X) CHECK IF TO LOWER PRIORITY ACB YET JMP NEXT NOT LESS YET, TRY NEXT ACB JMP HERE IF LESS, INSERT HERE NEXT EQU $ COPY X,Q MOVE UP TRAILING POINTER COPY AC:PER(X),X MOVE TO NEXT ACB ON LIST  JMP TEST GO CHECK PRIORITY * INSERT THE ACB BEFORE THE CURRENT READY LIST ACB HERE EQU $ EXCH  X,Q X TO LAST BLOCK COPY Y,AC:PER(X) LAST BLOCK TO NEW BLOCK COPY Q,AC:PER(Y) NEW BLOCK TO NEXT JMP INTQ DO NEXT R:INTQ ACB TITL * * READY TO DISPATCH A USER * REDY EQU $ SIN  2 SO WE WON'T IDLE FOREVER COPY R:RDY,Y GET FIRST READY ACB JEQ Y,IDLE IF NO ONE TO DISPATCH COPY Y,R:ACT JSK R:EVCK INSURE ENVIRONMENT,S PRESENCE COPY AC:K(Y),X GET / USERS K SIN 4 COPY R:INTQ,Q DID ANYONE SLIP IN JNE Q,INTQ YES, PUT HIM INTO R:RDY AND TRY AGAIN COPY X,K SET UP USERS STACK * LOAD CONTEXT POP * RESUME USER EXECTUION  RSK TITL * NO ONE TO DISPATCH - KILL SOME TIME * IDLE EQU $ SIN 3 NO INTERRUPTS WHILE SWITCHING * . MIGHT NOT GET HIM SCHEDULED FOR A WHILE COPY L,A SET UP PHONY ACB  ADD =1,A . AS THE TOP (L END) COPY A,L . OF THE STACK COPY A,R:ACT MAKE THIS THE CURRENT ACTIVITY SBIT RI:,S TURN ON CLOCK JMP R:IDLE EXECUTE IDLE CODE * * FLASH OV AND BY AS IF BINARY COUNTER. * DO IT SLOWER THAN WE USED TO. * R:IDLE EQU $ RBIT OV:,S TURN OFF OVERFLOW LOGHT JST ONES FLASH THE ONES BIT SBIT OV:,S TURN ON OV LIGHT JST ONES FLASH THE ONES BIT JMP R:IDLE GO DO IT AGAIN SPACE 1 ONES ENT RBIT BY:,S RESET BYTE LIGHT JST DELAY WAIT SBIT BY:,S SET BYTE LIGHT JST DELAY WAIT JMP *ONES RETURN SPACE 1 DELAY ENT JNED A,$ WAIT JNED A,$ WAIT JMP *DELAY RETURN TITL R:EVCK EQU $ PHONY ROUTINE RSK LPOOL * TITL * * SAVES THE CURRENT USERS CONTEXT ON HIS STACK * THEN SWITCHES TO THE SYSTEM STACK AND BEGINS * EXECUTION AT THE ADDRESS GIVEN AT CALL+1. THE * A REGISTER IS SET TO ZERO BEFORE CONTEXT IS SAVED * THE CALL: JSK R:SACT * WORD ADDRESS * RETURNS HERE ON COMPLETION * GIVES CONTROL TO PROGRAM ADDRESS GIVEN WITH: * X=CALLERS STACK ADDRESS * * THE ADDRESSED CODE MUST END THROUGH THE DISPATCHER * R:SACT EQU $ COPY =0,A SET UP GOOD STATUS JST R:SAVE SAVE CONTEXT AND SWITCH TO SYSTEM STACK COPY A,X OLD CONTEXT ADDRESS TO X COPY LAST:P(X),Y LOAD CALL ADDRESS, ALSO PARAMETER ADDRESS IMS LAST:P(X) STEP OVER PARAMETER JMP *0(Y)  BEGIN EXECUTION OF SYSTEM CODE LPOOL * TITL * * THE ACB ADDRESSED BY THE X REGISTER IS INSERTED INTO * THE LIST OF ACBS BASED ON PRIORITY. * * THE CALL: * Q = ADDRESS OF FIRST ACB IN LIST * X = ADDRESS OF ACB TO BE INSERTED *  JSK R:IACB * RETURNS WITH: * A = STATUS * Q = ADDRESS OF FIRST ACB IN LIST * X = ADDRESS OF INSERTED ACB * * R:IACB EQU $ CHK: X,=AC:CHK DEBUG TABLE ID CHECK PUSH: Y,Q FREE Y, SAVE LKLIST HEAD  COPY Q,Y HEAD TO Y JEQ Y,FIRST IF EMPTY LIST COPY AC:PRI(X),A PRIORITY OF ACB BEING INSERTED CSK A,AC:PRI(Y) COMPARE PRIORITY JMP SEARCH GT - NOT SPECIAL CASE JMP FIRST LT - IF INSERTION AT HEAD JMP SEARCH GT - NOT SPECIAL * SPECIAL CASE - INSERTION AT HEAD OF LIST FIRST EQU $ COPY Y,A SET UP PEER LINK COPY A,AC:PER(X) COPY X,Q NEW BLOCK BECOMES HEAD POP: Y,A RESTORE Y, THROW OUT OLD HEAD JMP IACBRT RETURN TO CALLER * N0 OT SPECIAL CASE, MUST SEARCH LIST SEARCH EQU $ COPY Y,Q Q IS TRAILING POINTER COPY AC:PER(Y),Y  Y IS CURRENT POINTER JEQ Y,INSRT IF END OF LIST CHK: Y,=AC:CHK CSK A,AC:PRI(Y) TEST -- NEW BLOCK TO CURRENT JMP SEARCH LT- KEEP LOOKING JMP INSRT GT - PUT IT HERE JMP SEARCH EQ - PUT AFTER ALL EQUALS * READY TO INSERT THE ACB INSRT EQU $ EXCH Q,Y Y TO PRIOR BLOCK, Q TO CURRENT COPY X,AC:PER(Y) PRIOR TO NEW COPY Q,AC:PER(X) NEW TO CURRENT POP: Y,Q  RESTORE Y AND HEAD IACBRT EQU $ COPY =0,A GOOD STATUS RSK LPOOL END  TITL RM:DIS -- DISPATCHER S4161* 93416-1* TITL RM:STK -- SYSTEM STACK NAM R:LSTK,R:KSTK R:LSTK EQU $ SYSTEM STACK L VALUE RES 64,:FFFF R:KSTK EQU $ SYSTEM STACK K VALUE END TITL RM:DIS -- DISPATCHER S4161* 93416-1* TITL R:STRT -- SYSTEM POWER UP AND RESTART IFT  CHKOT: NAM G:U ENDC NAM R:STRT NAM R:PWRF NAM R:INI1 EXTR R:KSTK,R:LSTK EXTR R:UINI EXTR R:NOPF EXTR R:DISP EXTR R:PFLG,R:PFK,R:CDRG,R:SNSW,R:SREG EXTR I:INIT EXTR R:RTXEX FATAL RTX EXCEPTION PROCESSOR SPACE 4 TITL R:STRT -- SYSTEM START UP * * SYSTEM START UP OR POWER UP RESTART PROCESS * * SPACE 1 ROM REL SPACE 1 R:STRT EQU $ COPY =R:LSTK,A SET UP SYSTEM SACK COPY A,L COPY =R:KSTK,A SYSTEM ORIGINAL K COPY R:PFK,Q GET SYSTEM STACK FLAG AND K VALUE JEQ Q,GOTK IF NOT ON SYSTEM STACK AT P/F COPY Q,A GET K FROM P/F GOTK EQU $ COPY A,K  COPY R:PFLG,A CHECK IF THERE WAS A POWER FAIL JNE A,$+2 IF POWER FAIL RECOVERY JMP R:NOPF  IF NOT POWER FAIL TO INITIALIZATION COPY R:CDRG,A RESTORE THE CONSOLE WORD REGISTER SELP A,4  COPY R:SNSW,A RETORE SENSE SWITCH STATE OUT A,CONDA:+CIRFC: R:INI1 EQU $ R:NOPF RETURNS HERE COPY R:PFLG,A PASS POWER FAIL FLAG JSK I:INIT DO I/O INITIALIZATION JEQ A,$+2 IF NO PROBLEMS JST R:RTXEX JUMP IF EXCEPTION COPY R:PFLG,A PASS THE P/F FLAG TO USER INITIALIZATION  JSK R:UINI ALLOW USER TO DO HIS INITIALIZATION JEQ A,$+2 IF NO PROBLEMS JST R:RTXEX JUMP IF EXCEPTION COPY =0,A CLEAR POWER FAIL FLAG SIN 7 NO INTERRUPTS TILL WE GET CONTEXT OF STACK COPY A,R:PFK CLEAR THE K FLAG EXCH A,R:PFLG JNE A,PF IF REALLY POWER FAIL JMP R:DISP GO SCHEDULE ACTIVITY IN R:INTQ PF EQU $ COPY =-8,A GET APPROPRIATE MASK AND R:SREG,A NO BYTE OV OR CY POP WILL RESTORE THEM (REA # 3938) OR A,S RESTORE STATUS REGISTER SIN 6  THIS SIN MUST REACH POP/RSK IN DISPATCHER. JMP R:DISP GO DISPATCH WHOEVER WAS RUNNING LPOOL * 1  TITL * * RECIEVES CONTROL THRU JMP AT LOCATION :8E * ON POWER FAIL TRAP OCCURRENCE * * R:PWRF EQU $ EXCH R:PFLG,A (REA # 3938) JEQ A,NOPWR IF YES, THEN SAVE INFORMATION JMP DEAD GO HALT NOPWR EQU $  COPY =1,A SET UP SET P/F FLAG EXCH A,R:PFLG * SAVE CONTEXT, CANNOT USE 'PUSH'; MIGHT CAUSE EXCEPTION  EXCH Y,K SAVE K, PREPARE TO SAVE CONTEXT SUB =7,Y MAKE ROOM ON STACK FOR CONTEXT  COPY A,LAST:A(Y) SAVE A COPY Q,LAST:Q(Y) SAVE Q COPY X,LAST:X(Y) SAVE X COPY K,A  SAVE Y COPY A,LAST:Y(Y) SAVE L COPY PFTA:,A SAVE P COPY A,LAST:P(Y) SIN 15 COPY S,A SAVE S COPY A,LAST:S(Y) COPY A,R:SREG ALSO IN BASE PAGE IN CONDA:+CDR:,A CONSOLE WORD REGISTER COPY A,R:CDRG SAVE THE CONTENTS IN CONDA:+CSSFC:,A READ SENSE SWITCH STATE COPY A,R:SNSW SAVE IT COPY L,A SAVE L COPY A,LAST:L(Y) COPY =R:LSTK,Q IS THIS THE SYSTEM STACK CSN A,Q IS THIS THE SYSTEM STACK JMP SYS  YES -- GO SET FLAG COPY R:ACT,X USER STACK SAVE K IN USERS ACB COPY Y,AC:K(X) JMP DEAD * ON SYSTEM STACK WHEN POWER WENT SYS EQU $ COPY Y,R:PFK SAVE K AS POWER UP K DEAD EQU $ HLT  DIE -- HOPEFULLY WITH GRACE. LPOOL END TITL RM:DIS -- DISPATCHER S4161* 93416-1* IFT CHKOT: NAM G:F ENDC NAM R:GTS,R:GVSH,R:GVST TITL * * ALLOCATES THE FIRST BLOCK IN THE SYSTEM FREEPOOL BY * RETURNING A POINTER TO IT IN X. * SPACE 1 ROM REL SPACE 1 IFT CHKOT: G:F EQU $ ENDC R:GTS EQU $ SIN 5 SUPPRESS INTERRUPTS TEMPORILY COPY R:FPH,X FREEPOOL HEAD JNE X,FULL IF FREEPOOL IS NOT EMPTY * SYSTEM FREEPOOL IS EMPTY, GIVE EXCEPTION COPY =-EX:SFP,A EXCEPTION CODE * RETURN RSK FULL EQU $ COPY 0(X),Q REMOVE BLOCK FROM LIST COPY  Q,R:FPH NEW FIRST BLOCK ADDRESS JNE Q,NOTEMP IF LIST IS NOT YET EMPTY COPY Q,R:FPT ZERO TAIL POINTER SINCE NO LONGER VALID NOTEMP EQU $ IFT R:CHEK IMS FPCNT: BUMP THE FREEPOOL ALLOCATION COUNT SIN 3 COPY FPCNT:,Q GET CURRENT COUNT OF ALLOCATED BLOCKS COPY FPMAX:,A GET THE MAX ALLOCATED SO FAR CSM A,Q IS THIS IS NEW MAX COPY Q,FPMAX: LT,NEW MAXIMUM NOP ENDC COPY =0,A GOOD STATUS * RETURN RSK * TITL * * RETURNS THE BLOCK ADDRESSED BY X TO THE END OF THE * SYSTEM FREEPOOL LIST * * R:GVST EQU $ COPY =0,A ALWAYS GOOD STATUS COPY A,0(X) ZERO NEXT POINTER IN BLOCK BEING RETURNED IFT R:CHEK IMS CHECK:(X) SIN 2  COPY FPCNT:,Q GET CURRENT COUNT OF ALLOCATED BLOCKS SUB =1,Q DECREMENT IT FOR THE ONE RETURNED 2  COPY Q,FPCNT: PUT BACK THE COUNT ENDC SIN 3 EXCH X,R:FPT NEW TAIL, GET OLD TAILS ADDRESS COPY R:FPT,Q SAVE ADDRESS OF BLOCK BEING RETURNED JNE X,NOHEAD IF LIST WAS NOT EMPTY COPY Q,R:FPH EMPTY LIST MEANS NOW BLOCK IS HEAD & TAIL JMP GVSTEX NOHEAD EQU $ COPY Q,0(X) LINK NEW BLOCK TO OLD TAIL GVSTEX EQU $ RSK * TITL R:GVSH -- RETURN SYSTEM FREEPOOL BLOCK TO HEAD * * RETURNS THE BLOCK ADDRESSED BY X TO THE HEAD OF THE * SYSTEM FREEPOOL FREELIST. R:GVSH EQU $ IFT R:CHEK  IMS CHECK:(X) SIN 2 COPY FPCNT:,Q GET CURRENT COUNT OF ALLOCATED BLOCKS SUB =1,Q  DECREMENT IT FOR THE ONE JUST RETURNED COPY Q,FPCNT: PUT BACK THE COUNT ENDC SIN 4 COPY R:FPH,Q POINTER TO OLD FIRST BLOCK COPY Q,0(X) LINK IN NEW BLOCK COPY X,R:FPH JNE Q,NOTAIL IF LIST WAS NOT EMPTY COPY X,R:FPT BLOK IS ALSO TAIL OF LIST NOTAIL EQU $ COPY  =0,A GOOD STATUS RSK IFT R:CHEK NAM FPCNT:,FPMAX: FPCNT: RES 1,0 COUNT OF CURRENTLY ALLOCATED BLOCKS FPMAX: RES 1,0 MAXIMUM ALLOCATED SO FAR ENDC LPOOL END NAM R:PAUS EXTR R:PRID,R:SACT,R:DISP SPACE 4 * * TAKES THE PRIORITY DESCRIPTOR IN X REGISTER * AND EVALUATES IT. BEGINS A SYSTEM ACTIVITY WHICH * REMOVES THE FIRST ACTIVITY WITHTHIS PRIORITY FROM TH E R:RDY LIST * AND INSERTS THE ACB INTO THE R:INTQ. * IT THEN EXITS TO THE DISPATCHER. THIS ROUTINE THEN RETURNS TO THE CAL * SPACE 1 ROM REL SPACE 1 R:PAUS EQU  $ COPY X,Q PRIORITY DESCRIPTOR TO Q JSK R:PRID EVALUATE DESCRIPTOR RESULT IN Q JGE A,SRPAUS IF NO PRIORITY PROBLEM RSK * SRPAUS EQU $ JSK R:SACT BEGIN SYSTEM ACTIVITY WORD RPAUS ACTIVITY TO BE STARTED RSK RETURN TO CALLER * * * SYSTEM ACTIVITY BEGINNING * * * X= BEGINNERS STACK ADDRESS RPAUS EQU $ COPY LAST:Q(X),Q GET PRIORITY VALUE COPY =R:RDY,X FIRST ACB ON LIST RPNEXT EQU $  COPY X,Y SAVE LAST R:RDY COPY AC:PER(X),X MOVE TO NEXT ACB ON LIST RPAUS2 JEQ X,RPAUS1 NO ONE IN R:RDY LIST CSK Q,AC:PRI(X) IS THIS THE FIRST ACTIVITY FOR THIS PRIORITY JMP RPNEXT NO,GO FIND IT JMP RPAUS1 COPY:M AC:PER(X),Q,AC:PER(Y) REMOVE ACB FROM R:RDY LIST SIN 2 COPY R:INTQ,Q PUT HIM INTO R:INTQ COPY Q,AC:PER(X) COPY X,R:INTQ RPAUS1 EQU $ JMP R:DISP GO TO DISPATCHER LPOOL  END X,Y SAVE LAST R:RDY COPY AC:PER(X),X MOVE TO NEXT ACB ON LIST RPAUS2 JEQ X,RPAUS1 NO ONE IN R:RDY LIST CSK Q,AC:PRI(X) IS THIS THE FIRST ACTIVITY FOR THIS PRIORITY JMP RPNEXT NO,GO FIND IT JMP  TITL RTX EXCEPTION PROCESSING - RTXEXPR - 93411-18 C1 TITL HARDWARE TRAP EXCEPTION PROCESSING * * THIS SECTION OF THE RTX EXCEPTION PROCESSOR HANDLES EXCEPTIONS CAUSED * BY HARDWARE TRAPS INCLUDING STRAP 0 AND UNIMPLEMENTED STRAPS. * SPACE 3 NAM R:AE3 TH ARITHMETIC EXCEPTION TRAP HANDLER NAM R:CNTH CHARACTER/NUMERIC TRAP HANDLER NAM R:USTH USER TRAP HANDLER NAM R:UMTH UNINSTALLED MEMORY TRAP HANDLER NAM R:UITH UNIMPLEMENTED INSTRUCTION TRAP HANDLER NAM R:TRAPX ILLEGAL INSTRUCTION RETURN NAM R:SETH STACK EXCEPTION TRAP HANDLER NAM R:USTREX STRAP OUT OF RANGE EXCEPTION PROCESSOR SPACE 1 EXTR R:EMUL EMULATOR EXTR R:FATL RTX FATAL ERROR SPACE 60 * * ARITHMETIC EXCEPTION TRAP PROCESSOR * SPACE 1 ROM REL SPACE 1 R:AETH EQU $ PUSH XA:V SAVE REGISTERS SIN 2 COPY AETA:,X X = NEXT P COPY AETA:+1,A A = INSTRUCTION CAUSING TRAP COPY =XV:AERTP,Q Q = OFFSET INTO EXCEPTION VECTOR JMP TRAP FINISH EXCEPTION PROCESS SPACE 3 * * CHARACTER/NUMERIC EXCEPTION TRAP PROCESSOR * R:CNTH EQU $ PUSH XA:V SAVE REGISTERS SIN 2 COPY CNTA:,X X = NEXT P COPY CNTA:+1,A A = INSTRUCTION CAUSING TRAP COPY =XV:CNMTP,Q Q = OFFSET INTO EXCEPTION VECTOR JMP TRAP FINISH EXCEPTION PROCESS SPACE 3 * * USER TRAP PROCESSOR * R:USTH EQU $ PUSH XA:V SAVE REGISTERS SIN 2 COPY USTA:,X X = NEXT P COPY USTA:+1,A A = UTRAP INSTRUCTION COPY =XV:USRTP,Q Q = OFFSET INTO EXCEPTION VECTOR JMP TRAP FINISH EXCEPTION PROCESS SPACE 3 * * UNINSTALLED MEMORY TRAP PROCESSOR * R:UMTH EQU $ PUSH XA:V SAVE REGISTERS SIN 2 COPY UMTA:,X X = UNDEFINED COPY UMTA:+1,A A = UNDEFINED COPY =XV:MEMTP,Q Q = OFFSET INTO EXCEPTION VECTOR JMP TRAP FINISH EXCEPTION PROCESS SPACE 3 * * UNIMPLEMENTED INSTRUCTION TRAP PROCESSOR * R:UITH EQU $ SIN 2 ENOUGH TO GET TO EMULATOR JMP R:EMUL JUMP TO EMULATOR (IF ONE EXISTS) LPOOL * * STRAP OUT OF RANGE EXCEPTION PROCESSOR * R:USTREX EQU $ COPY =XV:USTEX,Q Q = OFFSET INTO EXCEPTION VECTOR JMP TRAPX FINISH EXCEPTION PROCESS SPACE 3 LPOOL SPACE 60 ** ROUTINE: TRAP * * THIS ROUTINE FINISHES PROCESSING OF HARDWARE TRAP EXCEPTIONS. IT IS * JUMPED TO BY ALL HARDWARE TRAP PROCESSORS EXCEPT THE STACK EXCEPTION * TRAP PROCESSOR. * * CALLING SEQUENCE: * JMP TRAP (FOR NORMAL TRAPS) * OR * JMP TRAPX (IF NEXT P SAVED ON STACK) * ENTRY: * Q = OFFSET INTO EXCEPTION VECTOR FOR THIS TRAP * X = CONTENTS OF HARDWARE TRAP LOCATION * A = CONTENTS OF HARDWARE TRAP LOCATION+1 * * EXIT: * CONTROL IS TRANSFERRED TO THE EXCECPTION PROCESSOR SPECIFIED BY THE * EXCEPTION VECTOR IN THE ENVIRONMENT DESCRIPTOR BLOCK (EDB). IF NO * EXCEPTION PROCESSOR IS SPECIFIED, THE EXCEPTION VECTOR IN THE NEXT * HIGHER EDB WITHIN THE EDB HIGHER ARC TICKLE STRUCTURE IS CHECKED. * IF NO EXCEPTION PROCESSOR IS SPECIFIED IN ANY EDB, A JMP IS TAKEN * TO R:FATL AND THE PROCESSOR HALTS. * ** SPACE 1 TRAP EQU $ COPY K,Y Y = STACK INDEX COPY X,LAST:P(Y) SAVE NEXT P ON STACK R:TRAPX EQU $ ENTER HERE FROM ILLEGAL INSTRUCTION EMULATOR TRAPX EQU $ COPY R:ACT,X X = ACB ADDRESS COPY AC:ECB(X),X X = ECB/EDB ADDRESS ECBLOOP EQU $ COPY Q,Y Y = EXCEPTION VECTOR OFFSET COPY ED:EVT(X,Y),Y Y = EXCEPTION PROCESSOR ADDRESS JEQ Y,NOXVENT JUMP IF NO EXCEPTION PROCESSOR COPY K,X X = STACK INDEX COPY LAST:P(X),X X = NEXT P JMP 0(Y) JUMP TO ENVIRONMENT EXCEPTION PROCESSOR * * COME HERE IF NO EXCEPTION PROCESSOR FOUND IN EDB * NOXVENT EQU $  COPY EC:MST(X),X SEE IF HIGHER LEVEL ECB JNE X,ECBLOOP LOOP BACK IF MASTER ECB * * COME HERE IF NO EXCEPTION PROCESSOR ANYWHE4 RE * COPY =EX:TRP,A LOAD EXCEPTION CODE COPY K,X COPY LAST:P(X),X X = NEXT P JMP R:FATL LPOOL SPACE 60 * * STACK EXCEPTION TRAP PROCESSOR * R:SETH EQU $ SIN :E PREVENT ADDITIONAL STACK EXCEPTION COPY X,A SAVE X, A HAS BEEN SAVED COPY R:ACT,X X = ACB ADDRESS COPY AC:ECB(X),X X = ECB/EDB ADDRESS COPY ED:EVT+XV:STKSV(X),X X= REGISTER SAVE AREA JEQ X,NOSAVE JUMP IF NOT TO SAVE REGISTERS COPY A,STKSV:X(X) SAVE X COPY Q,STKSV:Q(X) SAVE Q COPY Y,STKSV:Y(X) SAVE Y COPY R:SVA,A GET SAVED A COPY A,STKSV:A(X) SAVE A NOSAVE EQU $ COPY R:ACT,X X = ACB ADDRESS COPY AC:ECB(X),X X = EDB/EDB ADDRESS STKXLOOP EQU $ SIN 7 ENOUGH TO GET TO USER COPY ED:EVT+XV:STKTP(X),Y Y = STACK EXCEPTION PROCESSOR ADDRESS JEQ Y,NOSTKXPR JUMP IF NO PROCESSOR COPY SETA:,X X = NEXT P COPY SETA:+1,A A = INSTRUCTION CAUSING TRAP JMP 0(Y) JUMP TO EXCEPTION PROCESSOR * * COME HERE IF NO EXCEPTION PROCESSOR FOUND IN EDB * NOSTKXPR EQU $ COPY EC:MST(X),X SEE IF MASTER ECB JNE X,STKXLOOP LOOP BACK IF MASTER * * COME HERE IF NO EXCEPTION PROCESSOR FOUND ANYWHERE * COPY SETA:,X X = WHERE TRAP OCCURRED COPY =EX:TRP,A COPY =XV:STKTP,Q Q = EXCEPTION VECTOR OFFSET JMP R:FATL SPACE 3 LPOOL END TITL RTX EXCEPTION PROCESSING - RTXEXPR - TITL RTX NON-HARDWARE EXCEPTION PROCESSING * * THIS SECTION OF THE RTX EXCEPTION PROCESSING HANDLES EXCEPTIONS * GENERATED BY SYSTEM SOFTWARE. * SPACE 3 NAM R:STR0EX STRAP 0 EXCEPTION PROCESSOR NAM R:DOOREX RTX DOOR EXIT EXCEPTION PROCESSOR NAM R:RTXEX FATAL RTX EXCEPTION PROCESSOR NAM R:XPTE SAME AS R:RTXEX (OLD NAM) NAM R:TABL RTX TABLE ID EXCEPTION PROCESSOR NAM R:SYSX RTX SYSTEM STACK VIOLATION EXCEPTION PROCESSOR SPACE 1 EXTR R:FATL RTX FATAL ERROR SPACE 60 * * STRAP 0 EXCEPTION PROCESSOR * SPACE 1 ROM REL SPACE 1 R:STR0EX EQU $ COPY =XV:ST0EX,Q Q = OFFSET INTO EXCEPTION VECTOR JMP RTXEXCPT FINISH EXCEPTION PROCESS SPACE 3 * * RTX DOOR EXIT EXCEPTION PROCESSOR * R:DOOREX EQU $ COPY =XV:DOREX,Q Q = OFFSET INTO EXCEPTION VECTOR JMP RTXEXCPT FINISH EXCEPTION PROCESS SPACE 3 LPOOL SPACE 60 ** ROUTINE: RTXEXCPT * * THIS ROUTINE FINISHES PROCESSING OF NON-HARDWARE RTX SYSTEM * EXCEPTIONS. IT IS JUMPED TO BY ALL OF THE NON-HARDWARE * EXCEPTION PROCESSORS EXCEPT DEBUGGING EXCEPTION PROCESSORS. * * CALLING SEQUENCE: * JMP RTXEXCPT * * ENTRY: * Q = OFFSET INTO EXCEPTION VECTOR FOR THIS EXCEPTION * A = NEGATIVE EXCEPTION CODE * * EXIT: * CONTROL IS TRANSFERRED TO THE EXCEPTION PROCESSOR SPECIFIED BY THE * EXCEPTION VECTOR IN THE ENVIRONMENT DESCRIPTOR BLOCK (EDB). IF NO * EXCEPTION PROCESSOR IS SPECIFIED, THE EXCEPTION VECTOR IN THE NEXT * HIGHER EDB WITHIN THE EDB HIGHER ARC TICKLE STRUCTURE IS CHECKED. * IF NO EXCEPTION PROCESSOR IS SPECIFIED IN ANY EDB, A JMP IS TAKEN * TO R:FATL AND THE PROCESSOR HALTS. * ** SPACE 1 RTXEXCPT EQU $ COPY R:ACT,X X = ACB ADDRESS COPY AC:ECB(X),X X = ECB/EDB ADDRESS ECBLOOP EQU $ COPY Q,Y Y = EXCEPTION VECTOR OFFSET COPY ED:EVT(X,Y),Y Y = EXCEPTION PROCESSOR ADDRESS JEQ Y,NOXVENT JUMP IF NO EXCEPTION PROCESSOR JMP 0(Y) JUMP TO ENVIRONMENT EXCEPTION PROCESSOR * * COME HERE IF NO EXCEPTION PROCESSOR FOUND IN EDB * NOXVENT EQU $ COPY EC:MST(X),X SEE IF HIGHER LEVEL ECB JNE X,ECBLOOP LOOP BACK IF MASTER ECB * * COME HERE IF NO EXCEPTION PROCESSOR ANYWHERE * NEG A,A MAKE COD5 E POSITIVE JMP R:FATL LPOOL SPACE 60 * * FATAL RTX EXCEPTION PROCESSOR * SPACE 1 REL SPACE 1 R:XPTE EQU $ R:RTXEX ENT SIN 3 COPY R:RTXEX,X X = ADDRESS+1 WHERE ERROR OCCURRED JMP RTXFATL FINISH EXCEPTION PROCESSING SPACE 3 * * RTX TABLE IDENTIFIER EXCEPTION PROCESSOR * R:TABL ENT SIN 4 COPY =-EX:TBL,A A = NEGATIVE EXCEPTION CODE COPY R:TABL,X X = ADDRESS+1 WHERE ERROR OCCURRED JMP RTXFATL FINISH EXCEPTION PROCESSING * * RTX SYSTEM STACK VIOLATION EXCEPTION PROCESSOR * R:SYSX ENT SIN 4 COPY =-EX:SYS,A A = NEGATIVE EXCEPTION CODE COPY R:SYSX,X X = ADDRESS+1 WHERE ERROR OCCURRED JMP RTXFATL FINISH EXCEPTION PROCESSING  SPACE 60 ** ROUTINE: RTXFATL * * THIS ROUTINE PROCESSES RTX FATAL ERRORS. THESE ARE USUALLY CAUSED BY * RTX DEBUG EXCEPTIONS. * * CALLING SEQUENCE: * JMP RTXFATL * * ENTRY: * A = NEGATIVE EXCEPTION CODE * X = ADDRESS WHERE EXCEPTION OCCURRED+1 * * EXIT: * CONTROL IS TRANSFERRED TO THE EXCEPTION VECTOR SPECIFIED IN THE EDB. * IF NO EXCEPTION PROCESSOR IS SPECIFIED A JMP IS MAKE TO R:FATL. * ** SPACE 1 ROM REL SPACE 1 RTXFATL EQU $ SIN 4 NO INTERRUPTS COPY X,XSAVE SAVE X REGISTER COPY R:ACT,X X = ACB ADDRESS COPY AC:ECB(X),X X = ECB/EDB ADDRESS FECBLOOP EQU $ SIN 8 NO INTERRUPTS COPY ED:EVT+XV:RTXEX(X),Y Y = POINTER TO EXCEPTION PROCESSOR JEQ Y,NORTXXV JUMP IF NO PROCESSOR COPY XSAVE,X RESTORE X REGISTER JMP 0(Y) JUMP TO EXCEPTION PROCESSOR * * COME HERE IF NO EXCEPTION PROCESSOR FOUND IN EDB * NORTXXV EQU $ COPY EC:MST(X),X SEE IF MASTER ECB JNE X,FECBLOOP LOOP IF MASTER ECB * * COME HERE IF NO EXCEPTION PROCESSOR ANYWHERE * NEG A,A A = EXCEPTION CODE COPY XSAVE,X GET X REGISTER COPY =XV:RTXEX,Q A = EXCEPTION VECTOR OFFSET JMP R:FATL LPOOL SPACE 1 REL SPACE 1 XSAVE RES 1,0 X REGISTER SAVE AREA SPACE 1 END EXCEPTION PROCESSOR JEQ Y,NORTXXV JUMP IF NO PROCESSOR COPY XSAVE,X RESTORE X REGISTER JMP 0(Y) JUMP TO EXCEPTION PROCESSOR * * COME HERE IF NO EXCEPTION PROCESSOR FOUND IN EDB * NORTXXV EQU $ COPY EC:MST(X),X SEE IF MASTER ECB JNE X,FECBLOOP LOOP IF MASTER ECB * * COME HERE IF NO EXCEPTION PROCESSOR ANYWHERE * NEG A,A A = EXCEPTION CODE COPY XSAVE,X GET X REGISTER COPY =XV:RTXEX,Q A = EXCEPTION VECTOR OFFSET JMP R:FATL LPOOL SPACE 1 REL SPACE 1 XSAVE RES 1,0 X REGISTER SAVE AREA S TITL RTX MISCELLANEOUS - RTXMISC - 93411-19 B3 TITL R:RINT -- REINITIALIZATION CONTROL REV SET 'C1' 79/1/16 VAW * ADDED R:HIGHER TO FILE NAM REINI: SNAM R:RINT EXTR R:TABL EXTR R:TKAC,R:LTIC,R:KTIC,R:TICP EXTR R:CNSM EXTR R:SECB,R:NECB,R:DECB EXTR R:CNTK SPACE 6 * * JSK R:RINT REINITIALIZE RTX * * A-REG RETURNS STATUS A=0 NORMAL * A<0 ERROR * SPACE 1 ROM REL SPACE 1 REINI: EQU $ IFT CHKOT: G:R EQU $ ENDC R:RINT EQU $ COPY =0,A  ZERO TO COPY A,R:RDY READY LIST HEAD COPY A,R:ACT CURRENT ACTIVITY COPY A,R:CCBH TICK CLOCK LIST HEAD COPY A,R:WCBH WALL CLOCK LIST HEAD COPY A,R:CNTK CONSOLE INTERRUPT TIMER SEMAPHORE  COPY A,R:CNSM CONSOLE INTERRUPT SEMAPHORE COPY A,R:INVL TICK CLOCK INTERVAL COPY A,RTCNC: REAL TIME CLOC6 K INCREMENT LOCATION COPY A,R:INTQ INTERRUPT QUEUE. * NOW SET UP THE TICK CLOCK COPY =R:KTIC,Y POINT TO INITIAL CONTEXT COPY:M =R:LTIC,A,LAST:L(Y) L COPY:M =XA:V,A,LAST:S(Y) S COPY =0,A COPY  A,LAST:A(Y) A COPY A,LAST:Q(Y) Q COPY A,LAST:X(Y) X COPY A,LAST:Y(Y)  Y COPY:M =R:TICP,A,LAST:P(Y) P COPY =R:TKAC,X ADDRESS OF TICK CLOCK ACB. COPY =0,A ZERO COPY A,AC:PER(X) PEER POINTER COPY A,AC:FLG(X) FLAGS COPY Y,AC:K(X) INITIALIZE K  COPY X,R:CLKS HANG ACB ON CLOCK SEMAPHORE * NOW INITIALIZE THE ECBS JSK R:SECB GET FIRST ECB. LOOP JSK R:IECB INITIALIZE IT. JLT A,ERROR JSK R:NECB GET NEXT ECB. BACK JLT A,ERROR JEQ Y,DONE DONE IF POINTER IS ZERO. COPY EC:FLG(Y),Q SEE IF ECB WAS DYNAMICALLY ALLOCATED. TBIT ECF:DA,Q JF OV,LOOP IF NOT, INITIALIZE IT. JSK R:DECB IF SO, DELETE FROM ECB TREE. JMP BACK DONE EQU $ ERROR RSK LPOOL TITL * * * Y-REG CONTAINS ADDRESS OF ECB. * JSK R:IECB INITIALIZE ECB * * A-REG RETURNS STATUS A=0 NORMAL RETURN * R:IECB EQU $ COPY =0,A ZERO THE ACTIVITY COUNT. COPY A,EC:CNT(Y) COPY ED:TLH(Y),X * * INITIALIZE TASK DESCRIPTOR BLOCKS * TDB1 JEQ X,SL0A JUMP IF END OF TDB LIST. CHK: X,=TD:CHK COPY TD:NOX(X),A INIT VALUE IS IN TD:NOX. COPY X,Q COPY TD:USA(X),X GET ADDRESS OF SEMAPHORE. COPY A,0(X) STORE INITIAL VALUE. COPY Q,X COPY TD:PER(X),X PROCESS NEXT TDB IN LIST. JMP TDB1 TITL * *  INITIALIZE SEMAPHORE * SL0A EQU $ COPY ED:SLH(Y),X GET SEMAPHORE LIST HEAD SL EQU $ JEQ  X,MLH1 JUMP IF END OF LIST CHK: X,=SD:CHK,3 COPY SD:FLG(X),A STORE INITIAL VALUE BACK TO SEMAPHORE AND =:FF,A COPY A,SD:SEM(X) COPY SD:PER(X),X GET NEXT SEMAPHORE ADDRESS JMP SL  PROCESS NEXT SEMAPHORE * * INITIALIZE MAILBOXES * MLH1 COPY =1,A INIT VALUE OF MAILBOX SEMAPHORE.  COPY =0,Q INIT VALUE OF MESSAGE SEMAPHORE. COPY ED:MLH(Y),X LOAD LIST HEAD MLH2 JEQ X,MLH3  JUMP IF END OF LIST. CHK: X,=MD:CHK COPY A,MD:MBX(X) STORE INIT VALUE IN MAILBOX SEMAPHORE.  COPY Q,MD:MSG(X) STORE INIT VALUE IN MESSAGE SEMAPHORE COPY MD:PER(X),X PROCESS NEXT MAILBOX. JMP  MLH2 MLH3 EQU $ COPY =0,A ALL'S WELL THAT ENDS WELL. OUT RSK LPOOL END TITL RM:MSC -- MISCELLANEOUS S4161* 93416-1* TITL RM:WLK -- WALK THROUGH ECB TREE NAM R:SECB,R:NECB,R:DECB EXTR R:TABL SPACE 4 * * RETURNS ECB ADDRESS IN Y * SPACE 1 ROM REL SPACE 1 R:SECB EQU $ COPY R:ECBH,Y GET ECB LIST HEAD ADDRESS COPY =-1,A JEQ Y,ERROR IF NO ECBS CHK: Y,=EC7 :CHK VERIFY TABLE ID COPY =0,A GOOD STATUS ERROR EQU $ RSK R:NECB EQU $ PHONY ROUTINE COPY =0,A SET UP GOOD STATUS COPY =0,Y SET DONE FLAG RSK RETURN R:DECB EQU $ PHONY ROUTINE RSK JUST IN CASE CALLED LPOOL END * * THIS IS A ROUTINE WHICH CHECKS THE IDS OF A CONTROL * BLOCK (ADDRESS IN Y REGISTER) AGAINST THOSE IN A LIST * OF CONTROL BLOCKS (ADDRESS OF LIST HEAD IN X) FOR DUPLICATE. * A 0 RETURNED IN THE A REGISTER INDICATES THAT NO DUPLICATE * IS FOUND. OTHER WISE A -1 IS RETURNED IN THE A REGISTER * AND THE X REGISTER CONTAINS THE ADDRESS OF THE BLOCK WHICH * HAS DUPLICATE IDS, Q CONTAINS THE PRIOR BLOCK ADDRESS * NOTE- * WHEN BLOCK ID HAS THE VALUE 0, THE RESULT IS AS IF NO * DUPLICATE IS FOUND. * NAM R:DCHK SPACE 1 ROM REL SPACE 1 R:DCHK EQU $ COPY IDENT:(Y),A CHECK FOR 0 ID JEQ A,NODUP ID IS 0, ASSUME NO DUPLICATE FOUND COPY X,Q SAVE PRIOR BLOCK ADDRESS COPY PEER:(X),X GET NEXT CONTROLL BLOCK JEQ X,NODUP QUIT, LIST IS EMPTY COPY IDENT:(Y),A GET ID CSK A,IDENT:(X) CHECK FOR DUPLICATE JMP NEXT NOT A DUPLICATE JMP NEXT NOT A DUPLICATE COPY MASTR:(Y),A DUPLICATE ID, CHECK ENVIRONMENT CSK A,MASTR:(X) CHECK ENVIRNMENT JMP  NEXT OK,DIFFERENT ENVIRNMENT JMP NEXT OK,DIFFERENT ENVIRNMENT JMP DUPFND DUPLICATE FOUND NEXT EQU $ JMP R:DCHK KEEP CHECKING * DUPFND COPY =-1,A STATUS FOR DUPLICATE  RSK RETURN * NODUP COPY =0,A STATUS FOR NO DUPLICATE RSK RETURN  END TITL RM:MSC -- MISCELLANEOUS S4161* 93416-1* TITL R:NOPF -- NON-POWER FAIL INITIALIZATION NAM R:NOPF NAM R:HIGH END OF RTX EXTR R:WLKS EXTR R:SSIG EXTR R:RWAL EXTR R:INIT,R:UMTH,R:DISP EXTR R:RINT EXTR R:BEGI,R:GTS EXTR R:XPTE,R:TABL EXTR R:INI1 EXTR STTLF: EXTR R:HIGHER SPACE 3 * * DUMMY MEMORY TRAP HANDLER FOR RTX MEMORY INITIALIZATION SEARCH * MEMTRAP ENT JMP FINDMN JUMP TO MEMORY DECREMENT ROUTINE * * IMAGE TO STORE IN TRAP LOCATION FOR SEARCH * SRCHTRAP JST *$+1 WORD MEMTRAP SPACE 1 TRAPSAVE RES 2,0 REGULAR TRAP SAVE AREA SPACE 60 * * INITIAL START UP OR RESTART, NOT P/F RECOVERY * SPACE 1 ROM REL SPACE 1 R:NOPF EQU $  JSK R:RINT * FIND END OF MEMORY COPY:M UMTA:+2,A,TRAPSAVE SAVE TRAP SEQUENCE COPY:M UMTA:+3,A,TRAPSAVE+1 COPY:M SRCHTRAP,A,UMTA:+2 SET SEARCH MEMORY TRAP COPY:M SRCHTRAP+1,A,UMTA:+3 COPY =R:INIT,X GET END OF MEMORY ADDRESS  COPY IN:EOM(X),X . R:INIT CALL, BEGIN SEARCH THERE FINDMN EQU $ SUB =256,X DECREMENT MEMORY POINTER COPY =-1,A SET TO ALL ONES EXCH A,0(X) ACCESS MEMORY EXCH A,0(X) ACCESS MEMORY IJNE A,FINDMN BUMP RESUTS, IF NOT RAM EXCH A,0(X) NOW TRY TO GET BACK ZEROS EXC8 H A,0(X) JNE A,FINDMN IF FAILURE MUST BE ROM TITL * FOUND END OF MEMORY GOTMN EQU $ ADD =255,X MOVE X TO TOP OF THIS MEMORY COPY X,R:EMEM SAVE THIS AS END OF MEMORY ADDRESS COPY:M TRAPSAVE,A,UMTA:+2 RESTORE STANDARD TRAP CODE COPY:M TRAPSAVE+1,A,UMTA:+3 * MAKE ENVIRONMENT MEMORY POOL COPY =R:INIT,Y COPY IN:ECB(Y),Y ECB ADDR CHK: Y,=EC:CHK DEBUG CHECK FOR ECB TABLE ID * DETERMINE END OF CODE EXCH ED:MPA(Y),X GET THE END OF THE USER PROGRAM COPY =R:HIGHER,A END OF RTX CSM X,A COMPARE TO GET END OF WHOLE SYSTEM COPY A,X LT; RTX WAS LOADED BEHIND USER, CHANGE END NOP GT; RTX WAS LOADED BEFROE USER PROGRAM EXCH X,ED:MPA(Y) PUT END ADDRESS BACK COPY ED:MPA(Y),Y MEMORY POOL ADDRESS SUB  Y,X CALCULATE LENGTH OF E.M.P COPY X,EM:LEN(Y) SET UP THE EMP DEXCRIPTOR COPY Y,X ADD =EM:PTR+1,X FIRST BLOCK ADDRESS COPY X,EM:PTR(Y) ADDRESS OF FIRSTBLOCK * INITIALIZE THE E.M.P BLOCK * START OUT WITH ONE BIG BLOCK OF ALL ZEROS COPY EM:LEN(Y),X PUT LENGTH OF BLOCK INTO HEADER SUB =EM:PTR+1,X  COMPUTE BLOCK LENGTH COPY X,EM:PTR+EM:LEN+1(Y) LENGTH TO THE BLOCK HEADER * SET UP SYSTEM FREEPOOL * COPY =R:INIT,Y GET SYSTEM FREEPOO INFORMATION COPY IN:FPL(Y),Q . LENGTH OF FREEPOOL COPY IN:FPA(Y),Y . ADDRESS OF FREEPOOL COPY =SEMAX:,A INSURE FREEPOOL IS ABOVE SEMAPHORE ADDRS CSM A,Y JMP  OK1 FREEPOOL IS OK. NOP COPY =-EX:SFP,A FREEPOOL IS IN ILLEGAL LOCATION JST R:XPTE  GIVE EXCEPTION, FATAL ONE OK1 EQU $ IFT R:CHEK ADD =1,Y ALLOW FOR DEBUG ID WORD  ENDC COPY =R:FPH,X . SET UP HEAD POINTER COPY =0,A NUBLK EQU $ SUB =BLKSZ:,Q IS THERE SPACE LEFT FOR ANOTHER BLOCK JLT Q,ENDFP .IF NOT TAKE CARE OF TAIL POINTER COPY Y,0(X)  LINK LASTR BLOCK TO CURRENT COPY Y,X MOVE TRAILING POINTER TO CURRENT BLOCK ADD =BLKSZ:,Y  MOVE FORWARD POINTER TO NEW BLOCK JMP NUBLK GO DO THIS BLOCK ENDFP EQU $ COPY A,0(X)  ZERO END BLOCKS FORWARD POINTER COPY X,R:FPT SET UP FREEPOOL TAIL POINTER TITL * * * BEGIN THE ACTIVITY *  JSK R:GTS GET A FREEPOOL BLOCK JGE A,FPOK IF REQUEST WAS FILLED JST R:XPTE  FREEPOOL PROBLEM -- FATAL ERROR * * SET UP CONTEXT BLOCK FPOK EQU $ IFT R:CHEK COPY =1,A COPY A,CHECK:(X) PUT PHONY ID INTO BLOCK ENDC COPY =R:INIT,Y INITIALIZATION BLOCK ADDRESS COPY:M IN:A(Y),A,BEG:A(X) A REGISTER COPY:M IN:Q(Y),A,BEG:Q(X) Q REGISTER COPY:M IN:X(Y),A,BEG:X(X) X REGISTER COPY:M IN:Y(Y),A,BEG:Y(X) Y REGISTER COPY:M IN:ECB(Y),A,BEG:EC(X) ECB ADDRESS COPY:M IN:TDB(Y),A,BEG:TD(X) TDB ADDRESS COPY:M IN:PRI(Y),A,BEG:PR(X) PRIORITY JSK R:BEGI BEGIN THE ACTIVITY9  JGE A,INOK IF NO PROBLEMS JST R:XPTE EXCEPTION TITL * SHOULD HAVE ACTIVITY IN R:INTQ INOK EQU $ JSK R:RWAL INITIALIZE WALL CLOCK CONTEXT JSK STTLF: SET TTLF4:  COPY =R:WLKS,X INITIATE WALL CLOCK ACTIVITY JSK R:SSIG JMP R:INI1 * LPOOL SPACE 1 REL SPACE 1 R:HIGH RES 1 END TITL R:MISC -- MISCELLANEOUS ROUTINES TITL R:HIGHER -- SHOULD BE LAST THING LOADED NAM R:HIGHER R:HIGHER REL R:HIGHER RES 1 END TITL RM:MSC -- MISCELLANEOUS S4161* 93416-1* NAM DEBUG4 EXTR R:FAT1 ROM REL DEBUG4 JMP R:FAT1 DUMMY DEBUG, FATAL ERROR END TITL RM:MSC -- MISCELLANEOUS  S4161* 93416-1* NAM I:INIT ROM REL I:INIT COPY =0,A RETURN GOOD STATUS RSK END  TITL RM:MSC -- MISCELLANEOUS S4161* 93416-1* NAM R:UINI ROM REL R:UINI COPY =0,A RETURN GOOD STATUS RSK END TITL RM:MSC -- MISCELLANEOUS S4161* 93416-1* NAM R:RINT ROM REL R:RINT COPY =0,A RETURN GOOD STATUS RSK END TITL RM:MSC -- MISCELLANEOUS S4161* 93416-1* NAM R:EMUL DUMMY EMULATOR ENTRY EXTR R:TRAPX EMULATOR RETURN ROM REL R:EMUL EQU $ PUSH XA:V SAVE REGISTERS SIN 2 COPY UITA:,X SAVE NEXT P IN X COPY UITA:+1,A SAVE INSTRUCTION CAUSING TRAP IN A COPY =XV:UINTP,Q SET OFFSET INTO EXCEPTION VECTOR IN Q COPY K,Y COPY X,LAST:P(Y) SAVE NEXT P ON STACK JMP R:TRAPX RETURN TO INTERRUPT PROCESSOR END GOOD STATUS RSK END TITL RM:MSC -- MISCELLANEOUS S4161*  TITL RTX DATE - RTXDATE - 93411-1A B3 TITL R:SATD - SET ASCII DATE AND TIME NAM R:SATD ** SYSTEM REQUEST: R:SATD * * PASS A BLOCK OF INFORMATION TO THE SYSTEM WHICH * HAS THE DATE AND TIME IN ASCII CHARACTERS * * CALLING SEQUENCE: * R:SATD ARG * WHERE ARG IS THE PARAMETER BLOCK LOCATION * * ENTRY: * X = ADDRESS OF WORD BUFFER * (X) THRU (X)+5 CONTAIN DATE AND TIME IN ASCII AS FOLLOWS: * (X)+0 = YRYR MOST SIGNIFICANT 2 DIGITS OF YEAR * (X)+1 = MOMO MONTH * (X)+2 = DADA DAY * (X)+3 = HRHR HOURS * (X)+4 = MIMI  MINUTES * (X)+5 = SESE SECONDS * * EXIT: * (X)-(X)+1 = 32 BIT BINARY TIME AS STORED IN SYSTEM *  0 IF WORD PASSED WAS BAD * ** SPACE 1 ROM REL SPACE 1 AYEAR EQU 0 AMON EQU 1 ADAY EQU 2 AHOUR EQU 3 AMIN EQU 4 ASEC EQU 5 SPACE 1 R:SATD EQU $ COPY =5,Y SETBIN EQU $ COPY 0(X),Q GET ASCII VALUE JSK CNDTB2 CONVERT TO BINARY JGE Q,VALOK JUMP IF VALUE FROM 0-99  SUB =5,X RESET BUFFER ADDRESS ADD Y,X JMP SETERR SIGNAL ERROR VALOK EQU $ COPY Q,0(X) STORE BINARY VALUE ADD =1,X INCREMENT ADDRESS JNED Y,SETBIN LOOP SUB  =6,X RESET X COPY AYEAR(X),Q CSK Q,=93 SEE IF YEAR IN RANGE JMP YROK :  JUMP IF OK SETERR EQU $ COPY =0,A COPY A,AYEAR(X) SIGNAL BAD DATE COPY A,AMON(X) RSK SPACE 1 YROK EQU $ SUB STRTYR,Q Q=YEARS RELATIVE TO 1976 JLT Q,SETERR JUMP IF DATE TOO SMALL GETMOD EQU $ COPY AMON(X),Y Y=MONTH INDEX CSK Y,=12 SEE IF MONTH IN RANGE  JMP MOOK JUMP IF OK JMP SETERR MOOK EQU $ SUB =3,Y MONTHS START AT MARCH JGE Y,MONOK JUMP IF NOT JAM OR FEB ADD =12,Y ADD BIAS IF JAN OR FEB SUB =1,Q  ADJUST YEARS JLT Q,SETERR JUMP IF LESS THAN MAR 1, 1976 MONOK EQU $ ADD =MOSUM,Y  COPY 0(Y),A A=DAYS IN MONTHS SO FAR COPY ADAY(X),Y GET DAY CSK Y,=31 SEE IF DAY IN RANGE JMP DAYOK JUMP IF OK JMP SETERR DAYOK EQU $ ADD Y,A ADD DAY  SUB =1,A DAYS START AT 1 SO COMPENSATE COPY Q,Y SHIFT Y,RO,2 NUMBER OF LEAP YEARS  ADD Y,A A=DAYS FROM MONTHS,DAYS,AND 1 PER LEAP MUL DPY,AQ Q=TOTAL DAYS COPY Q,Y  COPY =0,A MUL LQSPD,AQ Q=BOTTOM BITS MUL UQSPD,AY Y=TOP BITS COPY Y,AYEAR(X)  SAVE UPPER BITS COPY Q,AMON(X) SAVE LOWER BITS COPY ASEC(X),A GET BINARY SECONDS CSK  A,=60 SEE IF SECONDS IN RANGE JMP SECOK JUMP IF SECONDS IN RANGE JMP SETERR SECOK EQU $ SHIFT A,LO,2 CONVERT TO QUARTER SECONDS COPY AMIN(X),Q GET BINARY MINUTES CSK Q,=60 SEE IF MINUTES IN RANGE JMP MINOK JUMP IF IN RANGE JMP SETERR MINOK EQU  $ MUL QSPM,AQ Q=QUARTER SECS FROM SECS AND MINS COPY Q,A COPY AHOUR(X),Q CSK Q,=23 SEE IF HOURS IN RANGE JMP HOUROK JUMP IF IN RANGE JMP SETERR HOUROK EQU $ MUL QSPH,AQ AQ=QUARTER SECS FROM HR,MIN,SEC * * ADD AQ TO PREVIOUS SUM * RBIT CY:,S CLEAR CARRY  ADDC AMON(X),Q ADDC AYEAR(X),A COPY A,AYEAR(X) COPY Q,AMON(X) * AQ=BINARY BIME SIN 2 COPY A,R:TODU SET UPPER TIME OF DAY COPY Q,R:TODL SET LOWER TIME OF DAY COPY =0,A SIGNAL NO EXCEPTION RSK SPACE 1 LPOOL STRTYR WORD 76 STARTING YEAR DPY WORD 365 QSPM WORD 4*60 QSPH WORD 4*60*60 UQSPD WORD :0005 UPPER BITS OF QUARTER SECONDS PER DAY LQSPD WORD :4600 LOWER BITS OF QUARTER SECONDS PER DAY MOSUM EQU $ WORD 0 WORD 31 WORD 31+30 WORD 31+30+31 WORD 31+30+31+30 WORD 31+30+31+30+31 WORD 31+30+31+30+31+31 WORD 31+30+31+30+31+31+30 WORD 31+30+31+30+31+31+30+31 WORD 31+30+31+30+31+31+30+31+30 WORD 31+30+31+30+31+31+30+31+30+31 WORD 31+30+31+30+31+31+30+31+30+31+31 TITL CNDTB2 - CONVERT ASCII DECIMAL TO BINARY ** SUBROUTINE: CNDTB2 * * CONVERT AN ASCII DECIMAL NUMBER TO BINARY * * CALLING SEQUENCE: * JSK ; CNBTD2 * * ENTRY: * Q = ASCII DECIMAL VALUE * * EXIT: * EXIT: * Q = BINARY NUMBER * = -1 IF NUMBER NOT 0-99 * ** SPACE 1 CNDTB2 EQU $ AND ANDVAL,Q IGNORE PARITY SUB AIMAGE,Q CONVERT TO BINARY VALUES COPY Q,A AND =:FF,A A=UNITS SHIFT Q,RO,8 X=TENS CSK A,=9  INSURE TENS BETWEEN 0-9 JMP CKTENS JMP ERROR CKTENS CSK Q,=9 INSURE UNITS BETWEEN 0-9  JMP DATAOK JMP ERROR DATAOK EQU $ MUL TEN,AQ AQ=TENS*10+UNITS RSK  RETURN SPACE 1 ERROR EQU $ COPY =-1,Q SIGNAL ERROR RSK RETURN  SPACE 1 TEN WORD 10 AIMAGE WORD :3030 ANDVAL WORD :7F7F SPACE 1 END TITL R:GATD - RETURN ASCII DATE AND TIME NAM R:GATD SPACE 1 INTPS EQU 4 4 CLOCK INTERVALS PER SECOND SPACE 3 ** SYSTEM REQUEST: R:GATD * * PASS A BLOCK OF INFORMATION TO THE CALLING PROGRAM * WHICH HAS THE DATE AND TIME IN ASCII CHARACTERS * * CALLING SEQUENCE: * R:GATD BLOCK * WHERE BLOCK IS THE PARAMETER BLOCK LOCATION * * ENTRY: * X = ADDRESS OF WORD BUFFER * * EXIT: * (X) THRU (X)+6 CONTAIN DATE AND TIME IN ASCII AS FOLLOWS: * (X)+0 = YRYR MOST SIGNIFICANT 2 DIGITS OF YEAR * (X)+1 = MOMO MONTH * (X)+2 = DADA DAY * (X)+3 = HRHR HOURS * (X)+4 = MIMI MINUTES * (X)+5 = SESE SECONDS * (X)+6 = HSHS HUNDREDTHS OF A SECOND * ** SPACE 1 ROM REL SPACE 1 AYEAR EQU 0 YEAR AREA AMON EQU 1 MONTHS AREA ADAY EQU 2 DAYS AREA AHRS EQU 3 HOURS AREA AMIN EQU 4 MINUTES AREA ASEC EQU 5 SECONDS AREA AQSEC EQU 6 QUARTER SECONDS AREA SPACE 1 R:GATD EQU $ SIN 2 PREPARE TO GET RAW TIME/DATE COPY R:TODU,A GET UPPER BITS OF TIME COPY R:TODL,Q  GET LOWER BITS OF TIME COPY Q,Y * * THE FOLLOWING 4 INSTRUCTIONS ARE EQUIVALENT TO THE FOLLOWING: * SHIFT AY,RO,15 * ROTATE Y,LO,1 COPY A,Y ROTATE Y,LO,1 SHIFT A,RO,15 AY=TOP 17 BITS TO DIVIDE DIV QSPH,AY A=REMAINDER TO PUT WITH BOTTOM 15 BITS * Y=TOP BITS(*2) OF QUOTENT * * THE FOLLOWING 3 INSTRUCTIONS ARE EQUIVALENT TO THE FOLLOWING: * SHIFT AQ,RO,1 * SHIFT Q,LO,1 SHIFT A,RO,1 BUT BOTTOM BIT IN OV ROTATE Q,LO,16 DIV QSPH,AQ A=QUARTER SECONDS WITHIN LAST HOUR *  Q=BOTTOM 15 BITS OF TOTAL QUOTENT SHIFT Q,LO,1 PUSH BITS TO TOP SHIFT Y,RO,1 SET TOP OF QUOTENT, PROPOGATE LSB TO OV ROTATE Q,LO,16 MERGE WITH OV BIT * YQ=HOURS SINCE MAR 1,1976 COPY Y,AYEAR(X) SAVE UPPER BITS TEMPARARILY COPY Q,AMON(X) SAVE LOWER BITS TEMPORARILY COPY A,Y COPY =0,A DIV QSPM,AY A=QS/SEC, Y=MINUTES COPY A,AQSEC(X) STORE QUATER SECOND < BITS SHIFT A,RO,2 A=SECONDS COPY A,ASEC(X) STORE BINARY SECONDS COPY Y,AMIN(X) STORE BINARY VALUE OF MINUTES COPY AYEAR(X),Y GET PREVIOUS QUATENT COPY AMON(X),Q GET LOWER BITS *  YQ=HOURS SINCE MAR 1, 1976 COPY =0,A DIV HPD,AY DIVIDE UPPER BITS DIV HPD,AQ A=HOURS * YQ=DAYS SINCE MAR 1,1976 COPY A,AHRS(X) STORE BINARY HOURS COPY =0,A COPY =0,A DIV DP4Y,AY DIVIDE UPPER BITS DIV DP4Y,AQ Q=NUMBER OF 4 YEAR PERIODS * A=DAY SINCE LAST 4 YEAR PERIOD SHIFT Q,LO,2 MULTIPLY BY 4, Q WILL HOLD YEAR ADD STRTYR,Q ADD STARTING YEAR BIAS COPY A,Y COPY =0,A DIV DPY,AY  Y=ADDITIONAL YEARS, A=DAY IN YEAR ADD Y,Q UPDATE YEAR CSK Y,=4 SEE IF LEAP YEAR JMP FINDMO JUMP IF NOT FEB 29 NOP COPY Q,AYEAR(X) SET YEAR COPY =2,Q COPY Q,AMON(X)  SET MONTH COPY =29,A COPY A,ADAY(X) SET DAY JMP SETASC DO THE ASCII CONVERSION FINDMO EQU $ COPY =MODATA,Y MOLOOP EQU $ SUB 0(Y),A FIND WHICH MONTH JLT A,GOTMO  JUMP IF FOUND, Y=INDEX IJNE Y,MOLOOP ELSE LOOP JMP $ SHOULD NEVER GET HERE GOTMO EQU $ ADD 0(Y),A A=DAY INDEX SUB =MODATA,Y CSK Y,=10 SEE IF JANUARY OR FEBRUARY JMP ADD3MO JUMP IF NOT NOP SUB =12,Y ELSE COMPENSATE ADD =1,Q  INCREMENT YEAR BY 1 FOR JAN OR FEB ADD3MO EQU $ ADD =3,Y Y=ACTUAL MONTH COPY Y,AMON(X)  STORE BINARY MONTH COPY Q,AYEAR(X) STORE BINARY YEAR ADD =1,A DAYS START AT 1 COPY A,ADAY(X) STORE BINARY DAY SETASC EQU $ COPY =5,Y CONVERT 6 NUMBERS ASCLOP EQU $ COPY 0(X),Q GET THE BINARY VALUE JSK CNBTD2 CONVERT COPY Q,0(X) STORE THE ASCII VALUE  ADD =1,X INCREMENT TO NEXT ADDRESS JNED Y,ASCLOP FOR NEXT ONE COPY 0(X),Y GET QUARTER SECONDS BITS AND =:03,Y USE BOTTOM 2 BITS AS INDEX ADD =QSDATA,Y COPY 0(Y),Q  COPY Q,0(X) STORE ASCII QUARTER SECONDS COPY =0,A SIGNAL NO EXCEPTION RSK  RETURN SPACE 1 LPOOL STRTYR WORD 76 QSPM WORD 4*60 QUARTER SECONDS PER MINUTE QSPH WORD 4*60*60 QUARTER SECONDS PER HOUR MPH WORD 60 MINUTES PER HOUR HPD WORD 24 HOURS PER DAY DP4Y WORD 365+365+365+366 DAYS PER 4 YEARS DPY WORD 365 DAYS PER YEAR * * FOLLOWING TABLE CONTAINS DAYS PER MONTH * MODATA EQU $ WORD 31 MARCH WORD 30 APRIL WORD 31 MAY WORD 30 JUNE WORD 31 JULY WORD 31 AUGUST WORD 30 SEPTEMBER WORD 31 OCTOBER WORD 30 =  NOVEMBER WORD 31 DECEMBER WORD 31 JANUARY WORD 29 FEBRUARY QSDATA EQU $ WORD '00' WORD '25' WORD '50' WORD '75' TITL CNBTD2 - CONVERT BINARY TO ASCII DECIMAL ** SUBROUTINE: CNBTD2 * * CONVERT A BINARY 2 DIGIT NUMBER TO ASCII DECIMAL * * CALLING SEQUENCE: * JSK CNDTB2 * * ENTRY: * Q = BINARY NUMBER TO BE CONVERTED * * EXIT: * Q = ASCII IMAGE OF NUMBER * = -1 IF VALUE WAS NEGATIVE OF >99 * ** SPACE 1 CNBTD2 EQU  $ JLT Q,ILLEG JUMP IF NEGATIVE CSK Q,=99 JMP VALOK JMP ILLEG JUMP IF Q>99 VALOK EQU $ COPY =0,A DIV TEN,AQ Q=TENS, A=UNITS SHIFT Q,LO,8 ADD IMAGE,Q  SET TENS ADD A,Q SET UNITS RSK RETURN SPACE 1 ILLEG EQU $  COPY =-1,Q SIGNAL ERROR RSK RETURN TEN WORD 10 IMAGE WORD '00' SPACE 1  END JLT Q,ILLEG JUMP IF NEGATIVE CSK Q,=99 JMP VALOK JMP ILLEG JUMP IF Q>99 VALOK EQU $ COPY =0,A DIV TEN,AQ Q=TENS, A=UNITS SHIFT Q,LO,8 ADD IMAGE,Q  TITL RTX SINGLE TASK ENVIRONMENT - RTXECB - 93411-1B B3 TITL RM:COM -- RTX COMMON TITL R:ECB1 -- STANDARD ENVIRONMENT FOR SINGLE TASKS NAM R:ECB1 EXTR UAT:S ECB:A R:ECB1,UAT:S END OM790111120000OM790111120000OM790111120000 TITL RTX COMMON - RTXCOMN - 93411-1C B3 TITL R:LOW -- DUMMY MODULE TO LABEL LOW END OF RTX * NAM R:LOW R:LOW EQU $ END TITL RM:COM -- RTX COMMON S4141* 93414-1* TITL RM:BPG -- BASE PAGE CONSTANTS AND POINTERS NAM RTX: NAM R:FATL NAM R:FAT1 NAM R:CNSM,R:PFLG,R:PFK,R:SREG,R:SNSW,R:CDRG NAM R:CNTK NAM R:WLKS NAM R:BTC1,R:MPM1,R:MPM2 EXTR R:TKAC EXTR R:WLAC EXTR R:TICI EXTR R:STRT EXTR R:UITH,R:CNTH,R:USTH,R:AETH EXTR R:KSTK,R:LSTK EXTR R:CNSL,R:IDOR,R:PWRF,R:PWRU EXTR R:UMTH EXTR R:SETH SEXT DEBUG4 TITL TITL SCRATCHPAD DEFINITION ABS R:SCRA CHKBP: R:ECBH CHAN R:ECBL ECB LIST HEAD CHKBP: R:ACT RES 1,0 R:ACT ADDR OF EXECUTING ACTIVITY ACB CHKBP: R:RDY RES 1,0 R:RDY - HEAD OF READY LIST CHKBP: R:INTQ RES 1,0 R:INTQ - HEAD OF INTERRUPT ACB QUEUE CHKBP: R:EMEM RES  1,0 R:EMEM - END OF MEMORY ADDRESS CHKBP: R:FPH RES 1,0 R:FPT - HEAD OF FREEPOOL FREELIST CHKBP: R:FPT RES 1,0 R:FPH - HEAD OF FREEPOOL FREELIST CHKBP: R:NSRT RES 1,0  R:NSRT - R:WAIT LINK TO INSERTION ROUTIN CHKBP: R:SEMX RES 1,0 R:SEMX - RM:SEM TEMP>  CELL CHKBP: R:SEMY RES 1,0 R:SEMY - RM:SEM TEMP CELL CHKBP: R:SVA RES 1,0  R:SVA - RM:XPT TEMP CELL CHKBP: R:CCBH RES 1,0 CCB LIST HEAD FOR TICK CLOCK REQUESTS  CHKBP: R:WCBH RES 1,0 CCB LIST HEAD FOR WALL CLOCK REQUESTS CHKBP: R:INVL RES 1,0  CURRENT TIC CLOCK INTERVAL CHKBP: R:CLKS WORD R:TKAC TICK CLOCK WAIT SEMAPHORE. ACTIVITY WAITING. CHKBP: R:NUIN RES 1,0 TIC CLOCK TEMP CELL CHKBP: R:TODU RES 2,0 TIME OF DAY TITL TITL R:SAVE -- SAVE CONTEXT, GET ON SYSTEM STACK * ENTRY IS BY: * JST R:SAVE * FOR NONE INTERRUPT CAUSED CONTEXT SAVE * DOES NOT SET EOB INHIBIT STATUS * ABS R:SAVE CHKBP: R:SAVE RES 1,0 R:SAVE - ENTRY POINT PUSH XA:V PUSH CONTEXT ON CURRENT STACK AND TURN ON SIN 6 INHIBIT INTERRUPTS COPY R:SAVE,Y SET UP EXIT JMP SAVE2 GET ON SYSTEM STACK * * ENTER HERE FOR INTERRUPT CAUSED CONTEXT SAVE. * SUPPRESSES EOB INTERRUPTS BY SETTING STATUS BIT 12 * * ENTRY IS BY: * JST R:SA12 * EXITS WITH: * A = ADDRESS OF CONTEXT * * CHKBP: R:SA12 RES 1,0 R:SA12 - ENTRY POINT PUSH XA:V PUSH CONTEXT ON CURRENT STACK AND TURN ON SIN 7 INHIBIT INTERRUPTS TEMPORARILY. COPY R:SA12,Y SAVE ADDRESS OF CALL. SBIT 12,S STOP EOB INTERRUPTS. SAVE1 EQU $ UIS SEND NEW INTERRUPT STATUS TO CONTROLLERS. SAVE2 EQU $ COPY =R:LSTK,A GET LIMIT OF SYSTEM STACK. CSN A,L IS CURRENT STACK THE SYSTEM STACK? JMP ONSTK IF ALREADY ON SYSTEM STACK TITL COPY A,L NO, LOAD NEW STACK LIMIT. COPY =R:KSTK,A USE SYSTEM STACK FOR PROCESSING INTERRUPT EXCH K,A SAVE OLD STACK POINTER FOR CURRENT ACB.  COPY R:ACT,X LOAD CURRENT ACB ADDRESS COPY A,AC:K(X) STORE CURRENT STACK POINTER JMP 0(Y) CONTINUE PROCESSING THE INTERRUPT. ONSTK EQU $ COPY K,A GET THE CONTEXT ADDRESS JMP 0(Y) CONTINUE PROCESSING TITL R:STKX -- STACK EXCEPTION PROCESSING R:STKX ENT COPY A,R:SVA SAVE A  COPY =R:LSTK,A IS THIS THE SYSTEM STACK? CSN A,L JMP REAL IF SYSTEM STACK FATAL ERROR  COPY R:STKX,A GET RETURN ADDRESS CSK A,=SETA:+3 WAS EXCEPTION CAUSED BY INTERRUPT? JMP PHONY  YES, IGNORE EXCEPTION JMP PHONY YES, IGNORE EXCEPTION CSK A,=R:SAVE NO, IS IT DURING CONTEXT SAVE?  JMP REAL NO, MUST BE REAL. JMP MAYBE MIGHT BE, TEST OTHER LIMIT PHONY EQU $ IFT R:CHEK  COPY R:ACT,A SAVE ADDRESS OF ACB CAUSING PHONY COPY A,R:SEI STACK EXCEPTION ENDC COPY R:SVA,A PHONY EXCEPTION, RESTORE A JMP *R:STKX RESUME EXECUTION MAYBE CSK A,=R:SA12+2 TEST OTHER LIMIT OF CONTEXT SAVE. JMP PHONY THIS IS NOT ONE TO WORRY ABOUT NOP WORRY, IT'S REAL. REAL ?  JMP R:SETH PROCESS REAL STACK EXCEPTION. LPOOL TITL TITL RTX VARIABLES ALLOCATED HERE * CONSOLE INTERRUPT TIMER SEMAPHORE R:CNTK RES 1,0 CONSOLE INTERUPT TIMER SEMAPHORE WORD SD:CHK DUMMY CHECKWORD * R:CNSM RES 1,0 CONSOLE INTERUPT SEMAPHORE WORD SD:CHK DUMMY CHECKWORD * R:WLKS WORD R:WLAC  WALL CLOCK WAIT SEMAPHORE. ACTIVITY WAITIN WORD SD:CHK CHECK WORD * R:PFLG RES 1,0 POWER FAIL FLAG R:PFK RES 1,0 POWER FAIL SYSTEM STACK K R:SREG RES 1,0 STATUS REGISTER AT P/F R:SNSW RES 1,0 SENSE SWITCH P/F STATE R:CDRG RES 1,0 P/F CONSOLE WORD REGISTER CONTENTS R:BTC1 RES 1,0 RM:BTC TEMP CELL R:MPM1 RES 1,0  RM:MPM TEMP CELL R:MPM2 RES 1,0 RM:MPM TEMP CELL R:SEI RES 1,0 STACK EXCEPTION INDICATOR TITL RTX4 SYSTEM INTERRUPT LOCATIONS IFT PUPA:-3<$ NOTE A,'RTX BASE PAGE IS TOO FULL' ENDC * * START OR RESTART RTX * ABS PUPA:-3 WORD DEBUG4 R:FATL JMP *$-1 IF DEBUG IS LOADED GO TO IT R:FAT1 HLT IF NO DEBUG4,HALT RTX: EQU $ * * POWER UP ABS PUPA: COPY =XA:V,A INITIALIZE STATUS COPY A,S  JMP *$+1 WORD R:STRT * * UNIMPLEMENTED INSTRUCTION TRAP * ABS UITA: RES 2,0 HOLD SPACE FOR P AND INSTRUCTION JSK *$+1 WORD R:UITH * * UNINSTALLED MEMORY TRAP * ABS UMTA: RES 2,0 JSK *$+1 WORD R:UMTH * * POWER-FAIL TRAP * ABS PFTA: RES 2,0 JMP *$+1 WORD R:PWRF TO POWER FAIL SHUTDOWN ROUTINE * ** EFFECTIVE ADDRESS CALCULATION * ABS EACA: RES 1,0 * * REALTIME CLOCK * ABS RTCNC: RES 1,0 JSK *$+1 WORD R:TICI * * CONSOLE INTERRUPT * ABS CONIA: JSK *$+1 WORD R:CNSL TO CONSOLE INTERRUPT HANDLER * * CHARACTER/NUMERIC EXCEPTION TRAP * ABS CNTA: RES 2,0 JSK *$+1 WORD R:CNTH * * STACK EXCEPTION TRAP * ABS SETA: RES 2,0 JST R:STKX TO STACK EXCEPTION HANDLER * * USER TRAP * ABS USTA: RES 2,0 JSK *$+1 WORD R:USTH * * SYSTEM TRAP -- STRAP -- * ABS SYTA: RES 2,0 JSK *$+1 WORD R:IDOR TO THE DOOR * * ARITHMETIC EXCEPTION TRAP * ABS AETA: RES 2,0 JSK *$+1 WORD R:AETH END RTX: ABS CNTA: RES 2,0 JSK *$+1 WORD R:CNTH * * STACK EXCEPTION TRAP * ABS SETA: RES 2,0 JST R:STKX TO STACK EXCEPTION HANDLER * * USER TRAP * ABS USTA: RES 2,0 JSK *$+1 WORD R:USTH * * SYSTEM TRAP -- STRAP  TITL RAM INITIALIZATION MODULE (93708-1K-C2) TITL --- MUST BE LOCATED AT THE BUBBLE-UP LOCATION IN ROM SPACE 2 NAM ROMINIT * EXTR ROMTOP,R:HIGH * ROM REL * ROMINIT EQU $ ENTRY SIN 14 HERE IS THE REAL (ROM) ENTRY POINT WD:80 COPY =:40,A WD:81 COPY A,S SET UP FOR INITIALIZATION COPY WD:80,A COPY A,:80 COPY WD:81,A  COPY A,:81 COPY WD:82,A COPY A,:82 COPY =ENTRY,A COPY A,:83 FORCE A RESTART TO STA@ RT AT "ENTRY" COPY WD:8A,A COPY A,:8A FORCE A POWER FAIL TO SIMPLY HALT COPY WD:7E,A COPY A,:7E INTERCEPT RTX FAILURE WITH A HALT. * COPY =ROMTOP,X COPY =R:HIGH,Y SUB =:20,Y  ADD Y,X LOOP CSK Y,=:84-:20 ARE WE IN THE CRITICAL REGION? SIN 7 YES, THEN HOLD OFF POWER FAIL TIL END NOP COPY 0(X),A COPY A,:20(Y) SUB =1,X JNED Y,LOOP WD:82 JMP *$+1 RAM INITIALIZED, START UP RTX! WORD :80 * WD:7E EQU $ WD:8A HLT * LPOOL END COPY A,:7E INTERCEPT RTX FAILURE WITH A HALT. * COPY =ROMTOP,X COPY =R:HIGH,Y SUB =:20,Y  ADD Y,X LOOP CSK Y,=:84-:20 ARE WE IN THE CRITICAL REGION? SIN 7 YES, THEN HOLD OFF POWER FAIL TIL END NOP COPY 0(X),A COPY A,:20(Y) SUB =1,X JNED Y,LOOP WD:82 JMP *$JR:LOW O0SEGMENTBLANK oig’’JR:MPM2 R:MPM1 R:BTC1 JR:WLKS R:CNTK R:CDRG JR:SNSW R:SREG R:PFK  JR:PFLG R:CNSM R:FAT1 JR:FATL RTX: O0SEGMENTBLANK oKR:SETH R:UMTH R:PWRF KR:IDOR R:CNSL R:LSTK KR:KSTK R:AETH R:USTH KR:CNTH R:UITH R:STRT KR:TICI R:WLAC R:TKAC MDEBUG4 NR:ECBL ii kt9C @_ą9ž‡ C @oą?Å ‚œP ž†P‚™x  !„ƒœ@pœ@ „*‚P žŒ‚z Ÿ ž„žƒ 9ž†ž‚€*Ÿr Až|Ÿ‚tttgš>g š>gt š>g ggggggg}ug Ÿ~g  g € @0Ÿ€t „’€t ˆ’€tŒŸ€t‘’€t ”’€t˜’€t œ¾2 ’€t¤’€tØ’€t€JMDBUG4 O0SEGMENTBLANK oFKG:Z G:Y G:X  KG:W G:V G:U KG:T G:S G:R KG:Q G:P G:O KG:N G:M G:L KG:K G:J G:I  KG:H G:G G:F KG:E G:D G:C KG:B G:A G:9 KG:8 G:7 G:6 KG:5 G:4 G:3 KG:2 G:1 G:0 ig ¾¾Ż Ž~¾Āž¦’\ć¾ń EūI€œęnŸYd ¬ &‡ T_w“>Ø© Ŗ]?½ž@¾Ź (½Ó : ½Ó‚PŠ’½Ō -½Ó :½Ó‚" ’Š‰ ½Ō )½Ó ½Ó Š‚…ēĘ’žF  æ†ČĘȦČęČp†ĒP†Ę0†Å @ 0†ĀB ž †¾¢%` Ÿh  †!‚}’¾cÅčžF Ā«¢«ā«‚® ‚­‚§p‚¦P‚„0/‚œŸo  ½Ń M½Ó D½Ó B½Ó U½Ó G½Ó 4 ½Ó ½Ó C½Ó 0½Ó ½ÓŸi ¾7 Ÿ}t#t"t!t ttttttttttttttttttt t t t t ttttttttt  ½Ń ½Ó‚z½Ó¾¶¾µ P¾«ē ½Ś A¾§‚C½Ū Q¾£‚@½Ū X¾Ÿ‚= ½Ū Y¾›‚:½Ō½Ń¾Ÿ¾ž¾ K¾“‚3 ½Ū L¾‚0½Ū S¾‹‚-½Ū D¾‡‚* ½Ū C¾ƒ‚'½ŌŸK ½Ó =½ÓŸ{  ¾Ÿ} ½ÓŸ|‚Į"„ †¼½Ń *½Ł½Ņ†· NžÕ žø Gžž‹½Ņ½Ų†¬žBA& Ržž†½Ņ ž™½×ʜ ž€½ÖʘĀ™LBž·LCŠLFĪLLĶ LSĻLJž–LIŹLGÉLRČÅ  …ę½ĒžA« ¾4Ÿ}½Ņ  Äž|ĮŽQE‚r…ēā ,žā ,ž‰ ½Ń `ē†‚½ÕŸ€ _½ŁŸ€å Ŗ“¦“ `é Jž‰ BžƒĮēKžˆ‚§ eĮߞ½Ö‚£ žiŽ  @‚±€Žž ‡Žœ§› `ā@E ;žž…½ÖRA@E N@AŽĒŽ QĮŽŠ‡‰ā ,ž_ž?ž(Å– ½ o¾‚| ’…ē†x‚a Ę D `…ęž¢†mē¢X*ü ø‚ž€ƒS€„†b Ą ‚Š€Ŗ] Š€ ā„‚ĀX@AĄ܃Ÿ€V B `…ę½Ēę DŻēž„*üŽHž] žQ‚0Ā `Ä¢.*ü¦,€ ‚„€‚& ’†$žr½Ė Įå"B†œA ŽĘ½Ń ƒ˜½Ū½Ö½ĖŽCą‡‘Äį Ä /ž† XžÅƒ‡ž‚ƒ„ ½Ń½Ū ži ™ž]½Ńß†«@½ŚƒØ½Ū½Ö ŽB…äĒ¢ā ,žœĀžį[ +ž‰ -žˆ *žŠ Xž‹ /žŒÅKJ’ʎ Åߞ^ƒ‹…ßž[ƒˆž{ƒ… žxŽ‚ žZÄ ,ÅŸ|¾•½Ė½Ńß†± ½Śų†ƒ­½Ū½ŻŽ‰ž{‚Ø½Ńžu  ,žÅ½Ö†x@ ĮßFž…C ’pŸqĮéLLžÅ ¾ (žwž{žu ĀdŽ…J’QBĘ`Ÿy Ä¾‰…äß¾Ė†z‚”‡x¾oŠ’ž|  Iʎ¾Q ,žÅ½Öʇ ,žžƒ †·½ÖʂŸpIĘ°¾k ,ž“  ’« ,žƒH’Ętž’‚r žŽH’Ęm į -žÅ†›ž†½Öį -žÅ†” ß†CƒBš\–\ƂFžƒ‚Š -ž‚ ¾0žt½Ń‚5½Śƒ3½Ōžx Ā’@" Fž‚Ÿzž‡@ ĪŒ‰ć ’Fž„  …äÅć ŸlC¾#…äß†  † ‚.¾b†žĮćʝƒ™‡šŽ™Ž–J’Qŗ ‚”†’‚!†’Ā’ƒŽ»ž…ŽŠŽ‹J’ QøÄ½Ń %½Ó‚‚½Ōžu  †U ½Ó ½Ó ’‰B *ž  ½Ó ½Ó‚GŸo †h½Ō †f’ †e ™"†cIƒaM K ’¢Y& žž†¢V&žƒ†RĘR `ŽQKL$ žžk‚K N =½Ó‚DŽD½Ō G½Ó ‚A öĮ  :½Óž€ ½ÓŸL ¾ƒ ¾ĒŸ{ †’¹¾‡y¾…9¾ƒ¾‚ Ÿu  öĮ  :¾“‚Ÿw  Ā® 0¦”‡¢‚C C 9 6¼C C "¢…0 `Ÿj†  Ā•…ą¢’C "C ¢tC  I6BĒ EĀ‚ŒæŒŻBŸ4/”B€€…BŸ†tttt t^g @’6ÄNN ’…@ SA‚‚# t żś’’JR:SWAI R:IWAI R:WAIT JR:SSIG R:ISIG R:SIG O0SEGMENTBLANK ROM o OKR:DA R:IACB R:SACT iigg’…#  „ž„Ÿttg oĄ€SÅJRCQM܀ž‰ €Ą€  Ā Ą#Ā°# # ‚# ż’gg’e##  „‚Ø„'žŸ_g ä)iHOš€rÅ@bRCj’š€ž—¤(  "Ą€Ä"@`ż'`@ (š€qMš€qK  `ą€Ą#Ā°# š€j’žrą) # t’’JR:TICP R:TICI R:TKAC JR:ITIC R:KTIC R:LTIC O0SEGMENTBLANK ROM o #KR:RTXEX R:DCHK R:GTS KR:GVSH R:RE12 R:SSIG KR:IWAI R:ISIG R:GPR KR:SPRI iig ž€/p(ä€p(` ’ŽžB €/ph„@ph¢‰ ‚’„’‡G`ž°t Ctd’’t €@„‰€A„Š€B„„€C„‚`  +1N)+ ’ŠŚž€oƅČBSŹČ-ÄBžŒ‘t o¤-§zĄBČ-Ä-ĄB@AĒt@`Š+ Ä@Uižƒ `ā’?ph @kph’J`?p(ą€+p(# tżłg¼?).’Ÿttg )+‚„/`  €1T€‚Œ-Ē„‚Ą/F žužužt’ „’’A摠@Ą€Ä@’` `ži€//„-‹7‡6).’ƒž\tttigg@dX’’gpš.’’JR:MTIC R:CTIC O0SEGMENTBLANK ROM o JKR:TKAC R:GPR R:SPRI KR:DCHK R:GVST R:XPTE KR:ITIC iig ž„ p„ƒ # ž€/p(ä€p(` ’· ž€/ph„@ph¢² ‚’±j÷)+’ÆĮ ž‡` ą@@hÄ@’©iž‚h’ž€?ph  @kph’`?p(ą€+p(# g ž€/ph¤@phžP?ph @kphÄ’ŒAæ‹ p„ƒ # ttttttt’’JNOWAL: O0SEGMENTBLANK ROM o LR:RWAL R:WLAC KSTTLF: R:WLKS iighh ‡# t’’JR:RWAL TTLF4: R:WLAC O0SEGMENTBLANK ROM o '\KSTTLF: R:RTXEX R:GVST KR:IWAI R:ISIG R:ITIC KR:WLKS iig ā“‚“„@ @„A „B„C„D„E‚‹„F¢Š „€„äƒ§# td’’d’’d’’i@d’’gkš.i „0„1¢ŗ’ŗAž¶¢s’·?Ü1ž Ü0ą,qgI,€B 0&ž†ž™€C 1& žž” D’„ą `ą@ž€/phÄ@ph ’?phĄ@kphr%`HÄ@žˆ@hÄ@ `@ą@r`HÄ@ž€¢‡’‡Ažƒ¢@’„ æ…d#’’ttttti#$tg’’JR:IWAL R:AWAL R:GTOD JR:STOD O0SEGMENTBLANK ROM o yKR:DCHK R:WLAC R:GPR KR:GVSH R:SPRI R:GTS iig pO€„„1€ƒ„0 # g p?€1„„€0„ƒ # g ž€/p(ä€p(` ’”Fž€/ph„@ phžČ‚Ž„‹€@„‰€A„Š€B„„€D„ƒ€C„‚ž¤tfšNg ž€/p(ä€p(` ’uFž€/ph„@ phž©‚o„‹€@„‰€A„Š€B„„€0 Ą1Gă„‚` ’¢ž€/ ph„@ph¢ ‚’œ),’›ʞ€€,„@ ä,iž„ `ā“’“ž€?ph @kph’‰`?p(ą€+p(# ttttżõt’’JR:CWAL O0SEGMENTBLANK ROM o 4KR:WLAC R:GPR R:SPRI KR:DCHK R:GVST iig ž„ p„ƒ # ž€/p(ä€p(` ’£ ž€/ph„@ph¢ž ‚’j÷),’›Į ž‡` ą@@hÄ@’•iž‚h’ž€?ph  @kph’‰`?p(ą€+p(# ttttt’’JCLK50: O0SEGMENTBLANK ROM o LSTTLF: KTTLF4: iigh ‡# t’’JSTTLF: O0SEGMENTBLANK ROM o iig# ’’JR:SPRI R:GPR R:GPRI O0SEGMENTBLANK ROM o KR:DISP R:SACT R:PRID iigžƒ p„ƒ# g !€‚# g@ ’A# ’ # Ąƒ !€€„"Ă€#„€¤#Ÿ‚ttt’’JR:CNSL R:CINT O0SEGMENTBLANK ROM o 'KR:CNSM R:CNTK R:RE12 KR:RTXEX R:SSIG R:IWAI KR:ITIC iig ¢–’–A# ¢”’”A# Ā‘?“Š Fž‚‡†E¢ƒ’† # td’’tttitigG¼?¢v’ƒĮŸ‚æ‚ttt’’JR:IRCV R:RECV R:ISND JR:SEND O0SEGMENTBLANK ROM o ~KR:IWAI R:ISIG iig `  €1Įžö¤@ `žä A# `p€CĄDž# g ž€ž€ž€Op(䂄Ä€p(` +’™ E/p pž‹Oph€AĄ@kph „DÄE `+’‰?p(ą€+p(# zkttg `  €1Įžæ¤@ `ž­ A# ž‡Ä`p¤CÄD # g ž€/p(ä€p(` +’cÓ DĄEž€ ž€?ph¤AÄ@ph `+’WOph A Ą@kph ?p(ą€+p(# @``   @ Ø1G€ŠøAž‚žžƒ €žx¢…`@#  ! ‰# żō’’JR:GIVM R:GETM O0SEGMENTBLANK ROM o ]KR:MPM2 R:MPM1 R:RTXEX iig Ā)žē”  ¢`  1ZĄ€@žz žžJž@žŒKē’` `@Ä@ ĄÄA䁄€ć‰ĄÄA+ ćƒ# ‚ƒž|ttżüg ē| ž ¢Ą€@"F&žˆžˆ@#SÄ @ Ȁ@RB‚n梧k`  1E ž{ ž‚‚eæ™(„¤AHž£^ jž† A1M `ˆ@ žƒ` TGžw€„A€€ˆ@„@žxćK # t’’JR:RBUF R:ABUF O0SEGMENTBLANK ROM o KR:DISP R:GETM R:GIVM KR:SACT iC ig’’ # €„ą! I’ą!ąC¤LŸŠg’‡# €„ą! I’„Ÿ‚tttt’’JR:SACT R:RE12 R:DAQX JR:DA R:IACB R:DISP JG:Z O0SEGMENTBLANK ROM o yKR:KSTK iiggĒ žˆgą!ąC¤DÄCgą!ąC„Bž€g …‚ŗp ž‚c # /ą#qP @¤#I"  "€B1Fø‚žžƒ@  €žy@(ä€Ä@ žmą"qIä!ž C?Ą#Q¤p c  # /P P„!Už€¾ƒ¾ ž{ '¾ƒ%¾Ÿz ææŸ|# tg ¼9 ą†Ü†@g ž€ž€?p(äÄ€p(`@qE€‚øBžŒ žžŠ`„€@ Op(ą€€+p(ž @`ą@qDøBž{žžy`H¤@ĀOp(ąĄ€+p( # ’’JR:KSTK R:LSTK O0SEGMENTBLANK o@ig@’’g’’JR:INI1 R:PWRF R:STRT O0SEGMENTBLANK ROM o NKR:RTXEX I:INIT R:SREG KR:SNSW R:CDRG R:PFK KR:PFLG R:DISP R:NOPF KR:UINI R:LSTK R:KSTK iig ‚ P‚¤ĆžQA@pƒ›ĮŸžƒ™ƒ˜g ƒ”’™A昃’—Aæ” o‡‰“‰ĮŸų—ˆ0_Ÿ‹t tttttt tttt tg “uAžœ “qphjł„BÄC¤Dp„E ƒ“„Fļ0„A‡g‡c‡bP„@ Ā[@ žƒ !䃞ēV Œ’’JR:GVST R:GVSH R:GTS O0SEGMENTBLANK ROM o iig O %1Ā‚™# Ą€Ä%QĮÄ& # g „€/°&Ą&1ĀÄ%žÄ€# g ?Ą%Ā¤%QĮ¤& # żū’’JR:PAUS O0SEGMENTBLANK ROM o KR:DISP R:SACT R:PRID iig@ ’”A# ’’ # Ąƒ)"`  €1Ių‚ž{ž†Ą€Ä@Ą#Ā¤#Ÿ‚ttt’’JR:USTREXR:SETH R:TRAPX JR:UITH R:UMTH R:USTH JR:CNTH R:AETH O0SEGMENTBLANK ROM o XKR:FATL R:EMUL iigC @£šƒšIž¤gC @£•ƒ•IžgC @£ƒIž–gC @£‹ƒ‹Ižg ŸˆØ©˜™ ”ˆ‰tgIžƒ`p¤Fg  ! ‰`@ąŠqC p †œ@ ‰1ø‚ƒ p †Ÿtg ß  ! ‰ –1E„‚ā䃀*„€ !  ‰oą•qC£ˆƒˆœ@ ‰1ø£ƒ‚gIŸfœ’’JR:SYSX R:TABL R:XPTE JR:RTXEX R:DOOREXR:STR0EXO0SEGMENTBLANK ROM o  KR:FATL iigI žƒg I ž ! ‰`@ąŠqAœ@ ‰1ŗŸ€tigg /¢}ŸŠg ?‚ˆ¢|Ÿ…g ?‚„¢|Ÿ€d’’ż÷żöi ?§ ! ‰ą›qB£‡œ@ ‰1¹£‚I Ÿpd’’i’’JR:SATD O0SEGMENTBLANK ROM o xiig iĄ€žāSC*ū bž‡Ä€+u·*śĄ€ M]ž„ „€„# ĪĄSŗąm žžv jżsCk J’S±ź²€@ą‚mžžkb ’`@nbG€*`@ G€*g€' ä€Ä€… <žžXĄ„M<žžSG€ @ĄƒMžžLG€G""„€Ä„0Ä1 # Y Lmš8@F=\ z™øÖõ2Q֑Ī@’ Ny žž†M žžƒG€# H’#  00’’JR:GATD O0SEGMENTBLANK ROM o ‚iig €0Ą1`@n`négTN  NóGONn Nóä€Ä` gE „†„…ä„ą€Ą g?G=„ƒ g9G7NŹ°` g2 @bmž‡Ä€Iā „‚ž‘āŒ@ Āt½žˆ@ī—m žƒjōKkä Ā „‚iĄ€ž„Ā+u»ą€xź…Ą@Ā # co Lš8@<µm 002550 75SŹMcžž‡ GNqŹ…@# H’# 00’’JR:ECB1 O0SEGMENTBLANK o1KUAT:S NR:MBXL R:SL R:TDBL NR:ECBL igkšn0t’kkk’’JREINI: O0SEGMENTBLANK ROM o OLR:RINT KR:CNTK R:DECB R:NECB KR:SECB R:CNSM R:TICP KR:KTIC R:LTIC R:TKAC iigh „"„!„+„,‡¢‡¢„-‡”„#ā ‚  „@ @„A „B„C„D„E‚˜„F¢—  „€„äƒ¤.’’ž•Č’ĘqEĄA@Ļ6ø’‹žy# tt‘ttttttt „F f1G€ƒ@  ‚„€ @ €žx  g1E€’„‚ €žz I h1D„‚㠀ž{ # ’’JR:DECB R:NECB R:SECB O0SEGMENTBLANK ROM o  iigą ’qA # g i# g# ’’JR:DCHK O0SEGMENTBLANK ROM o iig €JO@  €1L€JøŠž†ž…€Iø‰ž‚žžžq’# # ’’JD R:HIGH R:NOPF O0SEGMENTBLANK ROM o jKR:HIGHERSTTLF: R:INI1 KR:XPTE R:GTS R:BEGI KR:RINT R:INIT R:RWAL KR:SSIG R:WLKS i Ÿ„æ€d ’’ig ’ÖƒÖ‡ÖƒÖ‡ÖƒÖ‡ŃƒÕ‡Ń¢Ō Š* ’€€»€€ø+’¤$ƒĆ‡ĮƒĆ ‡ĮāÄąD°b‚Ā  °bąb c¤@ `+¤A @*ž¤Bā³ĄHąI‚²fžƒ ‚ÆæÆ)% JōSÄä€ `k žz„€ ¤&’„Aæ¢ā€@„€A„‚€B„ƒ€C „„€D„…€E„†€F„‡’”A搒’’’¢’’’Ÿ’tŠd’’‹d’’d’’d’’ttżūtttttt t tig’’JR:HIGHERO0SEGMENTBLANK R:HIGHERo iig’’JDEBUG4 O0SEGMENTBLANK ROM o KR:FAT1 iigŸ€t’’JI:INIT O0SEGMENTBLANK  ROM o iig # ’’JR:UINI O0SEGMENTBLANK ROM o iig # ’’JR:RINT O0SEGMENTBLANK ROM o iig # ’’JR:EMUL O0SEGMENTBLANK ROM o  KR:TRAPX iig C @£…ƒ…I`p¤FŸ‚„…t’’’’ttżūtttttt t tig’’JR:HIGHERO0SEGMENTBLANK R:HIGHERo i******************************************************************** * * I : W A I T * WAITS FOR COMPLETION OF THE OPERATION * * THE CALL: * Y= TIB ADDRESS * * RETURNS WITH: * A= 0 NO END OF BLOCK *  A= 1 END OF BLOCK * * I:WAIT EQU $ COPY TI:CIB(Y),X COPY CIB ADDRESS TO X ADD =CI:CSM,X COMPLETION SEMAPHORE TO X JSK R:IWAI WAIT ON COMPLETION SEMAPHORE COPY TI:CIB(Y),X COPY:M =0,A,CI:TIM(X) CANCEL WATCHDOG TIMER COPY CI:CFL(X),A COMPLETION FLAG TO A REGISTER RSK RETURN  SPACE 60 GO TO NEW PAGE ************************************************************************ * * I : F I N I * RELEASES CONTROL OF THE CIB * SETS TI:SOF WITH ERROR CODE FROM HANDLER * THE CALL: *  Y= TIB ADDRESS * A= ERROR CODE * * RETURNS WITH: * A= 0 CONTROLLER RELEASED * I:FINI EQU $  JSK I:ECTT ERROR CODE TO TIB PUSH: A ERROR CODE COPY TI:CIB(Y),X CIB ADDRESS TO X ADD =CI:USM,X CONTROLLER USAGE SEMAPHORE ADDR. TO X JSK R:ISIG SIGNAL CONTROLLER USAGE SEMAPHORE COPY TI:CIB(Y),X COPY CI:APR(X),X JSK R:SPRI RESTORE ACTIVITIES PRIORITY TO ORIGINAL  POP: A RETURN ERROR CODE RSK * * LPOOL SPACE 60 GO TO NEW PAGE ************************************************************************ * * I : N E O B * DETERMINES THE REASON FOR ABNORMAL COMPLETION OF * AN I/O OPERATION * THE CALL: * Y= TIB ADDRESS * * RETURNS WITH: *  A= -HALTD: I/O HALTED * A= -CIF:PU POWER FAILER * A= -CIF:TO DEVICE TIMED OUT * A= 0  DON'T KNOW WHAT HAPPEN * I:NEOB EQU $ COPY TI:CIB(Y),X COPY CIB ADDRESS TO X COPY CI:FLG(X),A CIB FLAGWORD TO A REG. TBIT CIF:PU,A IS POWER UP FLAG SET IN CIB JF OV,INE1 RET: -PWRFL: YES,POWER FAILED CODE IN A INE1 EQU $ TBIT CIF:TO,A DID THE DEVICE TIME OUT? JT OV,INE2 COPY =0,AE  DON'T KNOW WHAT THE HELL HAPPEN! RSK INE2 EQU $ RET: -TIMOT: DEVICE TIMED OUT SPACE 60 GO TO NEW PAGE ************************************************************************ * * I : P O W R *  PURPOSE TO INFORM ALL HANDLERS THAT A POWER FAILURE * AND RECOVERY HAS JUST OCCURRED, ALLOWING HANDLERS *  TO TAKE APPROPRIATE ACTION. * SIGNAL'S ALL COMPLETION SEMAPHORES AND SETS POWER UP * FLAG (CIF:PU). * THE CALL : * C:HEAD MUST CONTAIN CIB LIST HEAD ADDRESS * I:POWR EQU $ COPY C:HEAD,X  CIB LIST HEAD TO X JMP IPOW2 CHECK CIB LIST HEAD =0 ? IPOW1 COPY CI:FLG(X),A SBIT CIF:PU,A  SET POWER UP FLAG COPY A,CI:FLG(X) COPY X,Q SAVE CIB ADDRESS ADD =CI:CSM,X SIGNAL COMPLETION SEMAPHORE JSK R:ISIG COPY Q,X CIB ADDRESS TO X COPY CI:PER(X),X PEER POINTER =0? IPOW2 JNE X,IPOW1 GET NEXT CIB RSK RETURN NO MORE CIBS END TITL WATCH DOG TIMER ACTIVITY * THIS ACTIVITY MONITORS THE WATCH DOG TIMERS FOR ALL DEVICES * ALL DEVICES HAVE A TIMER IN THE CIB, FOLLOWED IMMEDIATELY BY A * SEMAPHOR TO BE SIGNALED IF THE TIMER EXPIRES * ALSO EACH DISK DIB HAS A TIMER ASSOCIATED WITH IT * FOR OVERLAPPED SEEKS SPACE 3 NAM I:WDT NAM I:DOGY NAM R:RTCI  NAM I:LWDT,I:KWDT,I:WDAC NAM I:INIT SPACE 3 EXTR I:POWR EXTR C:HEAD EXTR R:IWAI,R:ISIG EXTR R:ITIC SPACE 3 EXTR TTLF4: R:RTCI EQU 120 TICS PER SECOND WDPRI: EQU :1000 PRIORITY SPACE 3 ROM REL SPACE 1 I:WDT EQU $ WDT0 EQU $ COPY =I:DOGY,X WATCH DOG TIMER SEMAPHORE ADDRESS JSK R:IWAI WAIT FOR CLOCK INTERVAL TO EXPIRE COPY =TIME,X ADDR OF CLOCK BLOCK * * SET UP WATCH DOG TIMER INTERVAL * COPY TTLF4:,A GET # OF TICK EQUIVALENT TO 1/4 SEC SHIFT  A,RO,1 DIVIDED BY 2 COPY A,3(X) * JSK R:ITIC DELAY THEN SIGNAL SEMAPHORE COPY C:HEAD,X FIRST CIB SPACE 3 WDT5 COPY X,CIB SAVE COPY CI:TIM(X),A CHECK IF TIMER ACTIVE  JEQ A,WDT15 NOT ACTIVE IMS CI:TIM(X) BUMP TIMER JMP WDT15 NOT EXPIRED  COPY CI:FLG(X),A SET TIMEOUT FLAG SBIT CIF:TO,A COPY A,CI:FLG(X) ADD =CI:TIM+1,X SEMAPHORE TO SIGNAL FOR EXPIRED TIMER JSK R:ISIG COPY CIB,X RESTORE CIB ADDR SPACE 3 WDT15 COPY CI:FLG(X),A CHECK FOR OVCERLAPPED OPERATIONS TBIT CIF:OO,A FOR DIB TIMERS JF OV,WDT35 NO DIB TIMERS COPY CI:DIB(X),X FIRST DIB WDT17 COPY X,DIB SAVE COPY DI:SCS(X),Y SEMAPHORE ADDR SUB =1,Y TIMER ADDR COPY 0(Y),A TIMER JEQ A,WDT25 NOT ACTIVE IMS 0(Y) BUMP TIMER JMP WDT25 NOT EXPIRED COPY Y,X ADD =1,X SEMAPF HORE TO SIGNAL JSK R:ISIG COPY DIB,X WDT25 COPY DI:PER(X),X NEXT DIB JNE X,WDT17 GOT ONE SPACE 3 WDT30 COPY CIB,X WDT35 COPY CI:PER(X),X NEXT CIB JNE X,WDT5 GOT ONE JMP WDT0 WAIT FOR NEXT TIME INTERVAL TO EXPIRE LPOOL SPACE 3 REL SPACE 1 CIB RES 1 SAVE CIB ADDR DIB RES 1 SAVE DIB ADDR TIME WORD 0 ENVIRONMENT ID WORD $ TIMER ID WORD I:DOGY SEMAPHORE ADDR WORD R:RTCI/8 EIGHTH OF A SECOND * I:DOGY WORD 1 SEMAPHORE,INITIAL VALUE= 1 WORD SD:CHK SEMAPHORE CHECKWORD * ** WATCH DOG TIMER CONTEXT CANNED HERE * SYS:A I:WDAC,WDPRI:,I:WDT,I:LWDT,I:KWDT TITL IOS4 INITIALIZATION SPACE 4 * SET UP WATCH DOG TIMER ACTIVITY SPACE 1 ROM REL SPACE 1 I:INIT EQU $ IOS INITIALIZATION JEQ A,INI2 NOT POWER UP JSK I:POWR SET POWER UP FLAGS INI2 EQU $ SPACE 3 COPY:M =1,A,I:DOGY INITIALIZE SEMAPHORE COPY =I:KWDT,Y POINT TO INITAIL CONTEXT COPY:M =I:LWDT,A,LAST:L(Y) L COPY:M =XA:V,A,LAST:S(Y) S COPY:M =I:WDT,A,LAST:P(Y) P COPY =I:WDAC,X ACB ADDR COPY =0,A COPY A,AC:PER(X) PEER POINTER COPY A,AC:FLG(X) FLAGS COPY Y,AC:K(X) K REG COPY R:INTQ,Y PUT ACB IN INTQ COPY X,R:INTQ COPY Y,AC:PER(X) RET: 0 LPOOL END TITL IOS4 ERROR TABLE NAM I:ERTB  NAM I:ERS1,I:ERS2,I:ERS3 SPACE 3 I:ERTB EQU $ ERROR TABLE RES 1,0 IOE:AC - ACB ADDR OF ERROR ACTIVITY RES 1,0 IOE:EC - ERROR CODE RES 1,0 IOE:K - K REGISTER  RES 1,0 IOE:DI - DIB ADDR RES 1,0 IOE:TI - TIB ADDR SPACE 3 * SEMAPHORES I:ERS1 WORD 1 TABLE CONTROL SEMAPHORE I:ERS2 WORD 0 ERROR OCURRED SEMAPHORE I:ERS3 WORD 0  RESPONSE SEMAPHORE END TITL DUMMY ABORT ROUTINE NAM I:ABRT NAM I:DOSV NAM I:DOER SPACE 3 ROM REL SPACE 1 I:DOER EQU $ I:DOSV EQU $ I:ABRT RSK END :K - K REGISTER  RES 1,0 IOE:DI - DIB ADDR RES 1,0 IOE:TI - TIB ADDR SPACE 3 * SEMAPHORES TITL IOSTTY,LP,& PT - TTY,LP,& PT DRIVERS - 93431-12 B3 NAM TY:RD,PR:RD,TY:WRT,LP:WRT,PP:WRT,TY:FUN,LP:FUN,PP:FUN  SPACE 2 EXTR I:STUP,I:DIO,I:WAIT,I:NEOB,I:FINI,I:EMEM,I:RET,I:TRLL EXTR I:TRTB,I:SDIO EXTR I:RST,I:ECTT EXTR I:STAT EXTR FBR:,FBW: EXTR I:SIV EXTR I:VCNT EXTR I:OPCL SPACE 3 ROM REL SPACE 1 READ EQU RE:%4 OP CODE UREAD EQU READ+UF: UNFORMATEED READ PARITY EQU 6  PSEUDO STATUS BIT CRBT EQU 11 CR BIT IN BRANCH MODE WORD CR EQU :D ASCII FOR CARRIGE RETRUN RUBOUT EQU :FF LF EQU :A LINE FEED CRLF EQU :D0A SPACE 3 LP:WRT EQU $ G  LINE PRINTER WRITE ENTRY TY:WRT EQU $ TELETYPE WRITE ENTRY PP:WRT EQU $ PAPER TAPE PUNCH WRITE ENTRY COPY TI:BUF(Y),X CHECK IF BUFFER EXIST& NOT IN RTX COPY TI:BCT(Y),A LENGTH OF BUFFER JSK I:EMEM SEE IF BUFFER ADDR IN NON-EXISTANT MEMORY JLT A,TY150J IN RTX, OR NOT IN MEMORY COPY TI:FC(Y),A CHECK TYPE OF WRITE AND =:F,A ISOLATE MODIFIER SUB =WP:,A WRITE PROMPT? JNE A,TY2 NO COPY TI:DIB(Y),X COPY DI:NAM(X),Q SUB ='TR',Q NULL OP FOR TTY READER JEQ Q,TY150J NULL OPERATION TY2 SUB =FB:-WP:,A FORMATTED BINARY JEQ A,FBWJ  YES SUB =UF:-FB:,A UNFORMATTED? JNE A,TY3 NO SPACE 3 COPY TI:BCT(Y),A TRUNCATE UNFORMATTED BYTE COUNT RBIT 15,A TO 32K JMP TY5 TY150J JMP TY150 FBWJ JMP FBW: LPOOL SPACE 4 TY3 COPY TI:BCT(Y),A JSK I:TRLL TRUNCATE TO LINE LENGTH JSK I:TRTB TRUNCATE TRAILING BLANKS TY5 COPY A,TI:BCT(Y) TRUNCATED COUNT TO TIB COPY A,TI:ACT(Y) BYTES DONE JEQ A,TY150J NOTHING TO DO TY7 COPY TI:DIB(Y),X DIB COPY:M DI:BMO(X),A,TI:BMW(Y) BRANCH MODE WORD TO TIB COPY:M TI:BUF(Y),A,TI:IBF(Y) SET I/O BUFFER TO USER BUFFER SPACE 4 JSK I:STUP  SET UP JLT A,TY150J HALT I/O JGT A,TY140J ERROR AFTER IT GOT CIB COPY TI:CIB(Y),X COPY:M =0,A,CI:T2(X) SAVED ERROR CODE COPY TI:FC(Y),A GET FUNCTION CODE AND =:0F,A MASK OUT EVERYTHING BUT THE FC JEQ A,TY10J IF FC=0, UNFORMATTED - SO GO DO IT SPACE 9 * FORM CONTROL STUFF *  COPY:M TI:BCT(Y),A,TI:T2(Y) SAVE BYTE COUNT COPY TI:FC(Y),Q COPY TI:DIB(Y),X COPY DI:FLG(X),A  TBIT DIF:FC,A CHECK FOR FROM CONTROL JF OV,TY10J NO FORM CONTROL COPY *TI:BUF(Y),A  PAICK UP FORM CONTROL CHAR TBIT SB:,Q JT OV,TY8D ROTATE A,L,8 FC CHAR TO LOWER BYTE TY8D EQU $ AND =:FF,A ISOLATE FC CHAR COPY A,TI:T3(Y) SAVE IT CLSN A,='+' OVERPRINT? JMP TY9B YES OVERPRINT CLSN A,='1' TOP OF FORM? JMP TY9 YES CLSN A,='0'  DOUBLE SPACE? JMP TY8 YES SPACE 3 * ANYTHING ELSE IS SINGLE SPACE TY8A COPY DI:EOL(X),X COPY 1(X),A CHECK FOR AUTO LINE FEED SHIFT A,RO,8 SUB =' ',A IF FIRST CHAR BLANK, THEN AUTO LF JEQ A,TY9B AUTO LF SO NOTHING TO DO SPACE 3 TY8 EQU $ COPY TI:DIB(Y),X  COPY DI:LPP(X),A JEQ A,TY8C NOPAGES IMS DI:LC(X) BUMP LINE COUNTER JMP TY8C NOT END OF PAGE JMP TY9 END OF PAGE, DO TOF TY8C EQU $ COPY DI:EOL(X),X END OF LINE SEQUENCE TY8B EQU $ COPY:M 0(X),Q,TI:BCT(Y) LENGTH OF IT ADD =1,X BUFFER ADDR H  COPY X,TI:IBF(Y) JSK I:SIV SET INTERUPT VECTOR TY9A JSK I:SDIO START I/O JSK I:WAIT WAIT FOR COMPLETE JEQ A,TY200J NOT COMPLETE JSK I:STAT GET STATUS JNE A,TY300J BAD STATUS JSK I:VCNT CHECK INTERUPT VECTOR COUNT JNE A,TY9A NOT ALL DONE SPACE 3 COPY TI:T3(Y),A  SEE IF DOBLE SPACE COPY TI:DIB(Y),X SUB ='0',A COPY A,TI:T3(Y) TO PREVENT LOOPING JEQ A,TY8A GO SPACE SECOND LINE JMP TY9B DONE SPACE 3 TY10J JMP TY10 TY140J JMP TY140 SPACE 3 TY9 EQU $ COPY DI:LPP(X),A AND =:FF,A LINES PER PAGE NEG A,A  COUNTER COPY A,DI:LC(X) RESET TO TOP OF FORM COPY TI:SOF(Y),A OR =TFORM:,A SET TOP OF FORM STAUS COPY A,TI:SOF(Y) COPY DI:TOF(X),X TOP OF FORM SEQUENCE JMP TY8B GO DO IT SPACE 3 TY200J JMP TY200 TY250J JMP TY250 TY300J JMP TY300 LPOOL SPACE 3 TY9B EQU $  COPY TI:T2(Y),A OLD BYTE COUNT SUB =1,A ONE LESS FOR FC JEQ A,TY12 NO MORE LEFT TO DO COPY A,TI:BCT(Y) COPY TI:FC(Y),A CBIT SB:,A EXCH TI:FC(Y),A REVERSE SECOND BYTE FLAG TBIT  SB:,A JF OV,TY9C NOW ON SECOND BYTE IMS TI:BUF(Y) ON START OF NEXT WORD TY9C EQU $  COPY:M TI:BUF(Y),A,TI:IBF(Y) SPACE 9 TY10 EQU $ JSK I:SIV SET INTERUPT VECTOR TY10A EQU  $ JSK I:SDIO START I/O JSK I:WAIT WAIT FOR CONPLETE JEQ A,TY200J NOT COMPLETE SPACE 4 JSK I:STAT GE STATUS JNE A,TY300J BAD STATUS JSK I:VCNT  CHECK INTERUPT VECTOR COUNT JNE A,TY10A NOT ALL BYTES OUTPUT,RETRY SPACE 4 COPY TI:FC(Y),A CHECK IF ALPHA FOR END O OF LINE STUFF COPY A,Q AND =3%4,A OPCODE SUB =FU:%4,A  EOF? JEQ A,TY12 EOF, SO DO EOL AND =:F,Q MODIFIER SUB =FA:,Q ALPHA JNE Q,TY100 NO EOL SPACE 4 TY12 COPY TI:DIB(Y),X COPY DI:FLG(X),A COPY DI:EOL(X),X EOL SEQUENCE ADDR JEQ X,TY100 NO EOL SEQUENCE TBIT DIF:FC,A CHECK FOR FORM CONTROL  JF OV,TY12A NONOE, SO GO DO EOL COPY 1(X),A CHECK FOR AUTO LF SHIFT A,RO,8 SUB  =' ',A IF BLANK THEN AUTO LF JEQ A,TY12A AUTO LF COPY:M =1,A,TI:BCT(Y) LF ALREADY DONE  JMP TY12B SO JUST DO CR SPACE 3 TY12A EQU $ COPY:M 0(X),A,TI:BCT(Y) LENGTH OF IT TY12B EQU  $ ADD =1,X ADDR OF BUFFER COPY X,TI:IBF(Y) I/O BUFFER COPY TI:FC(Y),A AND  =:FF0F,A SET FOR WRITE RBIT SB:,A OR =WR:%4,A COPY A,TI:FC(Y) COPY TI:DIB(Y),X  COPY:M DI:BMO(X),A,TI:BMW(Y) OUTPUT BRANCH MODE WORD COPY DI:LPP(X),A JEQ A,TY20 NO PAGES CI OPY TI:BCT(Y),A CHECK FOR CR ONLY SUB =1,A JEQ A,TY20 ONLY CR, DON'T TOUCH LINE COUNTER  IMS DI:LC(X) BUMP LINE COUNTER JMP TY15 NOT END OF PAGE JMP TY14 GO AROUND INTERMEDIATE JUMPS SPACE 3 TY220J JMP TY220 SPACE 4 TY14 COPY DI:TOF(X),X ADDR OF NEW PAGE SEQUENCE  JEQ X,TY100 NO TOF SEQUENCE COPY:M 0(X),A,TI:BCT(Y) ADD =1,X JUST LIKE EOL COPY X,TI:IBF(Y) I/O BUFFER COPY TI:DIB(Y),X COPY DI:LPP(X),A RESET LINE COUNTER AND =:FF,A LINES PER PAGE NEG A,A SO IMS CAN BE USED COPY A,DI:LC(X) COPY =TFORM:,A  TOP OF FORM CODE JMP TY17 GO DO TOP OF FORM STUFF SPACE 4 TY15 COPY DI:LPP(X),A CHECK FOR BOTTOM OF FORM SHIFT A,RO,8 BOTTOM OF FORM COUNT ADD DI:LC(X),A JNE A,TY20 NOT BOTTOM OF FORM COPY =BFORM:,A BOTTOM OF FORM CODE SPACE 4 TY17 OR TI:SOF(Y),A COPY A,TI:SOF(Y) TFORM OR BFORM TY20 JSK I:DIO START EOL I/O JNE A,TY140 ERROR JSK I:WAIT  WAIT FOR COMPLETE JEQ A,TY220J NOT COMPLETE TY100 COPY TI:CIB(Y),X COPY CI:T2(X),A SAVED CODE TY140 JSK I:FINI CLEAN UP EXIT JMP I:RET RETURN TO DOIO LPOOL SPACE 3 TY150 JSK I:ECTT PUT ERROR CODE IN TIB JMP EXIT SPACE 6 TY200 JSK I:RST I/O NOT COMPLETE, RESET DEVICE JSK I:NEOB FIND TYPE OF ERROR COPY A,Q KEEP CODE IN A ADD =PWRFL:,Q  JNE Q,TY140 NOT POWER FAIL COPY TI:DIB(Y),X COPY DI:FLG(X),Q TBIT DIF:RT,Q RETRY? JF OV,TY140 NO TY204 COPY DI:PU(X),X SET INTERUPT VECTOR FOR POWER UP SEQUENCE JEQ X,TY209 NOTHING TO DO COPY X,Q ADD =1,Q BUFFER ADDR COPY 0(X),A COUNT  COPY TI:CIB(Y),X CAN'T DISTURB TIB VALUES COPY CI:IV(X),X CAUSE IT WILL MESS UP RETRY SHIFT Q,LO,1 BYTE ADDR COPY Q,IV:BUF(X) COPY IV:AIO(X),A SBIT 13,A OUTPUT COPY A,IV:AIO(X) JF OV,TY208 BUFFER < 32K COPY IV:CNT(X),A SBIT 15,A COPY A,IV:CNT(X) TY208 JSK I:SDIO START EOL I/O JNE A,TY140 ERROR JSK I:WAIT JEQ A,TY200 NOT COMPLETE TY209 EQU $ JMP TY10 RETRY SPACE 4 TY220 JSK I:RST EOL NOT COMPLETE  JSK I:NEOB FIND ERROR COPY A,Q LEAVE A INTACT ADD =PWRFL:,Q JNE Q,TY140  NOT POWER FAIL COPY =-HARDW:,A HARDWARE ERROR JMP TY140 BYE BYE JMP TY20  TRY EOL AGAIN SPACE 4 TY250 SBIT 15,A NOT ALL BYTES DONE ADD TI:BCT(Y),A NUMBER OF BYTES ACTUALLY DONE COPY A,TI:ACT(Y) JSK I:STAT GET STATUS SBIT PARITY,Q SET PSEUDO SJ TATUS BIT COPY Q,TI:HWS(Y) FOR PARITY OR WORD OVERUN COPY =-HARDW:,A HARDWARE ERROR JMP TY140 GO FINISH UP SPACE 3 TY300 COPY Q,TI:HWS(Y) HARDWARE STATUS,ERROR BITS IN A ADD TI:ACT(Y),A NUMBER OF BYTES ACTUALLY DONE JSK I:VCNT FIND HOW MANY BYTES WERE DONE BEFORE ERRER JEQ A,TY301 ALL DONE SBIT 15,A COMPLEMENT OF UNDONE BYTES ADD TI:ACT(Y),A BYTES DONE COPY A,TI:ACT(Y) TY301 EQU $ COPY TI:DIB(Y),X COPY DI:NAM(X),Q GET DOWN TO SPECIFIC DEVICE SUB  ='LP',Q JNE Q,TY310 TY302 COPY =-NORDY:,A NOT READY JMP TY140 SPACE 3 TY310 ADD ='LP',Q SHIFT Q,RO,8 ONLY LOOK AT FIRST CHAR SUB ='T',Q IS IT TTY JNE Q,TY320 JMP TY390 HARDWARE ERROR SPACE 3 TY320 SUB ='P'-'T',Q PAPER TAPE JNE Q,TY390 NO  TBIT 2,A ERROR BIT JF OV,TY302 NOT ERROR, SO NOT READY JMP TY390 HARDWARE ERROR SPACE 3 TY390 COPY =-HARDW:,A HARDWARE ERROR TY399 JMP TY140 GO FINISH UP FBRJ JMP FBR: RD150J JMP RD150 RD140K JMP RD140 RD15K JMP RD15 RD200K JMP RD200 RD300K JMP RD300 LPOOL RD16J JMP  RD16 SPACE 60 TY:RD EQU $ TELETYPE READ ENTRY PR:RD EQU $ PAPER TAPE READ ENTRY  COPY:M =0,A,TI:ACT(Y) NO BYTES DONE YET COPY TI:BUF(Y),X CHECK IF BUFFER EXIST& NOT IN RTX COPY TI:BCT(Y),A LENGTH OF BUFFER JEQ A,RD150J NULL INPUT JSK I:EMEM SEE IF MEMORY BUFFER EXISTS  JLT A,RD150J IN RTX, OR NOT IN MEMORY COPY TI:BCT(Y),A TRUNCATE COUNT TO 32K RBIT 15,A  COPY A,TI:BCT(Y) COPY TI:FC(Y),A AND =:F,A ISOLATE MODIFIER CLSN A,=WP: CECK FOR WRITE PROMPT, FOR PR JMP RD150A WRITE PROMPT ON READ ONLY DEVICE SUB =FB:,A JEQ A,FBRJ FORMATTED BINARY SPACE 4 COPY:M TI:BUF(Y),A,TI:IBF(Y) DO I/O TO USER BUFFER COPY TI:DIB(Y),X COPY DI:BMI(X),Q BRANCH MODE WORD COPY TI:FC(Y),A AND =:F,A SUB =UF:,A JEQ  A,RD5 UNFORMATTED SBIT CRBT,Q SET CR RECOGNITION FOR ALPHA RD5 COPY Q,TI:BMW(Y) BRANCH MODE WORD SPACE 4 JSK I:STUP SETUP JLT A,RD150J HALT I/O JGT A,RD140K GOT CIB BUT ERROR SPACE 4 COPY TI:FC(Y),A AND =:F,A SUB =FA:,A JNE A,RD15K NOT FORMATTED ASCII SPACE 3 RD7 EQU $ JSK I:SIV IGNORE LEADING NULLS & LINEFEEDS COPY TI:CIB(Y),X  COPY CI:IV(X),X SET FOR 1 BYTE COPY IV:CNT(X),A OR =:7FFF,A COPY A,IV:CNT(X) JSK I:SDIO START I/O JNE A,RD140K I/O NOT STARTED JSK I:WAIT JEQ A,RD200K NOT COMPLETE  JSK I:STAT JNE A,RD300J BAD STATUS COPY *TI:IBF(Y),A COPY TI:FC(Y),Q SEE WHICHK  BYTE IT IS IN TBIT SB:,Q JF OV,RD9 IN LEFT BYTE AND =:FF,A JMP RD10 RD9 SHIFT A,RO,8 RD10 RBIT 7,A GET RID OF PARITY COPY A,Q SAVE BYTE JEQ A,RD7 IGNORE NULL SUB =CR,A JEQ A,RD16J NULL INPUT SUB =LF-CR,A IGNORE LINEFEED JEQ A,RD7  INGORE LINEFEED IMS TI:ACT(Y) ONE BYTE DONE NOP COPY TI:BCT(Y),A SUB =1,A  ONE BYTE LESS TO DO JEQ A,RD35J NOTHING LEFT TO DO;ADD 328 COPY A,TI:BCT(Y) COPY TI:FC(Y),A TBIT SB:,A JT OV,RD11 ALREADY ON SECOND BYTE SBIT SB:,A NOW ON SECOND BYTE  JMP RD12 RD11 RBIT SB:,A ON NEXT WORD IMS TI:IBF(Y) NOP RD12 COPY A,TI:FC(Y) SUB =:7F,Q CHECK FOR RUBOUT JNE Q,RD15 NOT EOF, OF RO NULL NULL JSK I:SIV GET READY TO READ NEXY TWO BYTES COPY TI:CIB(Y),X COPY CI:IV(X),X COPY IV:CNT(X),A AND =:8000,A CHANGE COUNT TO TWO BYTES OR =:7FFE,A COPY A,IV:CNT(X) JSK I:SDIO START READ JNE A,RD140J ERROR  JSK I:WAIT WAIT FOR COMPLETE JEQ A,RD200J NOT COMPLETE JSK I:STAT JNE A,RD300J BAD SYATUS SPACE 3 COPY TI:FC(Y),A TBIT SB:,A CHECK WHICH BYTES JT OV,RD14 SECOND BYTE COPY *TI:IBF(Y),A JEQ A,RD95J EOF, GOT RO NULL NULLL JMP RD14C NOT EOF RD300J JMP RD300 RD35J JMP RD35 LPOOL SPACE 3 RD14 COPY TI:IBF(Y),X COPY 0(X),A AND =:7F,A JNE A,RD14C NOT NULL, NOT EOF COPY 1(X),A SHIFT A,RO,8 LOOK FOR SECOND NULL  RBIT 7,A GET RID OF PARITY JEQ A,RD95J EOF SPACE 3 RD14C IMS TI:IBF(Y) BUMP BUFFER BY 2 BYTES NOP COPY TI:ACT(Y),A ADD =2,A TWO MORE BYTES DONE COPY A,TI:ACT(Y) SPACE 3 SPACE 3 RD15 COPY:M TI:ACT(Y),A,TI:PRI(Y) SAVE BYTES DONE SO FAR JSK I:DIO START I/O JNE A,RD140J NOT STARTED JSK I:WAIT WAIT FOR COMPLETE JEQ A,RD200J NOT COMPLETE JSK I:STAT GET STATUS JEQ A,RD17 NO ERROR SPACE 3 RD95J JMP RD95 RD140J JMP RD140 RD200J JMP RD200 RD250J JMP RD250 RD16 COPY =0,Q NO ERROR JMP RD99  GO FINISH UP LPOOL SPACE 4 RD17 EQU $ JSK I:VCNT CHECK INTERUPT VECTOR COUNT JEQ A,RD19 ALL DONE SBIT 15,A GET RID OF BUFFER ADDR BIT JMP RD19 LPOOL RD19 EQU $ ADD TI:BCT(Y),A COUNT DONE ON THIS I/O ADD TI:ACT(Y),A COPY A,TI:ACT(Y) TOTAL DONE SO FAR SPACE 4 JSK I:VCNT CHECK INTERUPT VECTOR COUNT JEQ A,RD22 ALL BUYTES DONE ON THIS READ COPY TI:FC(Y),Q AND =:F,Q SUB =FA:,Q JNE Q,RD250J ERROR, NOT ALL BYTES L DONE RD22 EQU $ COPY TI:FC(Y),A CHECK FOR UNFORMATTED I/O AND =:0F,A CLSN =UF:,A  JMP RD100 IS UNFORMATTED, DONE. COPY TI:IBF(Y),X SEE IF LAST BYTE READ WAS CR ADD TI:ACT(Y),X ADD BUFFER INDEX SUB TI:PRI(Y),X TBIT SB:,A JT OV,RD23 ON SECOND BYTE SO DON'T DECREMENT SUB =1,X POINT TO LAST BYTE INPUT RD23 EQU $ SBIT BY:,S SET BYTE MODE  COPY *TI:IBF(Y,X),A LAST BYTE INPUT SUB =1,X GET SECOND TO LAST CHAR COPY *TI:IBF(Y,X),Q RD24 EQU $ RBIT BY:,S SET WORD MODE RBIT 7,A GET RID OF PARITY SUB =CR,A  COPY TI:CIB(Y),X SAVE LAST CHAR COPY A,CI:T2(X) JNE A,RD25 NOT CR COPY TI:DIB(Y),X SUB DI:EDT(X),Q SEE IF LINE CANCELED JNE Q,RD25 NO COPY:M =0,A,TI:ACT(Y) NOTHING DONE, LINE CANCELED COPY TI:CIB(Y),X COPY A,CI:T2(X) NO ERROR COPY TI:DIB(Y),X COPY DI:ELI(X),X END OF LINE FOR INPUT JEQ X,RD100J NONE COPY:M =2,A,TI:BCT(Y) INCLUDE LF JMP TY12B GO DO IT RD100J JMP RD100 LPOOL SPACE 3 SPACE  4 RD25 COPY TI:FC(Y),A COPY TI:FC(Y),A RESTORE BYTE MODIFIER TBIT SB:,A COPY =0,Q BACKSPACE COUNTER COPY Q,A INIT BUFFER POINTER JF OV,$+2 ADD =1,A START ODD IF SB: SET RD30 COPY TI:CIB(Y),X COPY A,CI:T1(X) SAVE BUFFER POINTER COPY A,X BUFFER POINTER ADD TI:IBF(Y),X GET READY TO EDIT INPUT SBIT BY:,S SET BYTE MODE COPY *TI:IBF(Y,X),A NEXT BYTE RBIT BY:,S SET WORD MODE COPY TI:DIB(Y),X SUB DI:EDT(X),A CHECK FOR EDIT CHAR JNE A,RD32 NOT IT ADD =2,Q BUMP BACKSPACE COUNT SBIT 15,A FLAG AS EDIT CHAR RD32 ADD DI:EDT(X),A RESTORE CHAR SUB =RUBOUT,A JNE A,RD32A ADD =1,Q  IGNORE CHAR SBIT 15,A FLAG AS EDIT CHAR RD32A ADD =RUBOUT,A RESTOR CHAR COPY TI:CIB(Y),X RESTORE BUFFER POINTER COPY CI:T1(X),X BUFFER POINTER JLT A,RD32B EDIT CHAR SO DON'T PUT IN BUFFER CSK X,Q COPY X,Q NOP ADD TI:IBF(Y),X SUB Q,X ALLOW FOR BACKSPACES SBIT BY:,S SET BYTE MODE COPY A,*TI:IBF(Y,X) PUT CHAR IN RIGHT PLACE RBIT BY:,S  SET WORD MODE ADD Q,X SUB TI:IBF(Y),X BUFFER POINTER RD32B ADD =1,X NEXT CHAR  COPY X,A SUB TI:ACT(Y),X DONE? ADD TI:PRI(Y),X JNE X,RD30 NO SPACE 4  SUB TI:ACT(Y),Q UPDATE COUNT DONE NEG Q,Q COPY Q,TI:ACT(Y) COPY TI:CIB(Y),X COPY åå