ASMB,R,L,Z,C *USE 'ASMB,R,N' (RTE-M I/RTE-M II) OR 'ASMB,R,Z' (RTE-M III) IFN * BEGIN NON-DMS CODE *************** NAM APLDR,1,40 91740-16017 REV 1840 780721 *** END NON-DMS CODE *************** XIF IFZ ***** BEGIN DMS CODE *************** NAM APLDR,1,40 91740-16018 REV 1840 780721 ******* END DMS CODE *************** XIF UNL IFN HED APLDR (M2) 91740-16017 REV 1840 780721 (C) HEWLETT-PACKARD CO. XIF IFZ HED APLDR (M3) 91740-16018 REV 1840 780721 (C) HEWLETT-PACKARD CO. XIF LST * * IFN OPTION * NAME: APLDR * SOURCE: 91740-18017 * RELOC: 91740-16017 * PROGMR: EJW,CHW * * IFZ OPTION * NAME : APLDR * SOURCE: 91740-18018 * RELOC: 91740-16018 * PROGMR: EJW,CHW * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * SPC 1 EXT $LIBR,$LIBX,EXEC EXT $CVT3,$CON,PRTN,IMESS EXT DOPEN,DREAD,DLOCF,DCLOS,DEXEC EXT #LNOD,#CNOD,#NCNT SPC 1 IFN * BEGIN NON-DMS CODE *************** EXT .MVW *** END NON-DMS CODE *************** XIF IFZ ***** BEGIN DMS CODE *************** EXT $MATA,$ENDS ******* END DMS CODE *************** XIF SPC 1 * A EQU 0 B EQU 1 KEYWD EQU 1657B BPA1 EQU 1742B BPA2 EQU 1743B RTORG EQU 1746B RTCOM EQU 1747B AVMEM EQU 1751B BKLWA EQU 1777B SUP * * * APLDR IS SCHEDULED BY THE SYSTEM WHEN OPERATOR INPUTS * ONE OF THE FOLLOWING: * PL,LU#,OPT * (1)(0) * LO,PNAME,SC,DRN-LU,PTTN#,SIZE * LU# * (4) (0) (0) (0) (0) * * APLDR IS SCHEDULED WITH THE FOLLOWING PARAMETERS: * P1 - REMOTE SCHEDULE[15]/ LU[4:9]/ FUNC[0:3] * P2 - #PAGES[10:14] / PTTN#[0:5] OR LIST OPTION * P3 - CHAR1[8:15] / CHAR2[0:7] (OR LU) * P4 - CHAR3[8:15] / CHAR4[0:7] * P5 - CHAR5[8:15] / CHAR6[0:7] * * WHERE FUNCTION CODE IS: * 0 - PROGRAM LIST * 1 - LOAD PROGRAM INTO MEMORY RESIDENT AREA * 2 - LOAD PROGRAM INTO A PARTITION * 3 - SAME AS #1 FROM REMOTE CPU * 4 - SAME AS #2 FROM REMOTE CPU SKP APLDR NOP LDA DPARM GET ADDR OF BUFFER STA TEMP1 SAVE TEMPORARILY LDA MD5 STA TEMP2 RMPLP LDA B,I GET PARAM FROM ID SEG STA TEMP1,I SAVE IN BUFFER INB ISZ TEMP1 ISZ TEMP2 JMP RMPLP * ADB D20 INDEX TO WORD 27 STB DFSC SAVE ADDR OF SECURITY CODE INB LDB 1,I GET CART.REF./ NEG.LU STB ICR SAVE IN 2 WORD ICR PARAMETER CLA STA ERTYP INITIALIZE ERROR INDICATOR LDA $CON,I GET CONSOLE LU AND B77 STA 1 LDA ERLUF RAL,CLE,ERA E=1 IF REMOTE SCHEDULE ALF,ALF ALF AND B77 SZA,RSS LIST LU SPECIFIED? LDA 1 NO, USE CONSOLE STA LU SAVE LU FOR LISTING IOR B400 STA RDLU CCB,SEZ SKIP IF LOCALLY SCHEDULED LDB #CNOD GET ORIGIN NODE FOR LIST STB LNODE SAVE LIST NODE * * LDA ERLUF GET FUNCTION FROM BITS 0-3 AND B17 STA FUNC SZA,RSS IS IT LIST? 0 JMP LIST * LDB #LNOD SEZ JMP LODCK JUMP IF REMOTELY SCHEDULED * LDB #NCNT SZB ANY DS-1000 NODES INITIALIZED? JMP CVNOD YES, ASK FOR LOAD NODE CCB NO, INDICATE LOCAL NODE JMP LODCK * CVNOD JSB IMESS ASK "LOAD FILE'S NODE?" DEF *+4 DEF D2 DEF QUEST DEF D10 * JSB IMESS GET RESPONSE DEF *+4 DEF D1 DEF ABSBF DEF MD5 * CMB,INB,SZB,RSS JMP CVNOD UNKNOWN RESPONSE STB TEMP1 SAVE BYTE COUNT CLA STA NODE LDB DABS RBL BYTE POINTER LBT GET FIRST CHAR. STA TEMP2 SAVE IT CPA ASCNG ="-"? LDA D48 YES CVNO1 ADA N58 SSA,RSS VALID NUMERIC? JMP CVNOD NO, RE-ASK QUESTION ADA D10 A HAS NUMERIC VALUE OF CHARACTER SSA VALID NUMERIC? JMP CVNOD NO, RE-ASK QUESTION ADA NODE ACCUMULATE NODAL ADDRESS ISZ TEMP1 MORE CHARACTERS? RSS YES JMP CVNO2 NO STB TEMP3 SAVE BYTE ADDRESS MPY D10 ACCUMULATED VALUE * 10 STA NODE LDB TEMP3 GET BYTE ADDRESS LBT GET NEXT CHARACTER JMP CVNO1 CVNO2 LDB TEMP2 CPB ASCNG 1ST = "-"? CMA,INA YES, NEGATE VALUE LDB 0 LDA FUNC * ENTER FOLLOWING CODE WITH FILE'S NODE IN B REGISTER LODCK CPA D1 IS IT A MEMORY RESIDENT LOAD? JMP LOAD IFZ ***** BEGIN DMS CODE ************** CPA D2 IS IT PARTITION LOAD? JMP LOAD ***** END DMS CODE ************** XIF * UNL * EXT DBUG *** DEBUGGING *** * JSB DBUG *** DEBUGGING *** * DEF *+1 *** DEBUGGING *** * NOP *** DEBUGGING *** NOP *** DEBUGGING *** LST * LDB MD64 FUNCTION CODE ERROR JMP ERSET ERROR * DPARM DEF ERLUF MD5 DEC -5 B77 OCT 77 B2300 OCT 2300 OPT OCT 2310 B400 OCT 400 D3 OCT 3 D20 DEC 20 D48 DEC 48 AN ASCII "0" N58 DEC -58 ASCNG OCT 55 NEG SIGN RDLU NOP FUNC NOP FUNCTION CODE LNODE NOP NODE FOR LIST OUTPUT ICR BSS 2 CR/NODE ARRAY NODE EQU ICR+1 FLFLG NOP FILE FLAG HED LO: LOAD PROGRAM * LOAD EQU * STB NODE SAVE NODE OF LOAD FILE SPC 1 IFZ ***** BEGIN DMS CODE *************** CLA STA PT#PG STA PTTN# ******* END DMS CODE *************** XIF SPC 1 JSB IHILO INIT HI,LO ADDRS LDA DWRD1 INIT SPEC REC STA WORD1 DUMMY ID ADDR. LDA DWRD2 STA WORD2 LDA RSS INITIALIZE SWITCH STA AB12D FOR SPEC. REC. CLA STA ABS12 STA ABSCT INDICATE NO ABS YET. * JSB STRID LOAD2 JSB SRCID FIND A BLANK DEF ZERO ID SEG. JMP LOADD NO BLANK ID SEG. JMP LOAD2 KEEP LOOKING. STA CURID GOT IT, SAVE ADDR. * LDA NAM12 GET FILE NAME. SZA,RSS GIVEN? LDA D4 NO, USE DEFAULT STA NAM12 SAVE FOR COMPARE STA FLFLG SET FILE FLAG AND B77 CPA NAM12 LEGAL LU? JMP STCNW YES. SET UP CONTROL WORD. LDB #NCNT IS THIS NODE INITIALIZED SZB FOR DS/1000 COMMUNICATIONS? JMP OPENF YES--GO OPEN FILE. JMP ABORT NO--ABORT. * STCNW IOR B2300 SET UP CONTROL WORD FOR STA CONWD BINARY ABSOLUTE DEXEC READS. CLB STB NAM12 CLEAR TO FORCE USE OF NAM RECORD NAME STB FLFLG CLEAR FILE FLAG. JMP NOTIN GO READ FROM LOCAL LU * OPENF JSB DOPEN OPEN THE ABS INPUT FILE DEF *+7 DEF DCB DEF ERR DEF NAM12 FILE NAME ADDR DEF OPT OPT = 2300B FOR ABS DFSC DEF * SECURITY CODE DEF ICR CR/NODE ARRAY SSA ANY ERRORS? JMP NOFIL NO SUCH FILE * JSB DLOCF GET FILE INFO DEF *+9 DEF DCB DEF ERR DEF TEMP1 DEF TEMP1 DEF TEMP1 DEF TEMP1 DEF TEMP1 DEF TEMP LDA TEMP SZA,RSS TYPE 0 FILE? STA NAM12 FORCE USE OF TRAILER RECORD SZA,RSS JMP ABS0 YES, SKIP DUP NAME CHECK NOW * JSB DUPID CHECK FOR DUPLICATE NAME DNM12 DEF NAM12 CHANGE TO ..NAME IF POSSIBLE * * READ AN ABSOLUTE RECORD * * ABS0 LDA FLFLG SZA IS INPUT FROM FILE? JMP READF YES, DO RFA READ * NOTIN JSB DEXEC NO--MAKE DEXEC CALLS. DEF *+6 DEF NODE DEF D1 DEF CONWD DEF ABSBF DEF D64 * AND B240 ISOLATE EOF/EOT BITS SZA EOF OR EOT? JMP LOAD5 YES JMP ABS0A NO, CONTINUE * READF JSB DREAD READ ABS RECORD DEF *+6 DEF DCB DEF ERR DABS DEF ABSBF DEF D64 DEF LEN LDB LEN CPB M1 EOF? JMP LOAD5 YES. SSA JMP ABSCK ANY ERROR, CHECKSUM ERROR * ABS0A LDA ABSCT GET WORD COUNT AND LHALF ALF,ALF SHIFT TO LOW BITS STA ABSSZ SAVE REC SIZE CMA,INA STA TEMP1 SAVE NEG COUNT LDA ABSAD GET ADDR, START CKSM. LDB DABSD ABS0B ADA 1,I ADD WORD TO RUNNING CKSUM INB ISZ TEMP1 BUMP COUNT JMP ABS0B REPEAT TIL DONE. * CPA 1,I COMPARE CKSMS JMP ABS1 MATCHES * ABSCK LDB ERR10 CHECKSUM ERROR- JMP ERPR4 ERR MSG THEN ABORT * NOFIL STA ERTYP RETURN ERROR CODE CMA,INA FMP ERROR CODE IN (A) LDB DABS GET DEF TO TEMP BUFFER JSB CVDEC CONVERT ERR CODE TO ASCII LDA LDASH IOR ABSAD FILL IN "- " STA ABSAD FOR " APLDR: -###" LDB DABS INB SET ADDR OF 4 CHARS LDA D2 JSB STUFP STUFF NAME & PRINT MESSAGE JMP ABORT ABORT APLDR * * FIND WHERE ABSOLUTE RECORD FITS IN CORE * * ABS1 LDA ABSAD LDB ABSCT CPB HI2 ONLY 2 WORDS IN REC? RSS JMP ABS1A NO, CHECK NORMAL RECORD CPA D2 IS IT SPECIAL RECORD? JMP ABS12 YES ABS1A AND BPMSK IS IT BASE PAGE? CPA ABSAD JMP ABS2 YES, BASE PAGE. * SPC 1 IFZ ***** BEGIN DMS CODE *************** LDA FUNC CPA D2 LOAD PTTN? JMP PTMN YES, SET BOUNDS FOR ADDR CHECKS * ******* END DMS CODE *************** XIF SPC 1 LDA RTORG GET DEFAULT LOWEST ADDR STA TEMP LDA AVMEM GET DEFAULT HIGHEST ADDR STA TEMP1 LDA DMAIN GET PTRS TO MAIN HI/LO LDB D22 SET OFFSET FOR MAIN JMP ABS3 ADDRS IN ID SEG. * ABS2 EQU * SPC 1 IFZ ***** BEGIN DMS CODE *************** LDA FUNC CPA D2 LOAD PTTN? JMP PTBP YES, SET BOUNDS FOR ADDR CHECKS * ******* END DMS CODE *************** XIF SPC 1 LDA BPA1 GET DEFAULT LOWEST ADDR STA TEMP LDA BPA2 GET DEFAULT HIGHEST ADDR INA STA TEMP1 LDA DBASE GET PTRS TO BASE HI/LO LDB D24 SET OFFSET FOR BASE PAGE * * * * FIND THE HI AND LO MEMORY BOUNDS OF FREE CORE * * ABS3 STB IDOFS SAVE OFFSET TO GET ADDRS STA TEMP4 SAVE ADDR OF LFREE ADA D2 STA TEMP5 SAVE ADDR OF HFREE LDA TEMP CMA,INA CHECK IF ABS REC < FWABP USER LINKS ADA ABSAD SSA JMP ABS14 ABS < FWABP, ERROR LDA ABSAD ADA ABSSZ CMA,INA CHECK IF ABS REC > LWAM USER SPACE ADA TEMP1 SSA JMP ABS14 ABS > LWAM, ERROR LDA TEMP4,I CPA TEMP RSS ADDRS ALREADY SET? JMP ABS6 YES, SKIP SEARCH FOR HI/LO * JSB STRID INIT ID SEARCH. ABS4 JSB SRCID SEARCH EACH ID DEF ZERO EXCEPT BLANK ONES, JMP ABS6 FOR THE HI/LO RSS RSS ADDRS WHICH JMP ABS4 DEFINE FREE CORE. CPA CURID IS THIS ID FOR PRG? JMP ABS4 YES, IGNORE THIS ID BOUNDS ADA IDOFS STA TEMP SET ADDR OF ID ADDR. * LDA B (B) STILL HAS ADDR OF NAME ADA D2 BUMP TO TYPE LDA A,I AND B17 GET TYPE FROM ID SEG CPA D1 MEMORY RESIDENT TYPE? RSS YES, CHECK ADDRS JMP ABS4 NO, IGNORE ID * CLA STA TEMP1 CLEAR OVERLAP FLAG * LDA TEMP,I GET ID LOW CMA,INA ADA ABSAD IS ID LOW > ABS REC? SSA JMP ABS4B LOW>ABS, CHECK MORE ISZ TEMP1 LOW<=ABS, CHECK IF OVERLAP JMP ABS5 BY CHECKING IF HI>=ABS * ABS4B LDA TEMP,I GET ID LOW AGAIN CMA SUBTRACT IT ADA TEMP5,I FROM LAST HFREE SSA AND JMP ABS5 IF IT IS LDA TEMP,I LOWER THEN KEEP IT DST TEMP5,I AS NEW HFREE * ABS5 ISZ TEMP LDA TEMP,I GET ID HIGH ADDR CMA,INA ADA ABSAD SSA,RSS ID HIGH < ADDR OF REC? JMP ABS5B HI<=ABS, CHECK MORE CLA,INA HI>ABS, MIGHT OVERLAP CPA TEMP1 DOES ABS OVERLAP? JMP ABS13 YES, GIVE OF ERR JMP ABS4 NO, IGNORE * ABS5B LDA TEMP,I GET ID HI CMA,INA SUBTRACT IT ADA TEMP4,I FROM LAST LFREE SSA,RSS AND IF IT IS JMP ABS4 LDA TEMP,I HIGHER, WE KEEP IT DST TEMP4,I AS NEW LFREE JMP ABS4 REPEAT FOR EACH ID * * * * ALREADY GOT MEMORY BOUNDS; SEE IF ABS CAN FIT * * ABS6 LDA ABSAD GET ADDR OF ABS REC LDB ABSSZ ADB A GET ADDR OF END OF ABS REC JSB CKBND CHECK BOUNDS WITH LFREE,HFREE JMP ABS13 ERROR. * * * * COPY ABS RECORD TO CORE IF WITHIN BOUNDS SPC 1 IFZ ***** BEGIN DMS CODE *************** LDA FUNC CPA D1 LOAD MEMORY RESIDENT? JMP LDMRP YES * LDA ABSAD NO, LOAD PARTITION RESIDENT JSB PGNO GET PAGE OF RECORD STA PAGE1 SZA,RSS RECORD FOR BASE PAGE? JMP BPMAP YES * LDA ABSAD ADA ABSSZ GET ADDR OF LAST WORD IN RECORD ADA M1 STA ABSEN SAVE ADDR OF LAST WORD IN REC JSB PGNO FIND PAGE OF THAT WORD STA B STB PAGE2 SAVE ENDING PAGE NUMBER CPB PAGE1 RECORD FITS WITHIN ONE PAGE? JMP SAMEP YES * BLF,BLF NO, CROSSES ONE PAGE RBL,RBL ASSUMING RECORD SIZE < 128 WORDS STB PADDR SAVE PAGE BOUNDARY ADDR LDA ABSAD CMA,INA ADA PADDR CALCULATE #WORDS ON THIS PAGE CAX STA WDS1 LDA PTFWA JSB PGNO STA B CMB,INB SUBTRACT PTTN PAGE# ADB PAGE1 TO GET #PAGES OFFSET ADB PTSPG AND OFFSET FROM FIRST PAGE OF PTTN INB (B) = PHYSICAL PAGE # AFTER COUNTING BP * LDA ABSAD CAY (Y) = LOGICAL ADDR FOR RECORD LDA DABSD (A) = ADDR OF RECORD IN INPUT BUFFER JSB MAPMV PERFORM MAPPING WORD MOVE * LDA PAGE2 SET UP TO MOVE SECOND PART ALF,ALF RAL,RAL CONVERT PAGE# TO ADDR CMA,INA SUBTRACT FROM END ADDR ADA ABSEN TO GET # WORDS INA CAX (X) = # WORDS TO MOVE LDA PTFWA JSB PGNO STA B CMB,INB SUBTRACT FIRST PAGE OF PTTN ADB PAGE2 TO GET #PAGES OFFSET ADB PTSPG ADD TO PTTN FIRST PAGE INB (B) = PAGE # LDA PADDR CAY (Y) = LOGICAL ADDR FOR RECORD LDA DABSD ADA WDS1 (A) = ADDR OF ABS REC IN INPUT BUFFER JSB MAPMV DO MAPPED MOVE JMP ABS0 GO READ MORE * SAMEP LDA PTFWA JSB PGNO STA B CMB,INB ADB PAGE1 INB ADB PTSPG SAMEM LDA ABSSZ CAX (X) = #WORDS LDA ABSAD CAY (Y) = LOGICAL ADDR IN PTTN LDA DABSD (A) = ADDR OF REC IN INPUT BUFFER JSB MAPMV DO MAPPED MOVE JMP ABS0 GO READ MORE * BPMAP LDB PTSPG JMP SAMEM * * PGNO NOP CONVERT ADDR TO PAGE # AND B76K ALF,RAL RAL JMP PGNO,I RETURN (A)=PAGE # (B)=UNCHANGED * * (A) = ADDR OF ABS REC IN INPUT BUFFER * (B) = PAGE # OF PARTITION * (X) = # WORDS TO MOVE * (Y) = LOGICAL ADDR FOR ABS IN PTTN * MAPMV NOP MAPPED MOVE ROUTINE STA MAPFR TO MOVE ABS RECS TO PTTN CYA STA LOGSA SAVE LOGICAL ADDR CXA STA NWDS SAVE # WORDS * CLA,INA CAX (X) = 1 REGISTER TO SET UP LDA MAPPG (A) = MAP REGISTER # JSB $LIBR TURN OFF MEM PROT NOP SO WE CAN CHANGE MAP, ALSO MOVE TO BP XMS (B) = PTTN'S PAGE # LDA LOGSA CONVERT LOG ADDR TO PAGE# AND B76K CMA,INA ADA LOGSA OFFSET INTO PAGE ADA PAGBF MAKE LOGICAL ADDR FOR MAPPED MOVE STA B (B) = ADDR OF DUMMY BUFFER FOR MOVE LDA NWDS CAX (X) = #WORDS TO MOVE LDA MAPFR (A) = ADDR OF ABS REC IN BUFFER MWI MOVE WORDS VIA DUMMY BUFFER IN SYS MAP JSB $LIBX DEF MAPMV RETURN * MAPFR NOP ADDR OF ABS REC IN BUFFER LOGSA NOP LOGICAL ADDR OF ABS REC IN PTTN MAPPG DEC 31 LAST PAGE IN SYSTEM MAP PAGBF OCT 76000 ADDR OF DUMMY BUFFER FOR CROSS MAP STORE NWDS NOP #WORDS TO MOVE PADDR NOP PAGE BOUNDARY ADDR B1777 OCT 1777 B76K OCT 76000 C100K OCT 77777 CURPT NOP ADDR OF CURRENT PTTN OWNER PTR PAGE1 NOP PAGE # OF FIRST PART OF REC PAGE2 NOP PAGE # OF SECOND PART OF REC ABSEN NOP ADDR OF LAST WORD IN REC PT#PG NOP #PAGES IN PTTN PTFWA NOP LOGICAL ADDR OF FIRST WORD IN MAIN OF PTTN PTLWA NOP LOGICAL ADDR OF LAST WORD IN MAIN OF PTTN PTSPG NOP PAGE # OF FIRST PAGE IN PTTN PTTN# NOP PTTN # WDS1 NOP # WORDS IN FIRST PAGE OF REC DCRID DEF CURID * * PTMN LDA DMAIN GET PTRS TO MAIN HI/LO RSS GO CHECK BOUNDS OF REC * PTBP LDA DBASE GET PTRS TO BP HI/LO STA TEMP4 JMP ABS6 GO CHECK BOUNDS OF REC * ******* END DMS CODE *************** XIF SPC 1 * * B240 OCT 240 CONWD NOP CONTROL WORD FOR EXEC CALL * * LDMRP LDA DABSD SET UP BUFFER LDB ABSAD SET UP CORE ADDR. JSB SYSET PUT INTO CORE. DEF ABSSZ JMP ABS0 GO GET ANOTHER RECORD * * * * PROCESS SPECIAL TRAILER RECORDS. * * ABS12 NOP RSS-ED AFTER SSGA SET UP. JMP AB12C AB12D RSS NOP-ED AFTER 1ST ENTRY.! JMP AB12B SO ONLY DO THIS ONCE. LDA MD28 STA TEMP1 SET COUNTER LDB DDMID TO CLEAR OUT CLA AB12A STA B,I SPECIAL RECORDS INB ISZ TEMP1 JMP AB12A STA AB12D NOP SWITCH * AB12B LDA WORD1 CPA DWRD2 ALL DONE ALREADY? JMP IDERR ERROR ON TRAILER RECORDS DLD ABSD1 PICK UP 2 DATA WORDS STA WORD1,I PUT 1ST INTO DUMMY ID. STB WORD2,I PUT 2ND INTO DUMMY ID. ISZ WORD1 BUMP DUMMY ID ISZ WORD2 LOCATIONS. JMP ABS0 * * MPFT# 0-PRP NO COM, 1-MRP NO COM, 2-RT COM, 3-XXX, 4-SSGA * AB12C LDA RSS STA ABS12 SET RSS IN THE SSGA SWITCH CLB,INB PREPARE FOR FUNC=1 FOR MRP LDA ABSD1 FIRST SPECIAL RECORD RAL,CLE,SLA,ERA SIGN BIT 0-MRP, 1-PRP INB NOT MEM RES, SET FUNC=2 FOR PTTN LOAD STA MPFT# HAS MPFT INDEX STB FUNC OVERRIDE FUNC WITH ABS TYPE SEZ,RSS IS IT MEMORY RESIDENT? JMP ABS0 YES, READ NEXT RECORD SPC 1 IFN * BEGIN NON-DMS CODE *************** JMP IDERR M1 OR M2 DOESN'T ALLOW PRP *** END NON-DMS CODE *************** XIF IFZ ***** BEGIN DMS CODE *************** LDA PGPT JSB PGNO CMA,INA INA STA PT#PG SAVE NEG #PAGES-1 CCB ADB $MATA (B) = ADDR OF #PTTNS LDA PGPT AND B77 GET PTTN # SZA,RSS SPECIFIC PTTN# WANTED? JMP PTFND NO, FIND A FREE ONE * ADA M1 SAVE PTTN# - 1 STA PTTN# CMA ADA B,I SUBTRACT FROM #PTTNS CMA SSA,RSS ANY ERROR? JMP ER.PT YES, NO SUCH PTTN * LDA PTTN# 6*(PTTN#-1)+$MATA MPY D6 IS ADDR OF ENTRY IN MAP TABLE ADA $MATA ADA D2 INDEX TO ID OF PTTN OWNER LDB A,I SZB IS PTTN FREE? JMP PTTNO NO, PTTN IS OCCUPIED * LDB A ADB D2 INDEX TO RESERVED FLAG LDB B,I AND PTTN SIZE WORD RBL,CLE,ERB KEEP RESERVE FLAG IN (E) ADB PT#PG CCE,SSB PTTN LARGE ENOUGH? JMP PT.SZ * PTFR LDB PTTN# RBL,ERB SET SIGN BIT FROM (E) STB PTTN# FOR PARTITION REQUESTED STA CURPT SAVE CURR PTTN OWNER PTR LDB A ADB M2 BACK UP TO LINK WORD LDB B,I SSB IS PTTN DEFINED? JMP ER.PT NO. GIVE 'PTN' ERROR * INA LDB A,I STB PTSPG SAVE PTTN START PAGE # INA LDB A,I STB PT#PG SAVE #PAGES IN PTTN JMP PTADR NOW FIND HI ADDR OF PTTN * PTTNO ADB D12 INDEX B TO ADDR OF NAME LDA ERR14 PTTN OCCUPIED JSB ERROR -PTN XXXXX- ERROR MESSAGE LDB MD62 ERROR CODE JMP ERSET * PTFND CLA STA PTTN# INIT PTTN# TO 0 LDA B,I GET #PTTNS CMA,INA STA TEMP NEGATE FOR PTTN SCAN LDA $MATA ADA D2 LOOK AT EACH PTTN OWNER ID * PTNX LDB A,I SZB IS PTTN FREE? JMP PTNFD NO, PTTN NOT FOUND * LDB A ADB D2 INDEX TO SIZE WORD IN MAT ENTRY LDB B,I RBL,CLE,SLB,ERB JMP PTNFD RESERVED, KEEP LOOKING ADB PT#PG CLE,SSB,RSS ENOUGH PAGES IN THIS PTTN? JMP PTFR YES, USE THIS (E=0 TOO) * PTNFD ADA D6 NO, TRY NEXT ONE ISZ PTTN# BUMP PTTN# ISZ TEMP LOOKED AT ALL OF THEM YET? JMP PTNX NO, KEEP LOOKING * ER.PT LDB ERR14 NO SUCH PTTN OR NONE FREE JMP ERPR4 -PTN- ERROR AND ABORT * PT.SZ LDB ERR15 NOT ENOUGH PAGES IN PTTN JMP ERPR4 -PTSZ- ERROR AND ABORT * * PTADR LDA MPFT# SZA IS COMMON OR SSGA NEEDED? JMP USECM YES * LDA $ENDS GET LAST PAGE OF SYSTEM ALF,ALF RAL,RAL JMP STFWA SET UP FWA FOR USER * USECM LDA RTORG ADA RTCOM ADA B1777 AND B76K * STFWA STA PAGE1 SAVE TEMPORARILY CMA,INA LOWEST POSSIBLE LOGICAL ADDR STA B LDA ABSD2 AND B76K GET START PAGE OF USER ABS ADB A SSB USER ADDR < LOWEST LOGICAL ADDR? JMP ABS14 YES "ERR MEM" * STA PTFWA SAVE FWA OF PARTITION USER STA LMAIN SAVE FOR BOUNDS CHECK LDB PT#PG #PAGES - 1 IN PARTITION BLF,BLF RBL,RBL ADB PAGE1 COMPUTE LWA PTTN OR 77777 CMA,INA ADA B JSB PGNO STA PT#PG SAVE ACTUAL #PAGES USED ADB M1 SSB ADDR > 77777? LDB C100K YES, SET LWA = 77777 STB PTLWA LWA OF PARTITION AREA STB HMAIN SAVE FOR BOUNDS CHECK LDA D2 STA LBASE SET LOW BASE ADDR FOR BOUNDS CHECK LDA BPA2 INA STA HBASE SET HI BASE ADDR FOR BOUNDS CHECK JMP ABS0 DONE WITH 1ST SPECIAL, GO READ ABS * ******* END DMS CODE *************** XIF SPC 1 * * * * * REACHED END-OF-FILE ON PROGRAM INPUT * * LOAD5 LDB ABSCT CHECK IF ANY ABS SZB,RSS WAS READ YET. JMP IDERR ERROR IF NONE. LDA WORD1 SPEC REC MUST BE AT END CPA DWRD2 WAS IT ALL THERE? JMP LOAD6 YES. IDERR LDB ERR13 NO SPECIAL RECORDS, JMP ERPR4 PRINT ERR MSG/ABORT * LOAD6 DLD NAM12 NAME GIVEN IN COMMAND? SZA,RSS JMP LOAD7 NO, USE NAME FROM SPEC REC DST PNM12 YES, USE NAME FROM COMMAND LDA NAM50 GET 5TH CHAR AND LHALF STA PNM50 JMP LOAD8 WE DID DUP.CHECK ALREADY. LOAD7 JSB DUPID NAME GIVEN IN SPECIAL RECORD, DEF PNM12 CHECK FOR DUPLICATE. * LOAD8 LDB SZCOM GET SIZE OF COMMON SZB,RSS JMP LOD8A SKIP CHECK IF NO COMMON LDA FWAC GET FWA COMMON CMA SUBTR FROM ADA RTORG FWA REAL-TIME COMMON SSA,RSS FWAC