|
DataMuseum.dkPresents historical artifacts from the history of: Philips Data Systems |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Philips Data Systems Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 61982 (0xf21e)
Notes: pts_type(SC)
Names: »SYSINI.SC«
└─⟦f350e1b7a⟧ Bits:30009678 Philips computer tape "600219"
└─⟦this⟧ »MONGEN/SYSINI.SC«
IDENT SYSINI REL 11.0 81-01-26 870105041100 =2,WHEN MMUPAG=0 INITIATE PAGE ADDRESS IN PAGTAB WITH RIGHT VALUE PRR 11.0 80-12-03 =1,CREATE PAGES FOR APPLICATIONS WITH DIFFERENT SEGMENT SIZES PRR 11.0 80-11-20 EJECT *************************** * * * ENTRIES AND EXTERNALS * * * *************************** * LABEL ENTRIES ENTRY SYSINI ENTRY INILEN PROGRAM LENGTH ENTRY INIEND END OF SYSINI ENTRY REL * SUBROUTINE ENTRIES ENTRY MOVE ENTRY ERROR ENTRY CMPADR COMPARE ADDRESSES ENTRY NXTBLK SKIP TO NEXT CONFIGURATION BLOCK ENTRY NXTCOM SKIP COMMONDEVICE DEFINITION BLOCK ENTRY CONVRT CONVERSION ASCII-BINARY ENTRY GETNUM CONVERT 3 ASCII-DIGITS TO BINARY ENTRY MULT MULTIPLICATION ROUTINE ENTRY XMOVE MOVE BLOCKS INSIDE MEMORY VIA MMU ENTRY MOVING ENTRY MOVMMT MOVE MM-TABLE ENTRY MMRST RESET MM-TAB ENTRIES ENTRY GETTAB FIND TTAB-ADDRESS ENTRY GETTTB FIND TTAB-ADDRESS ENTRY MMENT FIND LAST USED ENTRY IN MM-TAB ENTRY PUSH STORE REGISTERS ON A15-STACK ENTRY POB RESTORE REGISTERS FROM A15-STACK ENTRY GETAPP ENTRY SETTAB ENTRY INBIMA ENTRY QUEJOB QUEUE TASK EJECT * SAVE AND WORK AREA ENTRIES ENTRY MMTAB WORK-TABLE 1 (MMU ENTRY TABBE ABSOLUTE START ADDRESS OF WORK-TAB 1 ENTRY MMEND ABSOLUTE END ADDRESS OF WORK-TAB 1 ENTRY MMDDIV WORK-TABLE 2 (MM) RELATIVE 'REL' ENTRY MMBEG ENTRY LSTPAG DISPL. TO 'ENTRY POINTER' ENTRY PSW EJECT * SYSTEM CONTROL TABLE EXTERNALS EXTRN SCTSFA START OF FREE AREA EXTRN SCTLAC LOGICALL ADDRESS TO COMMON PART EXTRN SCTTCT TC:TAB ADDRESS EXTRN SCTSTB A15 STACK-BASE EXTRN SCTEFA END OF FREE AREA EXTRN SCTNOP NUMBER OF PAGES EXTRN SCTPSZ PAGE SIZE EXTRN SCTMMC =00002 EXTRN SCTOPT SYSTEM OPTION EXTRN SCTPAG PAGE TABLE ADDRESS EXTRN SCTSWB ADDRESS TO SWB CONTROL BLOCK TABLE EXTRN SCTBUG BUGGER ADDRESS EXTRN STKEND START OF SCRATCH-PAD AREA EXTRN STKCOM START OF COMMON-PAD AREA * EXTERNAL LABELS EXTRN PAGQUE PAGE QUEUE POINTER * EXTERNAL SUBROUTINES EXTRN ACTOT QUEUE TASK EXTRN PFINIT EXTRN SAVE8 SAVE 8 REGS EXTRN RETUR8 RELOAD 8 REGS EXTRN TDISP DISPATCHER ENTRY EXTRN SWL48 SWITCH TO LEVEL 48 * EXTRN TTB:SA START OF SAVE AREA IN TTAB EXTRN TTB:CB DISPL. TO CURRENT SEGMENT BASE ADDRESS EXTRN TTB:MT DISPL. TO 1:ST MMU-TABLE ENTRY IN TTAB EXTRN TTB:SP DISPL TO SEGMENT TABLE ADDRESS EXTRN SEG:NS NUMBER OF SEGMENTS IN SEGTAB EXTRN TTB:AM DISPL. TO ALLOCATION BIT MAP EJECT *************************************** * CONDITIONAL ASSEMBLY * *************************************** DSKPAG EQU 1 0 = NO DISC PAGING MMUPAG EQU 1 0 = NO MMU CPU852 EQU 0 0 = NOT 852 CPU ********************************************* * * * APCTAB DISPLACEMENTS * * ==================== * * * ********************************************* APLADA EQU 22 APPL. REL. BASE (2 WORDS) =1 APLREL EQU 18 NUMBER OF RESIDENT SEGMENTS APLIOE EQU 0 APPLICATION RESTART ADDRESS APLDAD EQU 0 APPLICATION FILE DISC ADDR. (BIT 0-15) APLLAC EQU 14 APPLICATION LOAD ADDR. (LOGICAL ADDR.) APLLAP EQU 12 LOGICAL PAGE ADDRESS APLLDA EQU 0 APPLICATION LOAD ADDR. (PHYSICAL ADDR.) APLMMC EQU 10 APPLICATION MMU START ENTRY APLMMP EQU 8 SEGMENT START MMU ENTRY APLSEG EQU 4 PHYSICAL START OF 1ST SEGMENT APLNPE EQU 6 NUMBER OF PAGE ENTRIES IN MMU APLSWB EQU 2 APPLICATION SWB APLSTA EQU 16 APPL. PGM START ADDRESS APLTYP EQU 8 APPLICATION TYPE APLPSZ EQU 20 APPLICATION SEGMENT SIZE =1 EJECT ***************************************** * * * COMMON DISPLACEMENTS AND CONSTANTS * * * ***************************************** APLTAB EQU 12 ADDRESS TO APPL. CONTROL TABLE APPLNO EQU 18 APPLICATION NUMBER BUFSIZ EQU 14 TEMPORARY BUFFER SIZE CONLEN EQU 0 LENGTH OF CONFIGURATION DATA CONSTA EQU 2 START OF CONFIGURATION DATA DATEND EQU 34 END OF DDIV PROTOTYPE DYNSTA EQU 52 START OF DYNTAB:S FSTADR EQU 20 1ST FREE ADDRESS WHEN ALLOCATING BUFFER FSTPAG EQU 22 1ST FREE PAGE (PHYSICAL) FYSPAG EQU 24 LAST PHYSICAL PAGE NUMBER LSTADR EQU 26 LAST ADDRESS WHEN BUILDING DATA PART MAPLEN EQU 30 LENGTH OF AREA TO MAP MMFROM EQU 36 2ND MMU TABLE WORK AREA MMTO EQU 38 1:ST MMU TABLE WORK AREA M:REL EQU 16 RELOCATION CONSTANT SYSBUF EQU 28 START OF TEMPORARY BUFFER SWBFSA EQU 4 SWB-FILE START ADDRESS SWBFSE EQU 8 SWB-FILE END ADDRESS TTAB EQU 32 WORK AREA FOR MMU TABLE TOTSGM EQU 46 TOTAL NUMBER OF SEGMENTS SWBFLG EQU 48 SWAPPABLE WORK BLOCK FLAG COM01 EQU 40 COMMON WORK AREA 1 COM02 EQU 42 COMMON WORK AREA 2 COM03 EQU 44 COMMON WORK AREA 3 COM04 EQU 50 COMMON WORK AREA 4 DCBLK EQU 54 START OF DC CONF DATA EJECT ******************************* * SCRATCH-PAD DISPLACEMENTS * ******************************* * APCBLK EQU 0 START OF APPL. CONTROL BLOCK EJECT ***************** ***************** ** ** ** CONSTANTS ** ***************** ** ** ***************** ********** * P:MTAB * ********** T:ATAB EQU 0 U:BTAB EQU 2 P:BAS EQU 6 SEGMENT BASE T:AID EQU 32 ADDRESS TO 'TABLE OF T:A TID' S:BTAB EQU 40 DISP TO S:BTAB ADDRESS EJECT ******************************* * CONFIGURATION FILE (CONFIG) * ******************************* * TASK DEFINITION BLOCK: TDBBT EQU 0 1A BLOCK TYPE TDBNT EQU TDBBT+1 2N NUMBER OF TASKS TDBID EQU TDBNT+2 6A TASK ID START VALUE TDBMC EQU TDBID+6 6A MATCHING TASK CLASS TDBTL EQU TDBMC+6 6A TASK LEVEL TDBNC EQU TDBTL+6 2N NUMBER OF TERMINAL DEVICE CLASSES * TDBFST EQU TDBNC+2 FIRST TERM DEF TDC EQU 7 TERMINAL DEVICE CLASS TLC EQU 7 LINE CONNECTION TDBREC EQU TDC+TLC TDB-RECORD LENGTH * SDC EQU 7 SPECIAL DEVICE CLASS-RECORD * * COMMON DEVICE DEF. BLOCK: CDBBT EQU 0 1A BLOCK TYPE CDBNC EQU CDBBT+1 2N NUMBER OF SPEC. DEV. CLASSES SDCFST EQU CDBNC+2 FIRST SDC-RECORD * * * USER WORK BLOCK TYPE DEF. BLOCK UDBBT EQU 0 1A BLOCK TYPE UDBNU EQU UDBBT+1 3A NUMBER OF UWB TYPES * UDBFST EQU UDBNU+3 FIRST UDB-RECORD NAMUWB EQU 3 NAME OF UWB NUMUBL EQU 3 NUMBER OF BLOCKS UDBREC EQU NAMUWB+NUMUBL UDB RECORD-LENGTH EJECT ********* * T:A * ********* T:ASTA EQU -14 T:A START CSE EQU -14 CURRENT SEGMENT END (HERE: STACKSIZE) CSB EQU -12 CURRENT SEGMENT BASE CSN EQU -10 CURRENT SEGMENT NUMBER (HERE LENGTH OF ALL DSCB-RECORDS T:DAD EQU -8 ADDRESS TO T:D CIA EQU -6 CURRENT INSTUCTION ADDRESS (HERE: DISPLACEMENT TO T:A-START) T:ATID EQU -4 TASK ID STKE EQU -2 STACK END PA EQU 0 STACK POINTER STKB EQU 2 STACK BASE WATFST EQU 4 FIRST WAT-ELEMENT * * DSCB-RECORD: DSCBL EQU 20 RECORD LENGTH BL EQU 2 LENGTH OF FIX BUFFER SB EQU 4 INDEX TO DSCB WHICH SHARE THE BUFFER BP EQU 18 BUFFER POINTER EJECT ********* * T:D * ********* FCD EQU 0 DISPLACEMENT TO FCB IN T:A T:DTID EQU 2 TASK IDENTIFIER (PROTOTYPE) DATLEN EQU 4 NUMBER OF DATASETS (DSCB'S) DATTAB EQU 6 DISPLACEMENT TO BEGINNING OF DAT-TABLE WATLEN EQU 8 NUMBER OF WATELEMENTS TWBMSK EQU 10 MASK FOR TWB'S (ONE BIT/ENTRY) SWBMSK EQU 12 MASK FOR SWB'S -"- CWBMSK EQU 14 MASK FOR CWB'S -"- UWBMSK EQU 16 MASK FOR UWB'S -"- DWBFST EQU 18 FIRST WORD IN DBLK-TAB STPREC EQU 4 RECORD LENGTH OF START-POINTS **************** * SOP-HANDLING * **************** SOP EQU /2E DEVICE ADDRESS LAMP CODE MEANING --------- ------- LMP1 EQU /400 SYSLOAD RUNS LMP2 EQU /200 READ ERROR LMP3 EQU /100 MEMORY OVERFLOW LMP4 EQU /80 FORMAT ERROR (CONFIG) LMP5 EQU /40 TID ERROR LMP6 EQU /20 UWB OR SWB ERROR LMP7 EQU /10 MM-TABLE OVERFLOW LMP8 EQU 8 LMP9 EQU 4 LMP10 EQU 2 LMP11 EQU 1 EJECT ****************************** * CONSTANTS USED ONLY * * WHEN COBOL APPLICATION * ****************************** STKMAX EQU 500 DEFAULT SPL STACK-SIZE ENTFIN EQU /FFFF PROGRAMMER DEFINED ENTRY POINT SPLSTS EQU 4 DIAGNOSTIC,STACK-SIZE SPLSTB EQU 52 STACK-BASE SPLENT EQU 54 ENTRY-FINI SPLSTA EQU 88 STACK-AREA ********************* * OTHER CONSTANTS * ********************* WBLEN EQU -4 LENGTH OF WORK-BLOCK DTLEN EQU -2 LENGTH OF DESCRIPTOR-TABLE SWBLEN EQU 4 DISP TO LENGTH OF SWB FCBDD1 EQU 8 DISP TO FIRST DSET FCBDD2 EQU 10 DISP TO 2:ND DSET STKSZ EQU 128 DEFAULT STACK-SIZE SEGREC EQU 6 RECORD LENGTH IN S:GTAB NUMSEG EQU 10 DISPL. TO NUMBER OF SEGMENTS IN S:GTAB TTBTID EQU 2 TID IN TTAB T:DSAV EQU 0 SAVE FOR T:D-ADDRESS IN TTAB TTB:PP EQU 6 SAVE AREA FOR TCL IN TTAB NTPA EQU 4 INTERPRETER START ADDRESS IHRTC EQU 4 RTC INTERRUPT ADDRESS RTCDA EQU /1B RTC DEVICE ADDRESS TABLEN EQU 20 LENGTH OF EACH APL.TABLE IN SCRATCH-PAD AREA ACBLEN EQU 26 APPL.CONTROL BLOCK LENGTH =1 ***************************************************************** * CALL-FORMAT, PERFORMS: CFR A14,A13 * * DATA [REL-ADDRESS] * * * ***************************************************************** CALL FORM 16=/F697,16 EJECT LDKL A1,SYSINI AD A1,M:REL+STKCOM ABR A1 GO TO START OF SYSINI EJECT ************************************************** ************************************************** ** ** ** RELOCATION ROUTINE & STACK INITIALLISATION ** ** ** ************************************************** ************************************************** REL RF SUBBA JUMP TO SUBROUTINE HANDLER LDR A13,P GET BASE ADDRESS TO A13 SUKL A13,4 * ADJUST FOR PSW-ROUTINE * ************************** LDK A3,GETPSW RELATIVE ADDRESS TO 'PSW-ADDRESS' ADR A3,A13 ABSOLUT DITO ST A3,PSW,A13 STORE ADDRESS TO 'GETPSW'-ROUTINE * LOAD STACKBASE * ****************** LDKL A14,STACKB ADR A14,A13 RELOCATE RTN A8 * STACK * ********* * RES 20 STACKB EQU *-REL-2 EJECT * ADDRESS TO PSW-ROUTINE * ************************** * PSW EQU *-REL DATA GETPSW **************************************************************** * G E T P S W * * LITTLE SUBROUTINE TO PUT PSW IN STACK FOR CALLING SUBROUTINE * **************************************************************** GETPSW EQU *-REL STR A2,A14 SAVE A2 ON A14-STACK LD A2,2,A14 GET PSW FROM CALLING SUBROUTINE ST A2,6,A14 REPLACE PSW FROM MAIN PROGRAM LDR* A2,A14 RESTORE A2 RTN A14 EJECT ********************************* * * * SUBROUTINE-HANDLER * * * ********************************* SUBSUB EQU *-REL SUBBA ST A10,COM04+STKCOM SAVE A10 LD* A10,4,A14 GET SUBROUTINE REL ADDRESS IM 4,A14 ADJUST RETURN ADDRESS IM 4,A14 AD A10,M:REL+STKCOM ADD FOR SYSLDM RELOCATION STR A10,A14 PUT ON STACK LD A10,COM04+STKCOM RESTORE A10 ABR* A14 EJECT * MMU TABLES * MMDDIV EQU *-REL DDIV (& SYSLDA) MM-TABLE IFT MMUPAG=1 RES 16 XIF MMTAB EQU *-REL WORK AREA MM-TAB TABBE EQU * IFT MMUPAG=1 DATA 0,0,0,0,0,0,0,0 DATA 0,0,0,0,0,0,0,0 XIF MMEND EQU * DATA 0 CURRENT SEGMENT BASE IN T:A TTPAG DATA 0 LAST ENTRY (FROM BOTTOM) IN MM-TAB DATA 0 LSTPAG EQU TTPAG-* DISPL. TO 'ENTRY-POINTER' DATA 0 APPL. CONTROL BLOCK ADDRESS MMBEG EQU TABBE-* EJECT *** *** *** S U B R O U T I N E S *** *** *** ************************************************* ************************************************* ** E R R O R ** ** ** ** ** ** ERROR HANDLING ROUTINE. ** ** ** ** INPUT :A1=SOP-MESSAGE ** ** OUTPUT:A2=RELATIVE CALLING ADDRESS** ** (REG-CONTENTS IS SAVED) ** **************************************** ERROR EQU * ST A2,COM01+STKCOM SAVE A2 LD A2,4,A14 GET CALLING ABSOLUTE ADDRESS SUR A2,A13 RELATIVE DITO OTR A1,0,SOP HLT DATA /6300 (DEBUGGING PURPOS) EJECT ** P U S H ** ** ** ** ** ** STORE REGISTERS ON A15-STACK ** ** ** ************************************ PUSH EQU * IFT CPU852=1 STR A1,A15 SAVE A1 STR A2,A15 SAVE A2 STR A3,A15 SAVE A3 STR A4,A15 SAVE A4 STR A5,A15 SAVE A5 STR A6,A15 SAVE A6 STR A7,A15 SAVE A7 STR A8,A15 SAVE A8 STR A9,A15 SAVE A9 STR A10,A15 SAVE A10 STR A11,A15 SAVE A11 STR A12,A15 SAVE A12 STR A13,A15 SAVE A13 STR A14,A15 SAVE A14 XIF IFT CPU852=0 MSR 14,A15 SAVE A1-A14 ON A15-STACK XIF RTN A14 EJECT ** P O B ** ** ** RESTORE REGISTERS FROM A15-STACK ** ** ** **************************************** POB EQU * IFT CPU852=1 LDR* A14,A15 RESTORE A1 LDR* A13,A15 RESTORE A2 LDR* A12,A15 RESTORE A3 LDR* A11,A15 RESTORE A4 LDR* A10,A15 RESTORE A5 LDR* A9,A15 RESTORE A6 LDR* A8,A15 RESTORE A7 LDR* A7,A15 RESTORE A8 LDR* A6,A15 RESTORE A9 LDR* A5,A15 RESTORE A10 LDR* A4,A15 RESTORE A11 LDR* A3,A15 RESTORE A12 LDR* A2,A15 RESTORE A13 LDR* A1,A15 RESTORE A14 XIF IFT CPU852=0 MLR 14,A15 RESTORE A1-A14 FROM A15-STACK XIF RTN A14 EJECT ** M O V E ** ** ** ** ** ** MOVE BLOCKS INSIDE MEMORY ** ** ** ** INPUT:A1=FROM-ADDRESS ** ** A2=TO-ADDRESS ** ** A3=LENGTH ** ** OUTPUT:A3=-1 ** ** WORK-REG: A4 ** ********************************* MOVE EQU * MOVES ADR A1,A3 END OF FROM AREA ADR A2,A3 END OF TO-AREA MOVE10 SUK A3,1 DEC LENGTH RF(N) MOVE20 ALL DONE SUK A1,1 SUK A2,1 LCR A4,A1 GET CHARACTER SCR A4,A2 STORE CHARACTER RB MOVE10 MOVE20 RTN A14 IFT MMUPAG=0 EJECT ** M O V I N G ** ** ** ** ** ** USES ROUTINE 'MOVE' ABOVE. TO-ADDRESS IS ** ** ASSUMED TO BE DATA-PART OF MEMORY ** ** LSTADR POINTS AT LAST (HIGHEST) FREE ** ** ADDRESS. LSTADR IS UPDATED AND CHECKED ** ** ** ** INPUT:A3 & A1 AS IN 'MOVE' ** ** OUTPUT: A2=TO-ADDRESS (LSTADR UPDATED) ** ** WORK-REG: A4 ** *********************************************** MOVING EQU * CALL PUSH STORE REGISTERS ON A15-STACK LD A2,LSTADR+STKCOM GET LAST ADDRESS LDR A9,A2 LDR A11,A3 CALL CMPADR ENOUGTH MEMORY LEFT? RF(NL) MOV010 NO! SUR A2,A3 SUB LENGTH ANKL A2,/FFFE MAKE EVEN ADDRESS LDR A11,A2 LD A9,DATEND+STKCOM END OF PROTOTYP AREA CALL CMPADR COMPARE ADDRESSES RF(NL) MOV020 MOV010 LDKL A1,LMP3 MEMORY OVERFLOW CALL ERROR MOV020 LD A9,FSTADR+STKCOM CHECK FIRST FREE ADDRESS CALL CMPADR RB(L) MOV010 ST A2,LSTADR+STKCOM NEW ADDRESS CALL POB RESTORE REGISTERS FROM A15-STACK LD A2,LSTADR+STKCOM RB MOVES XIF EJECT ** X M O V E ** ** ** ** ** ** MOVE BLOCK INSIDE MEMORY VIA MMU ** ** TWO PHASES:-MOVE TO SYSTEM AREA (BUFBEG) ** ** -MOVE TO USER AREA ** ** IF 'BUFSIZ' (TEMPORARY MOVE-BUFFER) IS NOT** ** BIG ENOUGH THE MOVE IS REPEATED ** ** ** ** INPUT :A1=FROM-ADDR(MMFROM=MM-TABLE ADDR.)** ** A2=TO-ADDRESS (MMTO=MM-TABLE ADDR.)** ** A3=LENGTH (IN BYTES) ** ** WORK.REGS:A4,A10 ** ************************************************ XMOVE EQU * IFT MMUPAG=1 CALL PUSH STORE REGISTERS ON A15-STACK ST A1,COM01+STKCOM ST A2,COM02+STKCOM ST A3,COM03+STKCOM XMOV05 EQU * LDR A10,A3 SAVE LENGTH LDK A4,0 RESET 'NUMBER-OF-MOVE' COUNTER LDR A11,A3 GET LENGTH OF AREA TO MOVE LD A9,BUFSIZ+STKCOM GET TEMPORARY BUFFER SIZE CALL CMPADR TEMPORARY BUFFER BIG ENOUGTH RF(G) SPLIT NO! SEVERAL MOVE XMOV10 LDR A3,A10 GET LENGTH LD A1,COM01+STKCOM GET FROM ADDRESS LD A2,SYSBUF+STKCOM GET TEMP. BUFFER START-ADDRESS TL* MMFROM+STKCOM LOAD FROM-TABLE MVUS A3 MOVE DATA-BLOCK TO TEMP. BUFFER ST A1,COM01+STKCOM SAVE END OF 'FROM' ADDRESS LD A1,SYSBUF+STKCOM LD A2,COM02+STKCOM GET START OF 'TO' ADDRESS LDR A3,A10 GET LENGTH TL* MMTO+STKCOM LOAD TO-TABLE MVSU A3 MOVE DATA-BLOCK FROM BUFFER SUK A4,1 MORE PARTS TO MOVE? RF(N) XMOV30 NO! ADR A2,A10 ST A2,COM02+STKCOM SAVE START OF 'TO' ADDRESS LD A3,COM03+STKCOM GET REQUESTED LENGTH SUR A3,A10 SUBTRACT MOVED PART ST A3,COM03+STKCOM SAVE LDR A11,A3 GET REMAINING LENGTH LDR A9,A10 GET CURRENT BUFFER LENGTH CALL CMPADR REMAINING LENGTH<CURRENT BUFFER LENGTH? RB(NL) XMOV10 LDR A10,A3 LAST LENGTH RB XMOV10 EJECT SPLIT EQU * LDR A1,A3 GET DIVISOR SRL A1,15 MOST SIGN. PART OF DIVISOR LDR A2,A3 GET DIVISOR DV BUFSIZ+STKCOM AND DIVIDE LDR A4,A2 GET QUOTIENT (=NUMBER OF MOVES - 1) LD A10,BUFSIZ+STKCOM MOVE MAX LENGTH RB XMOV10 XMOV30 CALL POB RESTORE REGISTERS FROM A15-STACK RTN A14 EJECT ** M O V I N G ** ** ** ** ** ** USES SUBROUTINE 'XMOVE' TO MOVE A BLOCK ** ** VIA TWO MM-TABLES.PHYSICALL TO-ADDRESS ** ** IS ALWAYS ASSUMED TO BE DATA PART OF ** ** MEMORY. LSTADR & FYSPAG POINTS AT LAST ** ** (HIGHEST) FREE ADDRESS. LSTADR &FYSPAG ** ** IS UPDATED AND CHECKED. ** ** ** ** INPUT :A1 & A3 AS IN 'XMOVE' ** ** TTAB=POINTER TO TTAB (OR LIKELY) ** ** OUTPUT:A2=LOGICALL TO-ADDRESS ** ** WORK-REGS: A4,A10 ** *********************************************** MOVING EQU * CALL PUSH STORE REGISTERS ON A15-STACK LD A4,FYSPAG+STKCOM GET ACT. PHYSICALL PAGE LD A10,TTAB+STKCOM LOAD TTAB-ADDRESS LD A2,LSTPAG,A10 GET LAST TABLE-ENTRY IN TTAB LDR* A9,A2 GET PAGE IN TABLE ANKL A9,/FC00 CWR A9,A4 CORRECT PAGE IN MMU-TABLE? RF(E) MOV010 YES! ADKL A4,/400 ADJUST FOR 'SETTAB' CALL SETTAB NEW PAGE IN TABLE! MOV010 LD A11,LSTADR+STKCOM GET LAST LOGICALL ADDRESS ANKL A11,/FFF LDR A9,A3 GET LENGTH OF AREA TO MOVE CALL CMPADR ENOUGTH SPACE IN CURRENT PAGE? RF(NL) MOV020 YES! SUR A11,A3 COMPUTE DISPLACEMENT IN PAGE MOV015 RF(NP) MOV025 CALL SETTAB INITIALIZE NEW PAGE ENTRY ADKL A11,4096 PHYSICAL PAGE INCREMENT RB MOV015 MOV020 SUR A11,A3 COMPUTE DISPLACEMENT IN PAGE MOV025 RF(NN) MOV050 MOV030 CALL SETTAB NEW PAGE IN TABLE! ADKL A11,4096 NEW PAGE INCREMENT RB(N) MOV030 NOT ENOUGH. NEW PAGE! * MM-TABLE CORRECT. SAVE ADDRESSES * * A4=PHYSICALL PAGE NUMBER * A11=DISPLACEM. WITHIN PAGE * A2=CURRENT ENTRY IN MM-TABLE MOV050 EQU * ST A2,LSTPAG,A10 SAVE MMU-ENTRY IN TTAB ST A4,FYSPAG+STKCOM SAVE PHYSICALL PAGE NUMBER LDKL A4,MMBEG CALCULATE TABLE ENTRY DISPLACEM. ADR A4,A10 ABSOLUTE ENTRY ADDRESS ST A4,MMTO+STKCOM SAVE TABLE ADDRESS SUR A2,A4 RELATIVE ADDRESS SLL A2,11 SHIFT TO FOUR FIRST BITS & DIV BY 2 ORR A2,A11 GET DISPLACEM. WITHIN PAGE ANKL A2,/FFFE EVEN ADDRESS ST A2,LSTADR+STKCOM SAVE LOGICALL ADDRESS * CHECK ADDRESSES * LD A9,FSTPAG+STKCOM GET FIRST FREE PAGE ST A11,COM01+STKCOM SAVE A11 LD A11,FYSPAG+STKCOM CALL CMPADR AND COMPARE RF(G) MOV090 OK! RF(L) MOV070 NOK! LD A11,COM01+STKCOM RESTORE DISPL. LD A9,FSTADR+STKCOM CALL CMPADR RF(NL) MOV090 OK! MOV070 LDKL A1,LMP3 CALL ERROR MOV090 EQU * CALL XMOVE MOVE LD A1,STKCOM+MAPLEN MAPPING? RF(Z) MOV100 NO CALL INBIMA INIT ALLOCATION BIT MAP MOV100 CALL POB RESTORE REGISTERS FROM A15-STACK LD A2,LSTADR+STKCOM GET LOGICAL TO-ADDRESS TL* MMFROM+STKCOM RESTORE MM-TABLE RTN A14 XIF EJECT ** S E T T A B ** ** ** ** ** ** SET NEW PAGE IN MM-TABLE & CHECK IF TABLE ** ** OVERFLOW. ** ** ** ** INPUT :A2-ADDRESS TO CURRENT ENTRY ** ** A4=PHYSICALL PAGE ** ** OUTPUT:A2 & A4 IS UPDATED ** ** WORK.REG: A9 ** ************************************************* SETTAB EQU * IFT MMUPAG=1 SUKL A4,/400 GET NEXT PAGE SUK A2,2 GET NEXT ENTRY * CHECK IF MM-TABLE OVERFLOW * LDR A9,A10 GET END-ADDRESS A10=TTAB ADKL A9,MMBEG TNM A2,A9 32-KB BOARDER CHECK RF(NN) SETT00 CWR A9,A2 RF SETT05 SETT00 CWR A2,A9 OVERFLOW? SETT05 RF(NL) SETT10 NO LDK A1,LMP7 CALL ERROR SETT10 EQU * STR A4,A2 STORE IN TABLE RTN A14 XIF EJECT ** C M P A D R ** ** ** ** ** ** COMPARE ADDRESSES. RESULT IN PSW ON RETURN ** ** ** ** INPUT : A11 COMPARED TO.. ** ** A9 ** ** OUTPUT: RESULT IN A14-STACK ** ************************************************** CMPADR EQU * TNM A11,A9 RF(NN) CMPA10 CWR A9,A11 RF CMPA20 CMPA10 CWR A11,A9 CMPA20 CFI A14,PSW,A13 PUT RESULT ON STACK RTN A14 EJECT ** M U L T ** ** ** ** ** ** MULTIPLICATION (A2) X A3(), A2#0 ** ** ** ** INPUT : A3,A2 ** ** OUTPUT:A3=RESULT ** ************************************************ MULT EQU * ST A3,COM01+STKCOM STR A2,A14 SAVE A2 TEMPORARY LDK A3,0 ADD AD A3,COM01+STKCOM SUK A2,1 RB(NZ) ADD LDR* A2,A14 RTN A14 EJECT ** M M E N T ** ** ** ** ** ** FIND LAST USED ENTRY IN MM-TAB. SCAN ** ** FROM LOW ADDRESS. NOT USED ENTRY=0. ** ** ** ** INPUT :A3=MM-TABLE ADDRESS ** ** OUTPUT:A3=ENTRY ADDRESS ** ** A9=TTAB-ADDRESS ** ** LSTPAG IN TTAB=A3 ** ** A1=CONTENTS OF 1:ST USED ENTRY ** *********************************************** MMENT EQU * IFT MMUPAG=1 LDR A9,A3 GET TABLE ADDRESS SUKL A9,MMBEG ADJUST A9 (LOOKS LIKE TTAB POINTER) SUK A3,2 MMEN10 ADK A3,2 INCREMENT ADDRESS LDR* A1,A3 GET CONTENTS OF MM-TABLE ANKL A1,/FC00 CWK A1,/FC00 RB(Z) MMEN10 ST A3,LSTPAG,A9 SAVE FIRST FREE PAGE-ADDRESS RTN A14 XIF EJECT ** G E T T A B ** ** ** ** ** ** FIND TTAB ADDRESS ** ** ** ** INPUT :A8=POINTER TO T:A IN T:ATAB ** ** OUTPUT:A2=TTAB-ADDRESS ** ** A1=TID ** ** WORKREGS:A3,A4,A10 ** ********************************************** GETTAB EQU * IFT MMUPAG=0 LDR* A3,A8 T:A ADDRESS LD A1,T:ATID,A3 GET TID TO MATCH LD A12,T:DAD,A3 T:D-ADDRESS XIF IFT MMUPAG=1 ELR A3,A8 T:A-ADDRESS EL A1,T:ATID,A3 GET TID EL A12,T:DAD,A3 XIF GETTTB EQU * ENTRY. INPUT: A1=TID ST A10,COM04+STKCOM SAVE A10 LD A4,SCTTCT GET TC:TAB ADDRESS LDR* A10,A4 TCTAB LENGTH GETT10 ADK A4,2 SUKL A10,2 ALL? RF(NN) GETT20 NO! LDR A3,A1 SAVE A1 (DEBUGGING PURPOS) LDK A1,LMP5 TID ERROR CALL ERROR GETT20 LDR* A2,A4 TTAB-ADDRESS CW A1,TTB:PP,A2 TCL EQUAL? RB(NE) GETT10 NO! ST A2,TTAB+STKCOM SAVE LD A10,COM04+STKCOM RTN A14 EJECT ********************************************************** * * * INBIMA - INIT BIT MAP * * ===================== * * * * REFERENCED IN: MOVING,SYSLDB PART 2 * * * * ENTRY: MAPLEN - LENGTH OF AREA TO BE MAPPED * * LSTADR - LAST LOGICAL ADDRESS * * TTAB - TTAB ADDRESS * * * * EXIT: * * * * WORK REGISTERS: A1,A2,A3,A4 * * * * SUBROUTINES: * * * ********************************************************** INBIMA EQU * IFT MMUPAG=1 LDKL A1,/8000 INIT BIT MASK LD A2,STKCOM+LSTADR GET LAST ADDRESS LDR A4,A2 SAVE ANKL A4,/C000 SELECT MMU TABLE PARTITION SRL A4,13 DISPLACEMENT TO START OF PARTITION ADKL A4,TTB:AM BIT MAP DISPLACEMENT AD A4,STKCOM+TTAB ADD TTAB ADDRESS LDR A3,A2 GET LOGICAL ADDRESS ANKL A3,/3000 SELECT ENTRY IN PARTITION SRL A3,12 DISPL. REL. START OF PARTITION MAP:40 SUK A3,1 CORRECT NIBBLE FOUND? RF(N) MAP:50 YES SRL A1,4 NEXT NIBBLE RB MAP:40 MAP:50 ECR A3,A2 GET NUMBER OF 1K-DISPLACEMENTS SRL A3,2 ANK A3,3 ISOLATE MAP:60 SUK A3,1 CORRECT 1K-PARTITION? RF(N) MAP:65 YES SRL A1,1 NEXT 1K-PARTITION RB MAP:60 MAP:65 LD A3,STKCOM+MAPLEN GET LENGTH ANKL A2,/3FF REMANING PART OF 1K-PAGE ADR A3,A2 ADJUST LENGTH LDKL A2,TTB:MT DISPLACEMENT TO MMU TABLE AD A2,STKCOM+TTAB ADD TTAB ENTRY ADDRESS MAP:70 ORRS A1,A4 INDICATE 1K-PARTITION OCCUPIED LDR A3,A3 GET LENGTH RF(N) MAP:80 >32K SUKL A3,/400 DECREMENT LENGTH RF(NP) MAP100 MAPPING FINISHED RF MAP:90 MAP:80 SUKL A3,/400 DECREMENT LENGTH MAP:90 SRL A1,1 NEXT 1K-PARTITION RB(NZ) MAP:70 IN THE SAME BIT MAP ENTRY ADK A4,2 NEXT BIT MAP ENTRY CWR A4,A2 END OF BIT MAP? RF(E) MAP100 YES! LDKL A1,/8000 INIT BIT MASK RB MAP:70 MAP100 EQU * XIF RTN A14 EJECT ** M M R S T ** ** ** ** RESET MMTAB ENTRIES FROM ADDRESS ** ** INDICATED BY REGISTER A1 DOWNTO ** ** MMTAB START.SET ENTRIES TO /FC00 ** ** ** ** INPUT : A1 = LAST USED ENTRY ** ** OUTPUT: A1 = MMTAB START ADDRESS ** ** A2 = MMTAB START ADDRESS ** ** A12= /FC00 ** ********************************************** MMRST EQU * IFT MMUPAG=1 LDKL A2,MMTAB WORK TABLE ADDRESS ADR A2,A13 SUK A2,2 LDKL A12,/FC00 INDICATOR MMRST1 EQU * SUK A1,2 NEXT ENTRY CWR A1,A2 ALL DONE ? RF(E) MMRST2 YES STR A12,A1 INDICATE FREE ENTRY RB MMRST1 NEXT ENTRY MMRST2 EQU * RTN A14 XIF EJECT * G E T A P P * * * * GET START OF APLTAB-BLOCK AND CONFIGURA- * * TION-DATA FOR SPECIFIED APPLICATION * * AND IF MMU-CASE ,LOAD HARDWARE MMU-TABLE * * AND MMTAB WITH MMU-TABLE FROM TTAB * * * * INPUT : A1=APPL.TYPE 'CR' 'CO' 'BA' 'AS' * * APPLNO=APPL.NUMBER OF CURRENT * * APPL.TYPE 0,1,2,3... * * CONSTA=START OF CONF.DATA * * * * OUTPUT: A1=ADDRESS TO FIRST ENTRY IN * * APLTAB-BLOCK * * A2=BLOCK TYPE T/C/U/S, OR 0 IF * * END OF CONFIGURATION-DATA * * A11=START OF CONF. FOR SPECIFIED * * APPLICATION * * APPLNO=APPLNO+1 IF APPLICATION * * IS FOUND * * ELSE APPLNO IS UNCHANGED * * CONSTA=START OF CONF.DATA * * COND.REG.=0 IF NO MORE APPL. OF * * CURRENT TYPE LEFT * * * * WORK REGISTERS : A1-A4,A11 * * * ******************************************** GETAPP EQU * * INITIATE REGISTERS AND INCREMENT APPLNO LD A3,APLTAB+STKCOM APLTAB ADDRESS ADK A3,2 FIRST APLTAB-BLOCK ADDRESS LDK A4,0 CLEAR APPL.COUNTER OF CURRENT APPL.TYPE LDK A2,0 CLEAR APPL.COUNTER OF ALL APPL.TYPES * FIND RIGHT APLTAB-BLOCK FOR SPECIFIED APPLICATION GTA100 EQU * ADK A2,1 INCREMENT APPL.COUNTER OF ALL APPL.TYPES CW* A2,APLTAB+STKCOM ANY APPLICATION LEFT? RF(NG) GTA150 YES! SUR A2,A2 A2=0 AND COND.REG.=0 RF GTA900 LEAVE SUBRUTIN GTA150 EQU * CW A1,APLTYP,A3 RIGHT APPL.TYPE? RF(E) GTA200 YES! ADK A3,ACBLEN UPDATE APLTAB-BLOCK ADDRESS RB GTA100 SHECK NEXT APLTAB-BLOCK GTA200 EQU * CW A4,APPLNO+STKCOM RIGHT APPL.NUMBER OF CURRENT APPL.TYPE? RF(E) GTA300 YES! ADK A4,1 INCREMENT APPL.COUNTER OF CURRENT APPL.TYPE ADK A3,ACBLEN UPDATE APLTAB-BLOCK ADDRESS RB GTA100 SHECK NEXT APLTAB-BLOCK GTA300 EQU * IFT MMUPAG=1 * GET MMU-TABLE FROM TTAB OF CURRENT TASK LD* A4,APLMMC,A3 GET TCTAB-ENTRY FOR CURRENT TASK ADKL A4,TTB:MT ADDRESS TO 1:ST MMU-TABLE ENTRY IN TTAB TLR A4 LOAD MMU-TABLE TS MMTAB,A13 STORE MMU-TABLE IN MMTAB XIF * FIND CONFIGURATION-DATA FOR SPECIFIED APPLICATION LDK A4,0 CLEAR APPL.COUNTER OF ALL APPL.TYPES LDR A1,A3 LOAD APLTAB-BLOCK ADDRESS TO OUTPUT REGISTER LD A11,CONSTA+STKCOM GET START OF CONF.DATA ADK A4,1 INCREMENT APPL.COUNTER OF ALL APPL.TYPES CWR A2,A4 IS IT THE FIRST APPLICATION RF(E) GTA800 YES! GTA400 EQU * LDK A3,0 CLEAR REGISTER LCR A3,A11 GET CHAR. FROM CONF.DATA ADKL A11,1 INCREMENT CONF.DATA POINTER CCK A3,/FFFF IS CONF.DATA CHAR. /FF? RB(NE) GTA400 NO! ADK A4,1 INCREMENT APPL.COUNTER OF ALL APL.TYPES CWR A2,A4 RIGHT APPL.NUMBER OF ALL APPL.TYPES? RB(NE) GTA400 NO! * LOAD REGISTER A2 WITH ITS OUTPUT VALUE,REPLACE * PSW OF CALLING PROGRAM TO PSW OF THIS * SUBRUTIN,AND RETURN FROM SUBRUTIN GTA800 EQU * IM APPLNO+STKCOM INCREMENT APPL.NUMBER OF CURRENT APPL.TYPE LDK A2,0 CLEAR REGISTER LCR A2,A11 GET CHAR FROM CONF.DATA LDK A4,1 MAKE COND.REG.TO BE NOT EQUAL TO 0 GTA900 EQU * CFI A14,PSW,A13 REPLACE PSW RTN A14 RETURN FROM SUBRUTIN EJECT ** C O N V R T ** ** ** ** ** ** CONVERSION OF TWO ASCII-DIGITS TO BINARY ** ** ** ** INPUT : A5=ASCII DIGITS ** ** OUTPUT: A1=BINARY RESULT ** ** WORK.REGS: A3,A2 ** ************************************************** CONVRT EQU * LDK A1,0 CLEAR RESULT REG LDR A3,A5 SRL A3,8 GET TEN'S SUK A3,/30 ADR A1,A3 LDR A2,A1 MULT BY 10 ADR A1,A1 . SLL A2,3 . ADR A1,A2 .... LDR A3,A5 ANK A3,/F GET ONE'S ADR A1,A3 RTN A14 EJECT ** N X T B L K ** ** ** ** ** ** SKIP TO NEXT BLOCK IN CONFIGURATION FILE ** ** ** ** INPUT: A11=ADDRESS TO CURRENT BLOCK-START ** ** OUTPUT:A11=ADDRESS TO NEXT BLOCK ** ** A2=BLOCK TYPE (T,C,U) IN RIGTH BYTE ** ** WORKREGS: A1,A3-A5 ** ************************************************** NXTBLK EQU * ADKL A11,TDBNC NUMBER OF TERMINAL DEVICE CLASSES NXTCOM EQU * ENTRY: SKIP TO NEXT COMMON-BLOCK LCR A5,A11 SLL A5,8 LC A5,1,A11 CALL CONVRT LDK A2,TDBREC LDR A3,A1 CALL MULT ADR A11,A3 ADKL A11,2 LCR A5,A11 GET NUMBER OF SPEC, DEV. CLASSES SLL A5,8 LC A5,1,A11 CALL CONVRT LDK A2,SDC SPEC. DEV. CL. RECORD LENGTH LDR A3,A1 CALL MULT ADR A11,A3 A11=NEXT BLOCK ADKL A11,2 LC A2,TDBBT,A11 GET BLOCK TYPE RTN A14 EJECT ** G E T N U M ** ** ** ** ** ** CONVERT 3 ASCII-DIGITS TO BINARY ** ** ** ** INPUT : A6=ADDRESS TO FIRST ASCII-CHARACTER ** ** OUTPUT: A5=BINARY VALUE ** ** WORK.REGS: A2,A4 ** **************************************************** GETNUM EQU * LDK A4,100 FIRST INCREMENT LDK A5,0 CLEAR RESULT REG SUK A6,1 INIT POINTER GET030 ADK A6,1 NEXT DIGIT LCR A2,A6 GET CHAR ANK A2,/F GET050 SUK A2,1 RF(N) GET100 THIS DIGIT READY ADR A5,A4 ACCUMULATE RB GET050 GET100 SUK A4,90 NEXT INCREMENT (TEN'S) RB(P) GET030 ADK A4,81 NEXT INCREMENT (ONE'S) RB(P) GET030 THIRD DIGIT RTN A14 EJECT ** Q U E J O B ** ** ** ** ** ** QUEUE TASK VIA 'ACTOT' AND SWITCH TO LEVEL ** ** 0, ENB. ** ** ** ** INPUT: A12=T:D-ADDRESS ** A5=TTAB-ADDRESS ** *************************************************** QUEJOB EQU * * QUEUE THIS TASK (THIS TID) LDKL A3,RETUR GET RETURN (FROM A15) ADDRESS ADR A3,A13 RELOCATE STR A3,A15 PUT ON STACK LDKL A3,/00C0 SET LEVEL 0 AND ENABLE STR A3,A15 PSW CF A15,SAVE8 SAVE 8 REGS LDK A7,0 CLEAR ABORT INDICATOR IFT MMUPAG=0 LD A4,WATLEN,A12 NUMBER OF WAT-ELEMENTS ADK A4,2 ANKL A4,/FFFE ADK A4,DWBFST+4 ADR A4,A12 ADD T:A-ADDRESS => START OF START-POINTS LDR* A6,A4 NUMBER OF START POINTS GETT30 SUK A6,1 DEC. NUMBER OF STARTPOINTS RF(N) GETT40 ALL! LD A1,4,A4 DISP ADDRESS LD A3,2,A4 SEGMENT NUMBER XIF IFT MMUPAG=1 EL A4,WATLEN,A12 NUMBER OF WAT-ELEMENTS ADK A4,2 ANKL A4,/FFFE ADK A4,DWBFST+4 ADR A4,A12 ADD T:A-ADDRESS => START OF START-POINTS ELR A6,A4 NUMBER OF START-POINTS GETT30 SUK A6,1 DEC. NUMBER OF STARTPOINTS RF(N) GETT40 ALL! EL A1,4,A4 DISP ADDRESS EL A3,2,A4 SEGMENT NUMBER XIF CF A15,ACTOT ADK A4,STPREC NEXT START-POINT RB GETT30 GETT40 ABL RETUR8 RELOAD 8 REGS RETUR EQU *-REL RTN A14 EJECT ** M O V M M T ** ** ** ** ** ** MOVE MM-TABLE ** ** ** ** INPUT :A2=TTAB-ADDRESS ** ** MMTAB HOLDS TABLE TO MOVE ** ** OUTPUT:A2=START OF MM-TABLE IN TTAB ** ** A9=TTAB ADDRESS ** ** WORKREGS:A1,A3 ** *********************************************** MOVMMT EQU * IFT MMUPAG=1 ADKL A2,MMBEG GET TO-TABLE ADDRESS TL MMTAB,A13 LOAD FROM-TABLE TSR A2 MOVE LDR A3,A2 CALL MMENT FILL LAST ENTRY ADDRESS TL* MMFROM+STKCOM RELOAD TABLE RTN A14 XIF EJECT SYSINI EQU * START OF SYSTEM INITIALIZATION IFT DSKPAG-MMUPAG=1 * * INITIATE DYNAMIC CORE FOR COBOL * LD A2,SCTOPT GET OPTION WORD ANKL A2,/2000 ANY COBOL APPL? RF(Z) PBSEND NO! LD A8,DYNSTA+STKCOM GET START OF DYNTAB:S LDR* A2,A8 GET NUMBER OF DYNTAB:S ADKL A8,2 INCREMENT DYNTAB POINTER INDY05 EQU * LDR* A3,A8 GET DYNTAB LENGTH (BYTES) INDY10 EQU * ADKL A8,2 INCREMENT DYNTAB POINTER LDR* A7,A8 GET SPL-PBS ADR LDR A6,A13 ADKL A6,PBSTAB CONSTANT-TABLE ADDRESS SUK A3,2 END OF DYNTAB RF(Z) INDY50 YES! INDY20 EQU * LDR* A5,A6 GET NUMBER OF COPIES CWK A5,/FFFF END OF TABLE? RF(E) INDY40 YES! LD A4,2,A6 GET WORD TO COPY ADK A6,4 ADJUST PBSTAB INDY30 EQU * SUK A5,1 DECREMENT NBR.OF COPIES RB(N) INDY20 ALL DONE FOR THIS CHARACTER STR A4,A7 STORE CHARACTER IN SPL-PBS ADK A7,2 STEP SPL-PBS POINTER RB INDY30 NEXT WORD INDY40 EQU * LDR* A4,A8 SPL-PBS ADR LDKL A5,STKMAX STACK-SIZE ST A5,SPLSTS,A4 STORE IN SPL-PBS LDKL A7,ENTFIN ENTRY-FINI (ADDRESS) ST A7,SPLENT,A4 STORE IN SPL-PBS LDR A6,A4 SPL-PBS ADDR ADK A6,SPLSTA POINT AT STACK AREA ADR A5,A6 +STACK AREA ADDR ST A5,SPLSTB,A4 STORE IN SPL-PBS STACK-BASE RB INDY10 INDY50 EQU * SUK A2,1 ANY DYNTAB:S LEFT? RB(NZ) INDY05 YES! RF PBSEND NO! EJECT ************************************************** ** ** ** EACH WORD IN THIS TABLE CONSISTS OF: ** ** WORD1=COUNTER,NBR OF COPIES OF NEXT WORD ** ** WORD2=WORD ** ** ** ** BYTE1 (COUNTER)=/FF MEANS END OF TABLE ** ** ** ************************************************** PBSTAB EQU *-REL DATA 1 TERMINATION-CODE DATA 0 DATA 1 STACK-USED DATA /6 DATA 1 STACK-SIZE DATA 0 DATA 3 PROCEDURE-NAME DATA /2020 DATA 20 PGM-DATA UNTIL STACK-BASE DATA 0 DATA 1 STACK-BASE DATA 0 DATA 1 ENTRY-FINI DATA 0 DATA 16 LAST-TS,RUNTIME-WORK-AREA DATA 0 DATA /FFFF E N D O F T A B L E PBSEND EQU * XIF IFF MMUPAG+DSKPAG=0 * * RESERVE PAGES IN MEMORY AND BUILD PAGE TABLE * PAGGEN EQU * LDKL A2,PAGEX EXIT ADDRESS ADR A2,A13 RELOCATE LD A1,STKCOM+TOTSGM ANY SEGMENTS IN APPLICATION? ABR(Z) A2 NO! LD A1,SCTOPT GET OPTION WORD ANK A1,3 PAGING? ABR(Z) A2 NO! * * RESERV SPACE FOR PAGE BLOCKS CORRESPONDING TO CORE RESIDENT SEGMENTS * LD A11,SCTSFA GET START OF FREE AREA ST A11,SCTPAG STORE IN SYSTAB LDR A8,A13 GET RELOCATION BASE ADKL A8,INI70-REL LIMIT FOR PAGE TABLE LDK A7,0 RESET PAGE COUNTER PAG:10 EQU * CW A7,SCTNOP EQUAL TO NUMBER OF PAGES? RF(E) PAG:30 YES! LDK A1,0 RESET NUMBER OF WORDS PAG:20 EQU * ADKL A11,2 INCLUDE NEXT WORD RF(Z) MEMOFL MEMORY OVERFLOW (64 KB LIMIT) ADK A1,1 INCREMENT WORD COUNTER CWK A1,4 4 WORDS RESERVED? RF(E) PAG:25 YES! CWR A11,A8 CHECK PROGRAM OVERWRITE RF(E) MEMOFL MEMORY OVERFLOW! RB PAG:20 PAG:25 ADK A7,1 INCREMENT PAGE BLOCK COUNTER RB PAG:10 PAG:30 EQU * * * RESERV MEMORY PAGES IN UNUSED PART OF MEMORY * AND EXTEND PAGE TABLE WITH CORRESPONDING NUMBER * OF PAGE BLOCKS. * XIF IFT MMUPAG=1 LD A1,STKCOM+FYSPAG GET PHYSICAL PAGE LD A2,STKCOM+LSTADR GET LAST LOGICAL ADDRESS ANKL A2,/FFF GET DISPLACEMENT SRL A2,2 SKIP TWO RIGHTMOST BITS ORR A1,A2 16 BITS PHYSICAL PAGE ADDRESS LDR A3,A1 SAVE LD A2,SCTPSZ GET PAGE SIZE SRL A2,2 SKIP TWO RIGHTMOST BITS LDR A10,A2 SAVE ANKL A1,/FC00 MAKE EVEN 4K-MULTIPLE ADDRESS ANKL A2,/0300 MODIFY FOR PAGE SIZE ANR A2,A3 EVEN 1-KB LIMIT ORR A1,A2 MODIFY PAGE ADDRESS LIMIT XIF IFT DSKPAG-MMUPAG=1 LD A1,LSTADR+STKCOM GET PHYSICAL LAST ADDRESS LD A10,SCTPSZ PAGE SIZE XIF IFF MMUPAG+DSKPAG=0 LDR A9,A1 INIT PAGE ADDRESS LDR A6,A9 SAVE PAG:31 EQU * ST A11,SCTSFA UPDATE START OF FREE AREA TNM A6,A10 RF(NN) PAG:32 CWR A10,A6 RF PAG:33 PAG:32 CWR A6,A10 PAG:33 RF(NG) PAG:40 SUR A6,A10 COMPUTE ADDRESS TO NEXT PAGE LDR A1,A6 GET PAGE ADDRESS IFT MMUPAG=1 ANKL A1,/C000 ADDRESS IN SYSTEM AREA? RF(NZ) PAG:34 NO! LDR A1,A6 PHYSICAL ADDRESS IN SYSTEM AREA SLL A1,2 ABSOLUTE ADDRESS IN SYSTEM AREA RF PAG:36 PAG:34 LDK A1,0 END OF FREE AREA XIF IFF MMUPAG+DSKPAG=0 PAG:36 LDK A2,0 RESET WORD COUNTER PAG:38 CWR A11,A8 CHECK PROGRAM OVERWRITE RF(E) PAG:40 NO MORE MEMORY AVALIABLE ADKL A11,2 INCR. PAGBLK POINTER ADK A2,1 INCREMENT WORD COUNTER CWK A2,4 BLOCK COMPLETE? RF(E) PAG:45 YES! LDR A1,A1 ADDRESS IN SYSTEM AREA? RB(Z) PAG:38 NO! TNM A11,A1 32-KB LIMIT CHECK RF(NN) PAG382 CWR A11,A1 RF PAG384 PAG382 CWR A1,A11 PAG384 RB(G) PAG:38 MORE MEMORY AVALIABLE PAG:40 EQU * ADK A7,0 ANY PAGES RESERVED? RF(Z) MEMOFL NO! CW A7,SCTNOP ONLY PAGES FOR CORE RESIDENT PAGES? RF(G) PAG:50 NO! CW A7,STKCOM+TOTSGM ONLY CORE RESIDENT SEGMENTS IN APPLICATION? RF(E) PAG:50 YES! MEMOFL LDKL A1,LMP3 OTR A1,0,SOP INDICATE MEMORY OVERFLOW HLT HALT PROGRAM PAG:45 CW A7,STKCOM+TOTSGM ONE PAGE/SEGMENT ALLOCATED? CW A7,STKCOM+TOTSGM MORE PAGES WANTED? RF(E) PAG:50 YES! ADK A7,1 INCREMENT PAGE COUNTER LDR A9,A6 SAVE PAGE ADDRESS RB PAG:31 PAG:50 EQU * ST A7,SCTNOP SAVE NUMBER OF PAGES LDR A1,A9 GET ADDRESS TO FIRST PAGE LDR A2,A1 SAVE IFT MMUPAG=1 SRL A1,14 BIT 0-1 OF 18-BITS ADDRESS ST A1,SCTEFA SAVE SLL A2,2 GET BITS 2-15 OF 18-BITS ADDRESS XIF IFF MMUPAG+DSKPAG=0 ST A2,SCTEFA+2 SAVE EJECT PAGEX EQU *-REL XIF LD A12,SCTPAG GET PAGE TABLE ADDRESS LD A7,STKCOM+APLTAB GET START OF ACB:S LDR* A4,A7 GET NUMBER OF APPLICATIONS INI10 LD* A3,APLMMC+2,A7 GET TTAB ADDRESS IFF MMUPAG+DSKPAG=0 LD A11,TTB:SP,A3 GET SEGMENT TABLE ADDRESS RF(Z) INI40 NO SEGMENT TABLE LD A6,SEG:NS,A11 GET NUMBER OF SEGMENTS RF(Z) INI40 NO SEGMENTS! XIF IFT MMUPAG=1 LD A1,APLNPE+2,A7 GET DISPL WITHIN 4K PAGE SRL A1,2 SKIP TWO RIGHTMOST BITS OR A1,APLSEG+2,A7 MERGE WITH PHYSICL 4K PAGE ADDRESS XIF IFT DSKPAG-MMUPAG=1 LD A1,APLSEG+2,A7 GET PHYSICAL 4K PAGE ADDRESS SLL A1,2 MULTIPLY BY 4 OR A1,APLNPE+2,A7 MERGE WITH DISPL WITHIN 4K PAGE XIF IFF MMUPAG+DSKPAG=0 INI20 EQU * * * INITIALIZE PAGE BLOCK FOR CORE RESIDENT SEGMENTS * AND STORE PAGE BLOCK ADDRESSES IN SEGMENT BLOCKS * ADKL A11,8 NEXT SEGMENT BLOCK LDR* A2,A11 GET STATUS RF(NN) INI30 SEGMENT NOT LOADED IN CORE ST A12,6,A11 STORE PAGE BLOCK ADDRESS CMR A12 RESET QUEUE POINTER FORWARD CM 2,A12 RESET QUEUE POINTER BACKWARD ST A1,4,A12 STORE PAGE ADDRESS ST A11,6,A12 STORE SEGMENT BLOCK ADDRESS LD A2,APLPSZ+2,A7 GET SEGMENT SIZE =1 XIF =2 IFT MMUPAG=1 =2 SRL A2,2 =1 XIF =2 IFF MMUPAG+DSKPAG=0 =2 ADR A1,A2 ADDRESS TO NEXT PAGE =1 ADKL A12,8 NEXT PAGE BLOCK INI30 SUK A6,1 DECR. SEGMENT BLOCK COUNTER RB(P) INI20 INI40 EQU * XIF IFT MMUPAG+DSKPAG=0 * * SAVE START OF DYNTAB:S IN SYSINI (STADYN) * BEFORE ENABLE IS SET BECAUSE INTERUPT * CAN DESTROY DYNSTA IN A15-STACK * LD A1,DYNSTA+STKCOM GET START OF DYNTAB:S ST A1,SAVDYN,A13 SAVE IN SYSINI (STADYN) XIF * * CHECK APPLICATION TYPE AND QUEUE FIRST TASK * FOR EACH ASSEMBLER APPLICATION * LD A1,APLMMP+2,A7 GET APPLICATION TYPE CWK A1,'AS' ASSEMBLER APPLICATION? RF(NE) INI50 NO * * SWITCH TO LEVEL 0 & ENABLE * LDKL A1,INI45 RETURN ADDRESS ADR A1,A13 RELOCATE STR A1,A15 STORE ON STACK LDKL A1,/00C0 PSW STR A1,A15 STORE ON STACK RTN A15 SWITCH INI45 EQU *-REL LD* A5,APLMMC+2,A7 GET TTAB ADDRESS LD A2,APLSTA+2,A7 GET START ADDRESS AD A2,APLREL+2,A7 RELOCATE LDK A3,0 SEGMENT NUMBER CF A15,ACTOT QUEUE TASK EJECT INI50 EQU * IFT MMUPAG=1 LD A1,APLLAP+2,A7 GET LOGICAL PAGE ADDRESS RF(NZ) INI55 NO PAGE ENTRIES RESERVED XIF CM APLNPE+2,A7 CLEAR NUMBER OF PAGE ENTRIES CM APLMMP+2,A7 CLEAR DISPL. TO PAGE ENTRY IFT MMUPAG=1 RF INI60 INI55 EQU * SRL A1,12 PAGE ENTRY NUMBER LDK A2,16 NUMBER OF MMU ENTRIES SUR A2,A1 NUMBER OF PAGE ENTRIES ST A2,APLNPE+2,A7 SAVE SLL A1,1 MULTIPLY BY 2 ADKL A1,TTB:MT DISPL TO FIRST PAGE ENTRY ST A1,APLMMP+2,A7 SAVE INI60 LD A1,APLLAC+2,A7 GET LOGICAL ADDR. TO COMMON PART SRL A1,11 ENTRY NUMBER ANK A1,/1E 2*ENTRY NUMBER ADKL A1,TTB:MT DISPL TO FIRST COMMON PART ENTRY ST A1,APLMMC+2,A7 SAVE XIF ADK A7,ACBLEN NEXT ACB SUK A4,1 MORE APPLICATIONS? RB(P) INI10 YES IFF MMUPAG+DSKPAG=0 * * INITIATE PAGE BLOCK FOR FREE PAGES AND LINK TO PAGQUE * LDR A12,A12 ANY PAGES? RF(Z) INI90 NO! CW A12,SCTSFA ANY FREE BLOCKS? RF(E) INI90 NO! ST A12,PAGQUE POINTER TO FIRST FREE PAGE BLOCK LDKL A11,PAGQUE POINTER TO PAGQUE LDR A1,A12 SAVE ADDRESS TO FIRST PAGE BLOCK LDK A2,0 INI70 ST A11,2,A12 STORE BACKWARD POINTER ST A9,4,A12 STORE PAGE ADDRESS ST A2,6,A12 INDICATE PAGE FREE ADK A1,8 ADDRESS NEXT PAGE BLOCK CW A1,SCTSFA LAST PAGE BLOCK? RF(E) INI80 YES! LDR A11,A12 SAVE ADDRESS TO PAGE BLOCK STR A1,A12 STORE FORWARD POINTER LDR A12,A1 NEXT PAGE BLOCK ADR A9,A10 NEXT PAGE RB INI70 INI80 EQU * LDKL A1,PAGQUE POINTER TO PAGQUE STR A1,A12 STORE IN LAST BLOCK ST A12,PAGQUE+2 STORE IN PAGQUE+2 INI90 EQU * EJECT XIF * START BUGGER (IF ANY) * GET APPLICATION START LD A14,STKCOM+APLTAB GET START OF ACB:S LD A14,APLREL+2,A14 GET RELOCATION BASE ADKL A13,INI100 CONTINUATION ADDRESS LDK A1,0 INDICATE SYSLOAD ENDED OTR A1,0,SOP LD A1,SCTBUG GET BUGGER ADDRESS ABR(NZ) A1 INI100 EQU *-REL LDR A13,P INI110 EQU *-REL SUKL A13,INI110 RESTORE PROGRAM BASE OINTER * * INIT A15 STACK * LD A15,SCTSTB SUKL A15,4 * START APPLICATION LD A1,IHRTC GET INTERRUPT ADDRESS FOR RTC ST A1,SAVRTC,A13 SAVE LDKL A1,IHRTCO LOAD TEMPORARY INTERRUPT ADDRESS ADR A1,A13 RELOCATE ST A1,IHRTC STORE IN INTERRUPT VECTOR CF A15,PFINIT INITIALIZE DEVICES CF A15,SAVE8 SAVE REGISTERS CF A15,SWL48 SWITCH TO LEVEL 48 * * WAIT APPROXIMATELY 0.62 SECONDS BEFORE BRANCHING TO DISPATCHER * LDKL A1,/FFFF SET COUNTER DELAY SRC A2,31 SUK A1,1 RB(NZ) DELAY INH LDKL A1,0 GET RTC INTERRUPT ADDRESS SAVRTC EQU *-REL-2 ST A1,IHRTC RESTORE LDR A1,A13 GET START OF SYSINI ADKL A1,INISTA START OF INIT. INSTR. SEQ. ADKL A13,INILEN END OF INIT. INSTR. SEQ. LDKL A2,STKEND START OF A15-STACK INI150 LDR* A3,A1 GET MEMORY WORD STR A3,A2 STORE IN A15-STACK ADK A1,2 INCREMENT FROM-ADDRESS ADK A2,2 INCREMENT TO-ADDRESS CWR A1,A13 ALL WORDS MOVED? ABL(E) STKEND YES RB INI150 * * TEMPORARY INTERRUPT ROUTINE FOR RTC * IHRTCO EQU *-REL RIT RTCDA RTN A15 INISTA EQU *-REL IFT MMUPAG+DSKPAG=0 * * INITIATE DYNAMIC CORE FOR COBOL * APPLICATIONS AND BRANCH TO DISPATCHER * INDY00 EQU * LD A2,SCTOPT GET OPTION WORD ANKL A2,/2000 ANY COBOL APPL? RF(Z) PBSEND NO! LDKL A2,STKEND LD A8,STADYN,A2 GET START OF DYNTAB:S RF(Z) PBSEND NO COBOL APPL. LOADED LDR* A2,A8 GET NUMBER OF DYNTAB:S ADKL A8,2 INCREMENT DYNTAB POINTER INDY05 EQU * LDR* A3,A8 GET DYNTAB LENGTH (BYTES) INDY10 EQU * ADKL A8,2 INCREMENT DYNTAB POINTER LDR* A7,A8 GET SPL-PBS ADR LDKL A6,STKEND START OF INIT.INSTR.SEQ. ADKL A6,PBSTAB CONSTANT-TABLE ADDRESS SUK A3,2 END OF DYNTAB RF(Z) INDY50 YES! INDY20 EQU * LDR* A5,A6 GET NUMBER OF COPIES CWK A5,/FFFF END OF TABLE? RF(E) INDY40 YES! LD A4,2,A6 GET WORD TO COPY ADK A6,4 ADJUST PBSTAB INDY30 EQU * SUK A5,1 DECREMENT NBR.OF COPIES RB(N) INDY20 ALL DONE FOR THIS CHARACTER STR A4,A7 STORE CHARACTER IN SPL-PBS ADK A7,2 STEP SPL-PBS POINTER RB INDY30 NEXT WORD INDY40 EQU * LDR* A4,A8 SPL-PBS ADR LDKL A5,STKMAX STACK-SIZE ST A5,SPLSTS,A4 STORE IN SPL-PBS LDKL A7,ENTFIN ENTRY-FINI (ADDRESS) ST A7,SPLENT,A4 STORE IN SPL-PBS LDR A6,A4 SPL-PBS ADDR ADK A6,SPLSTA POINT AT STACK AREA ADR A5,A6 +STACK AREA ADDR ST A5,SPLSTB,A4 STORE IN SPL-PBS STACK-BASE RB INDY10 INDY50 EQU * SUK A2,1 ANY DYNTAB:S LEFT? RB(NZ) INDY05 YES! RF PBSEND NO! SAVDYN EQU *-REL STADYN EQU *-INDY00 DATA 0 SAVE AREA FOR DYNSTA EJECT ************************************************** ** ** ** EACH WORD IN THIS TABLE CONSISTS OF: ** ** WORD1=COUNTER,NBR OF COPIES OF NEXT WORD ** ** WORD2=WORD ** ** ** ** BYTE1 (COUNTER)=/FF MEANS END OF TABLE ** ** ** ************************************************** PBSTAB EQU *-INDY00 DATA 1 TERMINATION-CODE DATA 0 DATA 1 STACK-USED DATA /6 DATA 1 STACK-SIZE DATA 0 DATA 3 PROCEDURE-NAME DATA /2020 DATA 20 PGM-DATA UNTIL STACK-BASE DATA 0 DATA 1 STACK-BASE DATA 0 DATA 1 ENTRY-FINI DATA 0 DATA 16 LAST-TS,RUNTIME-WORK-AREA DATA 0 DATA /FFFF E N D O F T A B L E PBSEND EQU * XIF ABL TDISP INILEN EQU *-REL PROGRAM LENGTH INIEND EQU * END