TITLE FORWMU - LOCAL FOROTS PATCHES SUBTTL T HAGADONE SEARCH FORPRM IFNDEF FTWMU, IFN FTWMU,< ENTRY INDVT. INDVT.: MOVSI T2,ACC.SV+20(P4);FIRST LOC TO ZERO HRRI T2,ACC.SV+21(P4) SETZM ACC.SV+20(P4) ;ZERO IT BLT T2,@.JBREL ;TO TOP OF CORE MOVEI T1,DEVTB. ;ADDRESS OF DEVTB. MOVEM T1,DEV.TB(P4) ;STORE IT FOR FOROTS MOVEI T1,DVEND.-DEVTB.-1 ;SIZE OF DEVTAB MOVEM T1,DEV.SZ(P4) ;STORE IT FOR FOROTS JRST (P) ;RETURN SUBTTL DEVTB. DEFAULT DEVICE TABLE FOR FORTRAN IV SIXBIT .REREAD. ;-6; REREAD SIXBIT .CDR. ;-5; READ SIXBIT .TTY. ;-4; ACCEPT SIXBIT .LPT. ;-3; PRINT SIXBIT .PTP. ;-2; PUNCH SIXBIT .TTY. ;-1; TYPE DEVTB.: Z ;00; ILLEGAL DEVICE NUMBER SIXBIT .DSK. ;01; DISC SIXBIT .CDR. ;02; CARD READER SIXBIT .LPT. ;03; LINE PRINTER SIXBIT .CTY. ;04; CONSOLE TELETYPE SIXBIT .TTY. ;05; USER'S TELETYPE SIXBIT .PTR. ;06; PAPER TAPE READER SIXBIT .PTP. ;07; PAPER TAPE PUNCH SIXBIT .DIS. ;08; DISPLAY SIXBIT .DTA1. ;09; DECTAPE SIXBIT .DTA2. ;10; SIXBIT .DTA3. ;11; SIXBIT .DTA4. ;12; SIXBIT .DTA5. ;13; SIXBIT .DTA6. ;14; SIXBIT .DTA7. ;15; SIXBIT .MTA0. ;16; MAG TAPE SIXBIT .MTA1. ;17; SIXBIT .MTA2. ;18; SIXBIT .FORTR. ;19; SIXBIT .DSK. ;20; SIXBIT .DSK. ;21; SIXBIT .DSK. ;22; SIXBIT .DSK. ;23; SIXBIT .DSK. ;24; SIXBIT .DEV1. ;25; SIXBIT .DEV2. ;26; SIXBIT .DEV3. ;27; SIXBIT .DEV4. ;28; SIXBIT .CDP. ;29; SIXBIT .TTY. ;30; DVEND.: > ;END FTWMU PRGEND TITLE DEVCHG SUBTTL CHANGE DEVTB. ENTRIES TO NEW DEVICES SEARCH FORPRM IFNDEF FTWMU, IFN FTWMU,< BP7=0 BP6=1 CTR=2 A=3 IND=5 CH=6 P4=7 Q=16 P=17 HELLO (DEVCHG) HRRZ P4,.JBOPS ;LOAD BASE REGISTER SETZ A, SKIPLE IND,@1(Q) ;GET FLU, IS IT LEGAL CAMLE IND,DEV.SZ(P4) ;TOP AND BOTTOM? JRST [OUTSTR DEVERR MOVEI 16,[EXP 0,0]+1 ;ARG FOR EXIT. PUSHJ P,EXIT.##] MOVEI BP7,@(Q) ;ADDRESS OF DEVICE NAME HRLI BP7,440700 MOVE BP6,POINT HRROI CTR,-5 ;NUMBER OF CHARS PER WORD GETDEV: ILDB CH,BP7 JUMPE CH,DONE SUBI CH,40 IDPB CH,BP6 AOJL CTR,GETDEV DONE: ADD IND,DEV.TB(P4) ;ADDRESS OF ENTRY MOVEM A,(IND) ;STORE NEW DEVICE GOODBY POINT: POINT 6,A, DEVERR: ASCIZ /?FRSDVC - ILLEGAL DEVICE NUMBER IN CALL TO DEVCHG / > ;END FTWMU PRGEND TITLE BLOCKT SUBTTL BLOCK TRANSFER SUBROUTINE SEARCH FORPRM COMMENT * USAGE CALL BLOCKT(ARRAY1,ARRAY2,NWORDS) WHERE ARRAY1: IS ARRAY (VECTOR) TO BE TRANSFERED ARRAY2: IS ARRAY (VECTOR) TO TRANSFER ARRAY1 TO NWORDS: IS THE NUMBER OF WORDS TO TRANSFER * HELLO (BLOCKT, ) ;BLOCKT ENTRY MOVSI 0,@0(16) ;PICK UP STARTING ADDRESS HRRI 0,@1(16) ;PICK UP DESTINATION ADDRESS HRRZ 1,0 ;COPY ADD 1,@2(16) ;ADD LENGTH BLT 0,-1(1) ;TRANSFER. LIMIT =C(1)-1 GOODBY (3) ;RETURN PRGEND TITLE LDBDPB - DO LDB AND DPB INSTRUCTIONS SEARCH FORPRM COMMENT % USAGE CALL GETBYT(SRCWD,IBYTE,ISIZE,IRMOST,IERR) WHERE SRCWD - WORD TO GET BYTE OUT OF IBYTE - WORD TO PUT BYTE INTO ISIZE - SIZE OF BYTE (1 TO 36) MUST NOT BE GREATER THAN IRMOST+1 IRMOST - POSITION OF RIGHTMOST BIT OF BYTE (0 TO 35) IERR - ERROR CODE. NON-ZERO IF ARGUMENTS ARE ILLEGAL CALL GETBYT(DSTWD,IBYTE,ISIZE,IRMOST,IERR) WHERE DSTWD - WORD TO PUT THE BYTE IN IBYTE - WORD TO DPB FROM OTHERS - SAME AS ABOVE % HELLO (GETBYT) PUSHJ P,MAKPNT ;SET UP THE BYTE POINTER GOODBY (1) ;ERROR LDB 0,3 ;LOAD THE BYTE MOVEM 0,@1(16) ;RETURN IT TO THE USER GOODBY (1) ;RETURN HELLO (PUTBYT) PUSHJ P,MAKPNT ;SET UP THE BYTE POINTER GOODBY (1) ;ERROR MOVE 0,@1(16) ;GET THE BYTE DPB 0,3 ;DEPOSIT THE BYTE GOODBY (1) ;RETURN MAKPNT: SETZM @4(16) ;ASSUME NO ERROR SKIPL 2,@3(16) ;IS "RIGHTMOST BIT" LEGAL? CAILE 2,^D35 ;... JRST ERRORR ;NO. ERROR SKIPLE 1,@2(16) ;IS SIZE LEGAL? CAILE 1,1(2) ;... JRST ERRORR ;NO. ERROR MOVEI 3,^D35 ;GET BITS TO THE RIGHT SUB 3,2 ;... LSH 3,6 ;MAKE SPACE FOR SIZE IOR 3,1 ;PUT IN SIZE LSH 3,^D24 ;POSITION HRRI 3,@0(16) ;GET ADDRESS AOS (P) ;SKIP RETURN POPJ P, ERRORR: SETOM @4(16) POPJ P, PRGEND TITLE BYTE PACKING/UNPACKING SEARCH FORPRM COMMENT % WRITTEN BY NORM GRANT. W.M.U. NOVEMBER 2, 1973 PURPOSE PACK AND UNPACK ASCII WORDS USAGE CALL GETCHR(WORD,IBYTE,CHAR) WHERE WORD: IS PACKED WORD(S) IBYTE: IS BYTE NUMBER (.GT. ZERO) CHAR: IS CHARACTER UNPACKED (TRAILING BLANKS) CALL PUTCHR(WORD,IBYTE,CHAR) WHERE WORD: IS PACKED WORD(S) IBYTE: IS BYTE NUMBER (.GT. ZERO) CHAR: IS CHARACTER TO BE PACKED (LEFT JUSTIFIED) % Q=16 HELLO (GETCHR, ) ;GETCHR ENTRY MOVE 0,[ASCII' '] ;BLANK OUT CHAR MOVEM 0,@2(Q) PUSHJ P,BYTE LDB 0,2 ;PICK UP CHARACTER FROM WORD DPB 0,3 ;STORE IN CHAR GOODBY (3) ;RETURN HELLO (PUTCHR, ) ;PUTCHR ENTRY PUSHJ P,BYTE LDB 0,3 ;PICK UP CHARACTER FROM CHAR DPB 0,2 ;STORE IN WORD GOODBY (3) ;RETURN BYTE: MOVE 2,@1(Q) ;GET BYTE NUMBER JUMPLE 2,NULL ;NON-POSITIVE IS AN ERROR SUBI 2,1 ;MINUS ONE FOR DIVIDE IDIVI 2,5 ;FIVE CHARACTERS PER WORD ADD 2,BYTTAB(3) ;ADD PROPER POINTER WORD ADDI 2,@0(Q) ;ADD IN ADDRESS OF WORD MOVEI 3,@2(Q) ;GET POINTER TO CHARACTER HRLI 3,350700 POPJ P, ;RETURN BYTTAB: POINT 7,0,6 ;FIRST BYTE IN WORD POINT 7,0,13 ;SECOND POINT 7,0,20 ;THIRD POINT 7,0,27 ;FOURTH POINT 7,0,34 ;FIFTH AND LAST NULL: OUTSTR [ASCIZ/ Non-positive byte number is illegal! /] POP P,0 GOODBY (2) PRGEND TITLE CLOCK SUBTTL TIME OF DAY. SEARCH FORPRM COMMENT % WRITTEN BY NORM GRANT. W.M.U. USAGE CALL CLOCK(IHOUR,IMIN,ISEC,ITICK) WHERE IHOUR: HOUR OF DAY-24 HOUR TIME. IMIN: MINUTE. ISEC: SECOND. ITICK: CLOCK TICK(1/60 TH SECOND). % HELLO (CLOCK, ) ;CLOCK ENTRY TIMER IDIVI 0,^D60 MOVEM 1,@3(16) IDIVI 0,^D60 MOVEM 1,@2(16) IDIVI 0,^D60 MOVEM 1,@1(16) MOVEM 0,@0(16) GOODBY (4) PRGEND TITLE DAY SUBTTL DATE SEARCH FORPRM COMMENT % WRITTEN BY NORM GRANT. WMU. SEPTEMBER 2,1971. PURPOSE: TO DETERMINE YEAR, MONTH, AND DAY. USAGE CALL DAY(IYEAR,IMONTH,IDAY) WHERE IYEAR: INTEGER YEAR(RETURNED) IMONTH: INTEGER MONTH(1-12)(RETURNED) IDAY: INTEGER DATE OF MONTH. % HELLO (DAY, ) ;DAY ENTRY DATE IDIVI 0,^D31 AOJ 1, MOVEM 1,@2(16) IDIVI 0,^D12 AOJ 1, MOVEM 1,@1(16) ADDI 0,^D1964 MOVEM 0,@0(16) GOODBY (3) PRGEND TITLE DLOGIC SUBTTL FORTRAN SUBROUTINES FOR LSHC AND ROTC. REMARK WRITTEN BY NORM GRANT. W.M.U. SEARCH FORPRM COMMENT % USAGE CALL DSHIFT(WORD,IPLACES,WORD1) CALL DROTATE(WORD,IPLACES,WORD1) WHERE WORD: IS DOUBLE PRECISION WORD TO BE SHIFTED OR ROTATED. IPLACES: IS NUMBER OF PLACES TO SHIFT OR ROTATE. POSITIVE IS LEFT, NEGATIVE IS RIGHT. WORD1: DOUBLE PRECISION RESULT. % HELLO (DSHIFT, ) ;DSHIFT ENTRY DMOVE 0,@0(16) MOVE 2,@1(16) LSHC 0,0(2) DRET: DMOVEM 0,@2(16) GOODBY (3) HELLO (DROTAT, ) ;DROTAT ENTRY DMOVE 0,@0(16) MOVE 2,@1(16) ROTC 0,0(2) JRST DRET PRGEND TITLE DYTIME SUBTTL GET DAY TIME, IN MS. SEARCH FORPRM COMMENT % WRITTEN BY NORM GRANT. W.M.U. USAGE CALL DYTIME(ITIME) WHERE ITIME: IS DAYTIME IN MILLISECONDS.(RETURNED) % HELLO (DYTIME, ) ;DYTIME ENTRY MSTIME 0, MOVEM 0,@0(16) GOODBY (1) PRGEND TITLE ECHO - SUBROUTINE TO TURN TTY ECHO ON OR OFF. SUBTTL WRITTEN BY JERRY FOCHTMAN. W.M.U. SEARCH FORPRM COMMENT % USAGE CALL ECHO(ICMD) WHERE ICMD - IS A SWITCH TO TURN ECHO EITHER ON OR OFF. 0 - ON 1 - OFF NOTE - A CARRIAGE RETURN DOES NOT GENERATE A LINE FEED WHEN ECHO IS OFF, SO THE MAIN PROGRAM MUST ALLOW FOR IT. % HELLO (ECHO, ) ;ECHO ENTRY MOVE 1,@0(16) SETO 0, GETLCH 0, JUMPN 1,NEO TLZ 0,4 JRST DONE NEO: TLO 0,4 DONE: SETLCH 0, GOODBY (1) PRGEND TITLE TYPEON SEARCH FORPRM HELLO (TYPEON, ) SKPINL ;TURN ON ECHOING JFCL ;DON'T CARE GOODBY (0) PRGEND TITLE GES SEARCH FORPRM HELLO (GES, ) SETZ 7, MOVE 1,@1(16) ADDI 1,@0(16) SOJ 1, HRRM 1,BLL HRLI 1,@0(16) MOVEI 2,@0(16) AOJ 2, HRRM 2,1 MOVE 2,BL MOVEM 2,@(16) BLL: BLT 1,0 MOVEI 1,@0(16) HRRM 1,MOV SETZM @2(16) MOVE 1,@1(16) SETZ 4, TT: INCHWL 2 CAIN 2,15 JRST TT CAIN 2,12 JRST EOL JUMPL 7,NEXT MOVE 3,BL DPB 2,[POINT 7,3,6] MOV: MOVEM 3,(4) NEXT: CAIG 2,175 CAIN 2,33 JRST ALT CAIN 2,32 JRST EOF A: AOJ 4, CAML 4,1 SETO 7, JRST TT ALT: SETOM @2(16) JRST CRLF EOL: MOVEI 5,1 MOVEM 5,@2(16) GOODBY (3) EOF: MOVEI 5,2 MOVEM 5,@2(16) CRLF: OUTSTR [BYTE (7)15,12] GOODBY (3) BL: ASCII/ / PRGEND TITLE GETPPN SUBTTL RETURN PROJECT-PROGRAMMER PAIR. SEARCH FORPRM COMMENT % WRITTEN BY NORM GRANT. AUGUST 30,1971. USAGE CALL GETPPN(IPROJ,IPROG) WHERE IPROJ: PROJECT NUMBER(OCTAL) RETURNED. IPROG: PROGRAMMER NUMBER(OCTAL) RETURNED. % HELLO (GETPPN, ) ;GETPPN ENTRY CALLI 0,24 HRRZM 0,@1(16) HLRZM 0,@0(16) GOODBY (2) PRGEND TITLE JOBNUM SUBTTL GET JOB NUMBER SEARCH FORPRM COMMENT % WRITTEN BY NORM GRANT. WMU. SEPTEMBER 2,1971. PURPOSE: TO DETERMINE JOB NUMBER OF USER'S JOB. USAGE CALL JOBNUM(IJOB) WHERE IJOB: INTEGER JOB# (RETURNED) % HELLO (JOBNUM, ) ;JOBNUM ENTRY PJOB MOVEM 0,@0(16) GOODBY (1) PRGEND TITLE LOGIC SUBTTL FORTRAN SUBROUTINES FOR LSH AND ROT. REMARK WRITTEN BY NORM GRANT. W.M.U. SEARCH FORPRM COMMENT % USAGE CALL SHIFT(WORD,IPLACES,WORD1) CALL ROTATE(WORD,IPLACES,WORD1) WHERE WORD: IS WORD TO BE SHIFTED OR ROTATED. IPLACES: IS NUMBER OF PLACES TO SHIFT OR ROTATE. POSITIVE IS LEFT, NEGATIVE IS RIGHT. WORD1: RESULT % HELLO (SHIFT, ) ;SHIFT ENTRY MOVE 1,@1(16) MOVE 0,@0(16) LSH 0,0(1) RET: MOVEM 0,@2(16) GOODBY (3) HELLO (ROTATE, ) ;ROTATE ENTRY MOVE 1,@1(16) MOVE 0,@0(16) ROT 0,0(1) JRST RET PRGEND TITLE MAXIMUMS SUBTTL FIND MAXIMUM ENTRY IN LIST SEARCH FORPRM COMMENT % WRITTEN BY NORM GRANT. W.M.U. USAGE CALL MAXIMU(ARRAY,NUM,ANS) WHERE ARRAY IS ARRAY FROM WHICH TO SELECT MAXIMUM. NUM SIZE OF ARRAY(>=1) ANS MAXIMUM(SAME MODE AS ARRAY) % HELLO (MAXIMU, ) ;MAXIMUM ENTRY MOVE 2,@1(16) MOVE 0,@0(16) SOJLE 2,DONE MOVEI 1,@0(16) AOJ 1, CAMGE 0,0(1) MOVE 0,0(1) SOJG 2,.-3 DONE: MOVEM 0,@2(16) GOODBY (3) PRGEND TITLE MAXWYT SEARCH FORPRM MIDNIT: EXP ^D24*^D3600*^D1000 ;NUMBER OF MILLISECONDS IN A DAY HELLO (MAXWYT, ) MOVE 1,@0(16) ;GET TIME LIMIT IMULI 1,^D1000 ;CONVERT TO MILLISECONDS MSTIME 3, ;GET CURRENT TIME ADD 3,1 ;MAKE TIME LIMIT IDIV 3,MIDNIT ;MAY BE DAYS DATE 2, ADD 3,2 ;GET FINAL DAY TOO CHECK: SKPINL ;ANY INPUT LINES? CAIA ;NO JRST GOTINP ;YES. GOOD RETURN DATE 2, ;CURRENT DATE MOVN 2,2 ADD 2,3 IMUL 2,MIDNIT ;DAYS YET ADD 2,4 MSTIME 0, ;CURRENT TIME SUB 2,0 ;TOTAL TIME YET TO WAIT JUMPLE 2,BADRET ;TOO LATE IF NOT POSITIVE CAILE 2,^D60000 ;60 SECONDS OR LESS MOVEI 2,^D60000 ;NO. USE 60 SECONDS TLO 2,(1B13) ;WAKE ON INPUT LINE HIBER 2, ;HIBERNATE JRST USESLP ;IF GET ERROR, WE MUST USE SLEEP JRST CHECK ;GO CHECK ON INPUT USESLP: MOVEI 2,1 ;SLEEP ONE SECOND SLEEP 2, JRST CHECK ;AND GO CHECK GOTINP: SETZM @1(16) ;GOOD EXIT GOODBY (2) BADRET: MOVEI 0,1 ;BAD RETURN MOVEM 0,@1(16) CLRBFI ;CLEAR ANY INPUT (PARTIAL LINES) GOODBY (2) ;AND EXIT PRGEND TITLE MINIMUMS SUBTTL FIND MINIMUM ENTRY IN LIST SEARCH FORPRM COMMENT % WRITTEN BY NORM GRANT. W.M.U. USAGE CALL MINIMUM(ARRAY,NUM,ANS) WHERE ARRAY IS ARRAY FROM WHICH TO SELECT MINIMUM. NUM SIZE OF ARRAY(>=1) ANS MINIMUM(SAME MODE AS ARRAY) % HELLO (MINIMU, ) ;MINIMUM ENTRY MOVE 2,@1(16) MOVE 0,@0(16) SOJLE 2,DONE MOVEI 1,@0(16) AOJ 1, CAMLE 0,0(1) MOVE 0,0(1) SOJG 2,.-3 DONE: MOVEM 0,@2(16) GOODBY (3) PRGEND TITLE PEEK SUBTTL SUBROUTINE TO EXAMINE MONITOR. SEARCH FORPRM COMMENT % WRITTEN BY NORM GRANT. W.M.U. USAGE CALL PEEK(IEXEC,IWORD) WHERE IEXEC: IS EXECUTIVE ADDRESS TO BE EXAMINED. IWORD: IS CONTENTS OF IEXEC. % OPDEF PEEK [CALLI 33] HELLO (PEEK, ) ;PEEK ENTRY MOVE 0,@0(16) PEEK MOVEM 0,@1(16) GOODBY (2) PRGEND TITLE RESTART SUBTTL RESTART PROGRAM SEARCH FORPRM ENTRY RESTAR COMMENT % WRITTEN BY NORM GRANT. W.M.U. MARCH 8,1971. PURPOSE TO IMMEDIATELY RESTART A PROGRAM FROM ANY POINT WITHIN IT. USAGE CALL RESTART % RESTAR: IFN F40LIB,< JFCL ;PERMIT BOTH F40 AND F10 ENTRIES> HRRZ 1,.JBSA## JRST 0(1) PRGEND TITLE RNTIME SUBTTL GET PROGRAM RUN TIME, IN MS. SEARCH FORPRM COMMENT % WRITTEN BY NORM GRANT. W.M.U. USAGE CALL RNTIME(ITIME) WHERE ITIME: IS RUNTIME OF JOB, TO PRESENT, IN MILLISECONDS.(RETURNED) % HELLO (RNTIME, ) ;RNTIME ENTRY SETZ 0, RUNTIM 0, MOVEM 0,@0(16) GOODBY (1) PRGEND TITLE RUNUUO SUBTTL MIMIC CONCISE COMMAND LANGUAGE ; WRITTEN BY NORM GRANT. W.M.U ENTRY RUNUUO COMMENT % USAGE CALL RUNUUO(COMMAND) WHERE COMMAND: IS ASCII COMMAND STRING, 200 CHARACTERS OR LESS; MUST END WITH ZERO WORD.(IF COMMAND STRING IS LITERAL ENCLOSED IN QUOTES IN CALL STATEMENT, WILL DO SO AUTOMATICALLY.) VALID COMMANDS ARE R,RUN,EXECUTE,DEBUG,LOAD,COMPILE,MAKE,TECO, CREATE,EDIT,RENAME,DELETE,TYPE,LIST,COPY,PRESERVE,PROTECT,REWIND, UNLOAD,ZERO,SKIP,BACKSPACE,EOF,LABEL AND THEIR STANDARD ABBREVIATIONS. % POINTA: POINT 7,BUFFER, POINTS: POINT 6,FX+1, COUNT=1 LIM=2 SVCNT=3 FLAG=4 NUM=6 POINT=10 POINT1=11 CH=12 Q=16 P=17 BLOCK: SIXBIT/SVC/ IOWD 1,BUFFER OBUF: BLOCK 3 BUFFER: BLOCK ^D40 NAME: SIXBIT/000SVC/ SIXBIT/TMP/ 0 0 RUNUUO: JFCL ;PERMIT BOTH F40 AND F10 ENTRIES SETZ FLAG, RUNUU1: RESET MOVEI POINT,@0(16) HRLI POINT,440700 ;440700=(POINT 7,0,) MOVE POINT1,POINTA SETZM BUFFER MOVE 0,[XWD BUFFER,BUFFER+1] BLT 0,BUFFER+^D39 SETZ 1, LOOP: PUSHJ P,GETCHR JUMPE CH,ERMSG CAIN CH," " JRST LOOP CAIN CH,"R" JRST RUNR CAIA LOOP1: PUSHJ P,GETCHR JUMPE CH,TRAN IDPB CH,POINT1 JRST LOOP1 TRAN: MOVE SVCNT,COUNT ADDI COUNT,4 IDIVI COUNT,5 MOVNS COUNT HRLM COUNT,BLOCK+1 MOVE 0,[XWD 3,BLOCK] TMPCOR JRST DSKIT RUNS: MOVE 0,[XWD 1,E] JRST GET1 DSKIT: INIT 0,0 SIXBIT/DSK/ XWD OBUF,0 JRST NOGO PJOB IDIVI 0,^D10 DPB 1,[POINT 4,NAME,17] IDIVI 0,^D10 DPB 1,[POINT 4,NAME,11] DPB 0,[POINT 4,NAME,5] ENTER 0,NAME JRST NOGO MOVE POINT,POINTA LOOP2: SOSG OBUF+2 OUTPUT 0, PUSHJ P,GETCHR IDPB CH,OBUF+1 SOJG SVCNT,LOOP2 CLOSE 0, JRST RUNS NOGO: OUTSTR [ASCIZ/CANNOT ENTER TMP FILE! /] EXIT RUNR: JUMPN FLAG,LOOP1+1 SETO FLAG, MOVE POINT1,POINTS MOVEI LIM,6 PUSHJ P,GETCHR CAIN CH," " JRST R CAIE CH,"U" JRST RUNUU1 PUSHJ P,GETCHR CAIN CH,"N" PUSHJ P,GETCHR CAIE CH," " JRST RUNUU1 SOS POINT1 SETZM FX PUSHJ P,LOOP4 LOOP6: CAIE CH," " CAIN CH,":" JRST NEXT CAIE CH,"." ;PREMATURE EXTENSION? CAIN CH,"[" ;OR PROJECT PROGRAMMER? JRST DEVFAL ;YES, USE DEFAULT DEVICE, THAT WAS FILENAME. JUMPE CH,DEVFAL ;SAME IF END OF STRING. JRST ERMSG ;ERROR IF NONE OF ABOVE. NEXT: MOVEI LIM,6 MOVE POINT1,POINTS PUSHJ P,LOOP3 SKIPN FX+1 ;NULL NAME? JRST DEVFAL ;YES, SO DEVICE WAS FILENAME. NEXT1: CAIN CH,"." JRST EXTEND EXEN: JUMPE CH,ENDS CAIN CH,"[" JRST LL2 CAIE CH," " JRST ERMSG ;BAD SYNTAX. PUSHJ P,GETCHR JRST EXEN DEVFAL: MOVSI 5,'DSK' ;DEFAULT DEVICE IS DSK. EXCH 5,FX ;AND THAT WAS A FILENAME. MOVEM 5,FX+1 ;SO PUT IT WHERE IT BELONGS. JRST NEXT1 ;AND GO CHECK FOR EXTENSION. ERMSG: OUTSTR [ASCIZ/Command error: /] OUTSTR @0(16) ;USERS COMMAND OUTSTR [BYTE (7)15,12] ;CRLF EXIT EXTEND: MOVEI LIM,3 MOVE POINT1,[POINT 6,FX+2,] PUSHJ P,LOOP5 JRST EXEN LL2: SETZ NUM, LL3: PUSHJ P,GETCHR CAIE CH," " CAIN CH,"]" JRST ENDNUM CAIN CH,"," JRST FNUM CAIG CH,"7" CAIGE CH,"0" JRST ERMSG LSH NUM,3 ADDI NUM,-"0"(CH) JRST LL3 FNUM: HRLZM NUM,FX+4 JRST LL2 ENDNUM: HRRM NUM,FX+4 JRST ENDS R: PUSHJ P,LOOP3 MOVSI 0,'SYS' MOVEM 0,FX ENDS: MOVEI 0,F GET1: MOVE 3,[XWD GETX,GET] BLT 3,GETEND JRST GET LOOP3: SETZM FX+1 MOVE 3,[XWD FX+1,FX+2] BLT 3,FX+5 LOOP4: PUSHJ P,GETCHR CAIN CH," " ;BLANKS JRST LOOP4 ;ARE IGNORED HERE SKIPA LOOP5: PUSHJ P,GETCHR ;SCAN UNTIL WE FIND BAD CHARACTER. CAIGE CH,"0" POPJ P, CAIG CH,"9" JRST OK CAIL CH,"A" CAILE CH,"Z" POPJ P, OK: JUMPLE LIM,.+3 ;DON'T DEPOSIT IF ALREADY HAVE ENOUGH. ADDI CH,40 IDPB CH,POINT1 SOJA LIM,LOOP5 GETCHR: ILDB CH,POINT CAIL COUNT,^D200 SETZ CH, AOJ COUNT, CAIN CH,11 MOVEI CH," " POPJ P, GETX: PHASE 140 GET: MOVE 1,[XWD 1,777] CORE 1, JFCL RUN 0, SPHASE: HALT . DEPHASE FX: PHASE SPHASE+1 F: 0 0 0 0 0 0 E: SIXBIT/SYS/ SIXBIT/COMPIL/ 0 0 0 GETEND: 0 DEPHASE PRGEND TITLE SIZE OF OVERLAY IN CHAINB SEARCH FORPRM HELLO (SIZE, ) MOVE 1,@0(16) HLRE 0,OVTAB##-1(1) MOVMM 0,@1(16) GOODBY (2) PRGEND TITLE SLEEP SEARCH FORPRM OPDEF SLEEP[CALLI 31] COMMENT % WRITTEN BY NORM GRANT. WMU. SEPTEMBER 2,1971. PURPOSE: TO FORCE JOB TO SLEEP. USAGE CALL SLEEP(ISEC) WHERE ISEC: MINIMUM NUMBER OF SECONDS TO SLEEP.(MAY SLEEP LONGER)(INTEGER.) % MIDNIT: EXP ^D24*^D3600*^D1000 ;MILLISECONDS PER DAY ARGBLK: 2 ;CLOCK FUNCTION BLOCK 1 HELLO (SLEEP, ) ;SLEEP ENTRY MOVE 1,@0(16) JUMPLE 1,NOWAIT IMULI 1,^D1000 MSTIME 3, ADD 3,1 ;GET FINAL TIME (MAY BE DAYS) IDIV 3,MIDNIT ;SO GET NUMBER OF DAYS DATE 2, ;CURRENT DATE ADD 3,2 ;FINAL DATE RESLP: PUSH P,1 IDIVI 1,^D1000 ;GET SECONDS MOVEM 1,ARGBLK+1 POP P,1 MOVEI 0,ARGBLK ;ASSUME DAEMON CAILE 1,^D60000 ;.LT. ONE MINUTE? DAEMON 0, ;NO. TRY DAEMON JRST USEHIB ;USE STRAIGHT HIBER SETZ 1, ;INFINITE HIBER USEHIB: CAILE 1,^D60000 ;MAX OF ONE MINUTE MOVEI 1,^D60000 ;DO IT ONE MINUTE AT TIME HIBER 1, ;HIBER. JRST USESLP ;DAMN CHECK: DATE 2, ;GET NEW DATE MSTIME 0, ;GET NEW TIME CAMLE 2,3 ;PAST DATE? JRST NOWAIT ;YES CAMN 2,3 ;SAME DATE? CAMGE 0,4 ;YES. PAST TIME? JRST NEWSLP ;NO. MORE WAITING NOWAIT: GOODBY (1) NEWSLP: MOVN 1,2 ADD 1,3 ;DATEF-DATE IMUL 1,MIDNIT ;TIMES MILLISECONDS/DAY ADD 1,4 ;PLUS TIMEF SUB 1,0 ;MINUS TIME JRST RESLP USESLP: IDIVI 1,^D1000 ;MUST USE SLEEP SLEEP 1, JRST CHECK ;ARE WE THROUGH PRGEND TITLE TRMOPS SEARCH FORPRM COMMENT % USAGE CALL REDTTY(IFUNCT,IVAL,IERR) TO READ FUNCTION IFUNCT INTO IVAL USAGE CALL SETTTY(IFUNCT,IVAL,IERR) TO SET FUNCTION IFUNCT FROM IVAL IERR IS AN ERROR CODE 0 OK -1 NOT ON TTY 1 FUNCTION NOT IMPLEMENTED 2 PRIVILEGED FUNCTION 3 ARGUMENT OUT OF RANGE 4 ARGUMENT LIST LENGTH OR ADDRESS ILLEGAL(ERROR IN SUBROUTINE) 5 DATASET ACTIVITY ON NON DATASET 6 ?? 7 SUBFUNCTION FAILED 8 TERMINAL NOT AVAILABLE FOR LIST OF FUNCTIONS, SEE TRMOP. UUO IN MONITOR CALLS MANUAL. ALL FUNCTION CODES ARE IN RANGE 0-777(BASE EIGHT) % FUNCT: BLOCK 1 ;FUNCTION UDX: BLOCK 1 ;TTY UDX VAL: BLOCK 1 ;ARGUMENT HELLO (REDTTY) MOVEI 0,1000 ;READ BIT JRST TRMOPS HELLO (SETTTY) MOVEI 0,2000 ;WRITE BIT MOVE 1,@1(16) ;GET VALUE MOVEM 1,VAL ;STORE IT TRMOPS: SKIPL 1,@0(16) ;PICK UP FUNCTION CAILE 1,777 ;AND RANGE CHECK IT JRST ERR0 ;ILL FUNCTION IOR 1,0 ;PUT IN READ/WRITE BIT MOVEM 1,FUNCT ;STORE IT PJOB 1, ;GET OUT JOB NUMBER TRMNO. 1, ;GET UDX JRST ERRM1 ;OOPS? MOVEM 1,UDX ;STORE IT MOVE 1,[XWD 3,FUNCT] ;ARGUMENT TRMOP. 1, ;DO FUNCTION JRST WHATER ;OOPS MOVE 0,FUNCT ;GET FUNCTION BACK TRNE 0,1000 ;READ? MOVEM 1,@1(16) ;YES. RETURN ANSWER SETZ 1, ;SET NO ERROR RETFIN: MOVEM 1,@2(16) ;RETURN ERROR CODE GOODBY (3) ;RETURN ERRM1: SKIPA 1,[-1] ;ERROR MINUS ONE ERR0: MOVEI 1,1 ;ERROR ONE JRST RETFIN ;RETURN IT WHATER: CAMN 1,[XWD 3,FUNCT] ;UNIMPLEMENTED UUO? SETZ 1, ;YES. PRETEND NO SUCH FUNCTION AOJA 1,RETFIN ;INCREMENT AND RETURN PRGEND TITLE TRUTH SUBTTL PROGRAM TO MAINTAIN AND TEST COMPRESSED TRUTH TABLES. REMARK WRITTEN BY NORM GRANT. W.M.U. OCTOBER 11,1971. SEARCH FORPRM COMMENT % USAGE CALL TRUTH(TABLE,IFUNCT,IENTRY,VALUE) WHERE TABLE: IS TRUTH TABLE. IFUNCT: IS FUNCTION TO BE PERFORMEED. IF IFUNCT=0, TEST TABLE ENTRY. IF IFUNCT#0, SET TABLE ENTRY TO VALUE. IENTRY: NUMBER OF ENTRY TO BE TESTED OR SET. VALUE: VALUE OF ENTRY, IF IFUNCT=0. VALUE TO SET ENTRY TO IF IFUNCT#0. (# MEANS NOT EQUAL.) PURPOSE: TO COMPRESS A LARGE TRUTH TABLE INTO LITTLE SPACE. FOR EXAMPLE, A 360 ENTRY TABLE WOULD OCCUPY 10 WORDS. % HELLO (TRUTH, ) ;TRUTH ENTRY MOVE 1,@2(16) SUBI 1,1 ;BITS RUN 0-35 IDIVI 1,^D36 MOVNS 2 ;GET NEGATIVE OF REMAINDER ADDI 1,@0(16) MOVE 0,0(1) MOVE 3,@1(16) MOVEI 5,1 ROT 5,0(2) JUMPE 3,TEST SKIPL @3(16) TDZA 0,5 TDO 0,5 MOVEM 0,0(1) GOODBY (4) TEST: SETZ 4, TDNE 0,5 SETO 4, MOVEM 4,@3(16) GOODBY (4) PRGEND TITLE TTYNAM SEARCH FORPRM COMMENT % WRITTEN BY NORM GRANT. W.M.U. USAGE CALL TTYNAM(NAME) WHERE NAME IS PHYSICAL NAME OF USER'S TTY. % HELLO (TTYNAM, ) ;TTYNAM ENTRY LDB 1,[POINT 4,0(16),12] PUSHJ P,TYPE..## ;CHECK SINGLE/DOUBLE WORD ARG MOVEI 2,@0(16) ;ADDR OF ARG WORD MOVE 1,[ASCII " "] MOVEM 1,(2) ;BLANK OUT WORD CAILE 0,5 ;SINGLE WORD ARG? MOVEM 1,1(2) ;NO. TWO WORD HRLI 2,440700 ;SET UP BYTE POINTER GETLIN 4, LOOP: SETZ 3, LSHC 3,6 ADDI 3,40 IDPB 3,2 JUMPN 4,LOOP GOODBY (1) PRGEND TITLE TTYPTY SUBTTL CHECK FOR TTY/PTY SEARCH FORPRM COMMENT % USAGE CALL TTYPTY(ICODE) WHERE ICODE IS CODE FOR TELETYPE OR PSUEDO-TELETYPE. ICODE=0 TELETYPE. ICODE=-1 PSEUDO-TELETYPE. WRITTEN BY NORM GRANT. WMU. APRIL 1,1971. THIS PROGRAM DETERMINES WHETHER PROGRAM IS RUNNING FROM TTY OR PTY,AND RETURNS THE APPROPRIATE CODE. % HELLO (TTYPTY, ) ;TTYPTY ENTRY SETZM @0(16) SETO 0, ;MAKE LINE NEGATIVE. GETLCH 0 ;GET LINE CHARACTERISTICS. SKIPGE 0 SETOM @0(16) ;CONSOLE IS PTY. THEREFORE BATCH. GOODBY (1) PRGEND TITLE MINVSQ SUBTTL INVERSE MATRIX PROGRAM. SEARCH FORPRM COMMENT % WRITTEN BY NORM GRANT. WMU. DECEMBER 23, 1970. PROGRAM INVERTS A SQUARE MATRIX WITHIN ITSELF. ; ; USAGE CALL MINVSQ(A,N,TOL,MC,MR,NDIM,IOUT,METHOD,DET,IEXP) WHERE A: MATRIX TO BE INVERTED. N: NUMBER OF ROWS(COLUMNS)IN MATRIX. TOL: TOLERANCE FOR INVERSE(IF LARGEST AVAILABLE PIVOT(IN ABS.)IS LESS THAN .000001*TOL, INVERSE IS CONSIDERED NOT TO EXIST). MC: BOOK-KEEPING VECTOR(AT LEAST N LONG) MR: BOOK-KEEPING VECTOR(AT LEAST N LONG) NDIM: DIMENSION OF MATRIX A IN MAINLINE(NDIM BY NDIM) IOUT: OUTPUT DEVICE SPECIFICATION FOR ERROR MESSAGES. METHOD: SWITCH FOR SELECTING PIVOT METHOD. =0 LEAST ACCURATE(FASTEST)USES FIRST NON-ZERO. =1 COMPROMISE.USES LARGEST REMAINING IN ROW. =2 MOST ACCURATE(SLOWEST)USES LARGEST REMAINING. DET: DETERMINENT OF MATRIX A(CHARACTERISTIC ONLY). IEXP: POWER OF 10 OF DETERMINENT. % K=15 J=14 I=13 II=12 JJ=11 KK=10 LL=7 KI=6 KKK=5 HELLO (MINVSQ, ) ;MINVSQ ENTRY MOVEM 15,TEMP. MOVEM 16,TEMP.+1 MOVEI 0,TEMP.+1 PUSH 0,@1(16) PUSH 0,@2(16) PUSH 0,@5(16) PUSH 0,@6(16) PUSH 0,@7(16) ; M0: MOVEI 2,@3(16) ;SET UP BASE ADDRESSES OF ARRAYS. SOJ 2, HRRM 2,MC1 HRRM 2,MC2 HRRM 2,MC3 ; MOVEI 2,@4(16) SOJ 2, HRRM 2,MR1 HRRM 2,MR2 HRRM 2,MR3 ; MOVEI 2,@0(16) SOJ 2, HRRM 2,A1 HRRM 2,A3 HRRM 2,A4 HRRM 2,A5 HRRM 2,A6 HRRM 2,A8 HRRM 2,A9 HRRM 2,A10 HRRM 2,A11 HRRM 2,A12 HRRM 2,A14 HRRM 2,A15 HRRM 2,A16 HRRM 2,A17 HRRM 2,A18 HRRM 2,A19 HRRM 2,A21 HRRM 2,A22 HRRM 2,A23 HRRM 2,A24 HRRM 2,A26 HRRM 2,A27 HRRM 2,A28 ; ; ; INITIALIZE ZTOL,DET,AND BOOK-KEEPING ARRAYS. ; MOVE 2,[1.E-6] FMPR 2,TOL MOVEM 2,ZTOL# MOVSI 2,201400 MOVEM 2,DET SETZM IEXP MOVEI I,1 M3:MR1: MOVEM I,777777(I) MC1: MOVEM I,777777(I) CAMGE I,N AOJA I,M3 MOVEI 2,1 MOVEM 2,KSGN# ; ; BEGIN MAIN INVERSION LOOP. ; MOVN KK,NDIM $7: MOVEI K,1 M4: ADD KK,NDIM MOVE 2,N MOVEM 2,NL# ; ; SELECT PIVOT METHOD AND THEN PIVOT ELEMENT. ; MOVNI 2,1 ADD 2,METHOD JUMPL 2,$4 JUMPG 2,$2 $3: MOVEM K,NL $2: SETZM AMAX# MOVE JJ,KK SUB JJ,NDIM MOVE J,K M6: ADD JJ,NDIM MOVE I,K M8: MOVE 2,I ADD 2,JJ MOVEM 2,IJ# A1: MOVM 0,777777(2) CAMG 0,AMAX JRST $5 MOVEM 0,AMAX MOVEM I,NR# MOVEM J,NC# $5: CAMGE I,NL AOJA I,M8 $6: CAMGE J,N AOJA J,M6 JRST $10 $4: MOVE II,KK SUB II,NDIM MOVE I,K M12: ADD II,NDIM MOVE KI,K ADD KI,II A3: MOVM 0,777777(KI) CAMLE 0,ZTOL JRST $11 $62: CAMGE I,N AOJA I,M12 $13: MOVE 0,IOUT JUMPE 0,M16 HRRZS IOUT ;IF NEGATIVE, MAKE JUST RIGHT HALFWORD MOVEI 16,%1M PUSHJ P,OUT.## MOVEI 16,%2M PUSHJ P,IOLST.## M16: SETZM DET SETZM IEXP JRST M17 $11:A4: MOVE 2,777777(KI) MOVEM 2,AMAX MOVEM K,NR MOVEM I,NC $10: MOVM 0,AMAX CAMG 0,ZTOL JRST $13 CAMN K,NR ;SEE IF IN SAME ROW. JRST $9 MOVNS 0,KSGN ;IF NOT, CHANGE SIGN ON DETERMINENT. MOVE 3,NR MR2: MOVEM 3,777777(K) MOVN JJ,NDIM MOVEI J,1 M19: ADD JJ,NDIM MOVE 2,K ADD 2,JJ MOVE 4,JJ ADD 4,NR A5: MOVE 0,777777(2) ;AND SWITCH ROWS. A6: EXCH 0,777777(4) A8: MOVEM 0,777777(2) CAMGE J,N AOJA J,M19 $9: CAMN K,NC ;SEE IF IN SAME COLUMN. JRST $22 MOVNS 0,KSGN ;IF NOT, CHANGE SIGN ON DETERMINENT. MOVE 3,NC MC2: MOVEM 3,777777(K) SUBI 3,1 IMUL 3,NDIM MOVEM 3,NCNC# MOVEI J,1 M21: MOVE 2,KK ADD 2,J MOVE 4,NCNC ADD 4,J A9: MOVE 0,777777(2) ;AND SWITCH COLUMNS. A10: EXCH 0,777777(4) A11: MOVEM 0,777777(2) CAMGE J,N AOJA J,M21 $22: MOVE KKK,KK ADD KKK,K A12: MOVE 0,777777(KKK) MOVEM 0,D# ;STORE PIVOT ELEMENT. FMPRB 0,DET ;MULTIPLY DETERMINENT BY PIVOT. JUMPE 0,$13 $205: MOVM 0,DET CAMGE 0,[10.] JRST $200 MOVE 2,DET FDVR 2,[10.] MOVEM 2,DET AOS IEXP JRST $205 $200: MOVM 0,DET CAML 0,[1.] JRST $210 MOVSI 2,204500 FMPRM 2,DET SOS IEXP JRST $200 $210: MOVEI I,1 M23: MOVE 2,I ADD 2,KK $30:A14:MOVE 0,777777(2) ;DIVIDE COLUMN BY PIVOT. FDVR 0,D A15: MOVEM 0,777777(2) CAMGE I,N AOJA I,M23 MOVSI 2,201400 FDVR 2,D A16: MOVEM 2,777777(KKK) ;PIVOT=1./PIVOT. ; ; BEGIN MAIN REDUCTION LOOP FOR REST OF MATRIX. ; MOVN II,NDIM MOVEI I,1 M24: ADD II,NDIM MOVE KI,K ADD KI,II A17: MOVE 0,777777(KI) JUMPE 0,$40 MOVEM 0,C# CAMN I,K JRST $40 ; ; BEGIN INNERMOST REDUCTION LOOP. ; $41: MOVEI J,1 M27: MOVE 2,J ADD 2,II MOVE 4,J ADD 4,KK MOVN 0,C A18: FMPR 0,777777(4) A19: FADRM 0,777777(2) ;A(J,I)=A(J,I)-C*A(J,K) $50: CAMGE J,N AOJA J,M27 ; ; END OF INNERMOST LOOP. ; MOVE 2,C FDVR 2,D A21: MOVNM 2,777777(KI) ;A(K,I)=-C/D $40: CAMGE I,N AOJA I,M24 ; ; END OF MAIN REDUCTION LOOP. ; $100: CAMGE K,N AOJA K,M4 ; ; END OF MAIN INVERSION LOOP. ; MOVE 0,KSGN FSC 0,233 ;FLOAT NUMBER FMPRM 0,DET ; ; NOW SORT COLUMNS INTO CORRECT ORDER. ; MOVE K,N M28:MC3:MOVE 2,777777(K) MOVEM 2,L# CAMN K,L JRST $155 $150: MOVE II,N IMUL II,NDIM MOVE I,N M31: SUB II,NDIM MOVE 3,II ADD 3,L MOVE 2,K ADD 2,II A22: MOVE 0,777777(3) A23: EXCH 0,777777(2) A24: MOVEM 0,777777(3) SOJG I,M31 $155: SOJG K,M28 ; ; NOW SORT ROWS INTO ORDER. ; MOVE KK,N IMUL KK,NDIM MOVE K,N M32: SUB KK,NDIM MR3: MOVE 2,777777(K) MOVEM 2,L SUB 2,K JUMPE 2,$175 $180: MOVNI LL,1 ADD LL,L IMUL LL,NDIM MOVEI I,1 M35: MOVE 2,I ADD 2,LL MOVE 4,I ADD 4,KK A26: MOVE 0,777777(2) A27: EXCH 0,777777(4) A28: MOVEM 0,777777(2) CAMGE I,N AOJA I,M35 $175: SOJG K,M32 ; ; RETURN! ; M17: MOVE 15,TEMP. MOVE 16,TEMP.+1 HRROI 0,TEMP.+10 POP 0,@11(16) POP 0,@10(16) GOODBY (12) %1M: 100,,IOUT 0 0 340,,[ASCII "('0',I4,' BY',I4,' INVERSE DOES NOT EXIST.'//)"] 12 0 %2M: 1100,,N 1100,,N 4000,,0 TEMP.: BLOCK 2 N: 0 TOL: 0 NDIM: 0 IOUT: 0 METHOD: 0 DET: 0 IEXP: 0 PRGEND TITLE XPRODH SUBTTL CROSS-PRODUCT MATRIX SUBROUTINE. SEARCH FORPRM COMMENT % WRITTEN BY NORMAN GRANT. WMU. DECEMBER 16,1970. GENERATES LOWER CORNER CROSS-PRODUCTS ONLY. USAGE CALL XPRODH(X,SX,SXX,N,NDIM) WHERE X: IS SET OF OBSERVATIONS.(1-DIMENSIONAL ARRAY) SX: IS SUMS OF VARIABLES.(1-DIMENSIONAL ARRAY) SXX: IS SUMS OF CROSS-PRODUCTS.(2-DIMENSIONAL) N: IS NUMBER OF VARIABLES. NDIM: IS DIMENSION OF SXX.(SXX(NDIM,NDIM) ) % SXX=0 XIXJ=1 XI=2 J=3 I=4 HELLO (XPRODH, ) ;XPRODH ENTRY MOVEI 0,N-1 ;INIT PUSH DOWN LIST TO GET ARGS PUSH 0,@3(16) ;GET N PUSH 0,@4(16) ;GET NDIM MOVEI SXX,@2(16) ;GET ADR OF SXX SOJ SXX, ;MINUS ONE MOVEI 1,@0(16) ;GET BASE FOR X SOJ 1, HRRM 1,L1 HRRM 1,L2 MOVEI 1,@1(16) ;GET BASE FOR SX SOJ 1, HRRM 1,SX1 ;AND STORE MOVEI I,1 ;SET INDEX OF OUTER LOOP TO 1 L1: MOVE XI,777777(I) ;SET VALUE OF X(I) SX1: FADRM XI,777777(I) ;SX(I)=SX(I)+X(I). MOVE J,I ;SET COUNTER ON INNER LOOP HRRM SXX,SXX1 ;SET BASE ADDR INTO ARRAY L2: MOVE XIXJ,777777(J) ;GET X(J) FMPR XIXJ,XI ;X(I)*X(J) SXX1: FADRM XIXJ,777777(J) ;SXX(J,I)=SXX(J,I)+X(I)*X(J) CAMGE J,N ;END OF KNNER LOOP? AOJA J,L2 ;NO. INCREMENT AND REPEAT ADD SXX,NDIM ;MOVE TO NEXT COLUMN OF SXX CAMGE I,N ;END OF OUTER LOOP? AOJA I,L1 ;INCREMENT I AND JUMP TO BEGINNING OUTER LOOP GOODBY (5) ;RETURN TO CALLING PROGRAM N: 0 NDIM: 0 PRGEND TITLE XPRODP SUBTTL CROSS-PRODUCT MATRIX SUBROUTINE. SEARCH FORPRM COMMENT % WRITTEN BY NORMAN GRANT. WMU. DECEMBER 16,1970. GENERATES UPPER CORNER CROSS-PRODUCTS ONLY.(BY COLUMN) (STORED IN CLOSE PACKED FORMAT) USAGE CALL XPRODP(X,SX,SXX,N) WHERE X: IS SET OF OBSERVATIONS.(1-DIMENSIONAL ARRAY) SX: IS SUMS OF VARIABLES.(1-DIMENSIONAL ARRAY) SXX: IS SUMS OF CROSS-PRODUCTS.(2-DIMENSIONAL) (IN CLOSE PACKED UPPER TRIANGULAR FORM.) N: IS NUMBER OF VARIABLES. % N=1 SXX=2 XI=3 XIXJ=4 J=5 I=6 HELLO (XPRODP, ) ;XPRODP ENTRY MOVE N,@3(16) ;GET VALUE OF N MOVEI 0,@0(16) ;GET BASE ADDR FOR X SOJ 0, HRRM 0,X1 HRRM 0,X2 MOVEI 0,@1(16) ;GET BASE ADDR FOR SX SOJ 0, HRRM 0,SX1 MOVEI SXX,@2(16) MOVEI I,1 ;SET INDEX OF OUTER LOOP TO 1 L1:X1: MOVE XI,777777(I) ;GET X(I) SX1: FADRM XI,777777(I) ;SX(I)=SX(I)+X(I) MOVEI J,1 ;SET INDEX OF INNER LOOP TO 1 L2: AOJ SXX, ;INCREMENT ADDR INTO SXX X2: MOVE XIXJ,777777(J) ;X(J) FMPR XIXJ,XI ;X(I)*X(J) SXX1: FADRM XIXJ,-1(SXX) ;SXX(J,I)=SXX(J,I)+X(I)*X(J) CAMGE J,I ;END OF INNER LOOP? AOJA J,L2 ;NO. CONTINUE CAMGE I,N ;END OF OUTER LOOP AOJA I,L1 ;NO. CONTINUE GOODBY (4) ;RETURN TO CALLING PROGRAM PRGEND TITLE ZEROH SUBTTL PROGRAM TO ZERO MATRIX. SEARCH FORPRM COMMENT % WRITTEN BY NORMAN GRANT. WMU. NOVEMBER 17,1970. USAGE CALL ZEROH(A,A2,N,NDIM) WHERE NDIM: DIMENSION OF A2 IN CALLING PROGRAM. A: A VECTOR OF NDIM ELEMENTS. A2: AN NDIM BY NDIM ARRAY N: NUMBER OF ROWS AND COMUMNS TO ZERO % A=5 A2=6 N=7 NDIM=10 HELLO (ZEROH, ) ;ZEROH ENTRY MOVEI A,@0(16) ;GET ADDRESS OF ARRAY A. MOVEI A2,@1(16) ;GET ADDRESS OF MATRIX A2. MOVE N,@2(16) ;GET VALUE OF N. MOVE NDIM,@3(16) ;GET VALUE OF DIMENSION(NDIM). SETZM 0(A) ;ZERO FIRST ELEMENT OF A CAIG N,1 ;MORE THAN ONE ELEMENT? JRST Z1 ;NO. HRLZ 0,A ;SET UP BLT HRRI 0,1(A) ;A,,A+1 MOVE 1,A ;A+N-1 ADD 1,N ;... BLT 0,-1(1) Z1: MOVEI 1,-1(N) HRRM 1,B1 ;UPPER LIMIT =N-1(A2+(I-1)*NDIM) Z2: HRRZ 0,A2 ;SET UP BLT WORD HRL 0,A ;A,,A2+(I-1)*NDIM B1: BLT 0,-1(A2) ADD A2,NDIM ;GET TO NEXT COLUMN SOJG N,Z2 ;N COLUMNS GOODBY (4) ;RETURN TO CALLING PROGRAM. PRGEND TITLE ZEROP SUBTTL PROGRAM TO ZERO ARRAY. SEARCH FORPRM COMMENT % WRITTEN BY NORMAN GRANT. WMU. JANUARY 6,1971. USAGE CALL ZEROP(A,N) WHERE A: IS VECTOR TO BE ZEROED N: IS NUMBER OF ELEMENTS TO ZERO % A=1 N=2 HELLO (ZEROP, ) ;ZEROP ENTRY MOVEI A,@0(16) ;GET ADDRESS OF ARRAY A. MOVE N,@1(16) ;GET VALUE OF N. SETZM 0(A) CAIG N,1 GOODBY (2) HRLZ 0,A HRRI 0,1(A) ADD A,N BLT 0,-1(A) POPJ P, PRGEND TITLE ACMSRT SEARCH FORPRM ;AC DEFINITIONS I=14 IJ=13 J=12 K=11 LL=10 M=7 T=6 TT=5 L=0 ; SUBROUTINE ACMSRT(L,N) ; C SORT ARRAY L ; C ORDERING IS BY INTEGER SUBTRACTION ; C ARRAYS IU(K) LND IL(K) PERMIT SORTING UP TO 2**(K+1)-1 ELEMENTS ; DIMENSION L(1),IU(16),IL(16) DIM==^D16 IU: BLOCK DIM IL: BLOCK DIM ; INTEGER T,TT ;ENTRANCE CODE HELLO (ACMSRT, ) ;ACMSRT ENTRY MOVEI 0,@0(16) HRRM 0,LP1 HRRM 0,LP2 HRRM 0,LP3 SOJ 0, HRRM 0,L1 HRRM 0,L2 HRRM 0,L3 HRRM 0,L4 HRRM 0,L6 HRRM 0,L7 HRRM 0,L8 HRRM 0,L10 HRRM 0,L11 HRRM 0,L12 HRRM 0,L14 HRRM 0,L15 HRRM 0,L16 HRRM 0,L17 HRRM 0,L18 HRRM 0,L19 HRRM 0,L20 HRRM 0,L21 HRRM 0,L22 ; M=1 MOVEI M,1 ; I=1 MOVEI I,1 ; J=N MOVE J,@1(16) ; 5 IF(I.GE.J) GO TO 70 $5: CAML I,J JRST $70 ; 10 K=I $10: MOVE K,I ; IJ=(J+I)/2 MOVE IJ,I ADD IJ,J ASH IJ,-1 ; T=L(IJ) L1: MOVE T,L-1(IJ) ; IF(L(I).LE.T) GO TO 20 L2: CAML T,L-1(I) JRST $20 ; L(IJ)=L(I) ; L(I)=T ; T=L(IJ) L3: EXCH T,L-1(I) L4: MOVEM T,L-1(IJ) ; 20 LL=J $20: MOVE LL,J ; IF(L(J).GE.T) GO TO 40 L6: CAMG T,L-1(J) JRST $40 ; L(IJ)=L(J) ; L(J)=T ; T=L(IJ) L7: EXCH T,L-1(J) L8: MOVEM T,L-1(IJ) ; IF(L(I).LE.T) GO TO40 L10: CAML T,L-1(I) JRST $40 ; L(IJ)=L(I) ; L(I)=T ; T=L(IJ) L11: EXCH T,L-1(I) L12: MOVEM T,L-1(IJ) ; GO TO 40 JRST $40 ; 30 L(LL)=L(K) L14: $30: MOVE 02,L-1(K) L15: MOVEM 02,L-1(LL) ; L(K)=TT L16: MOVEM TT,L-1(K) ; 40 LL=LL-1 $40: SOJ LL, ; IF(L(LL).GT.T) GO TO 40 L17: CAMGE T,L-1(LL) JRST $40 ; TT=L(LL) L18: MOVE TT,L-1(LL) ; 50 K=K+1 $50: AOJ K, ; IF(L(K).LT.T) GO TO 50 L19: CAMLE T,L-1(K) JRST $50 ; IF(K.LE.LL) GO TO 30 CAMG K,LL JRST $30 ; IF((LL-I).LE.(J-K)) GO TO 60 MOVE 02,J SUB 02,K ADD 02,I CAML 02,LL JRST $60 ; IL(M)=I MOVEM I,IL-1(M) ; IU(M)=LL MOVEM LL,IU-1(M) ; I=K MOVE I,K ; M=M+1 ; GO TO80 AOJA M,$80 ; 60 IL(M)=K $60: MOVEM K,IL-1(M) ; IU(M)=J MOVEM J,IU-1(M) ; J=LL MOVE J,LL ; M=M+1 ; GO TO 80 AOJA M,$80 ; 70 M=M-1 $70: SOJE M,M3 ; IF(M.EQ.0) RETURN ; I=IL(M) MOVE I,IL-1(M) ; J=IU(M) MOVE J,IU-1(M) ; 80 IF((J-I).GE.(11)) GO TO 10 $80: IFG ,< MOVE 02,J SUB 02,I CAIL 02,^D11> IFLE ,< CAIL J,^D11(I)> JRST $10 ; IF(I.EQ.1) GO TO 5 CAIN I,1 JRST $5 ; I=I-1 SOJ I, ; 90 I=I+1 $90: AOJ I, ; IF(I.EQ.J) GO TO 70 CAMN I,J JRST $70 ; T=L(I+1) LP1: MOVE T,L(I) ; IF(L(I).LE.T) GO TO 90 L20: CAML T,L-1(I) JRST $90 ; K=I MOVE K,I ; 100 L(K+1)=L(K) L21: $100: MOVE 02,L-1(K) LP2: MOVEM 02,L(K) ; K=K-1 SOJ K, ; IF(T.LT.L(K)) GO TO 100 L22: CAMGE T,L-1(K) JRST $100 ; L(K+1)=T LP3: MOVEM T,L(K) ; GO TO90 JRST $90 ; END M3: GOODBY (2) PRGEND TITLE SORT SUBTTL MERGE-SORT PROGRAM. ; REMARK PROGRAM ORIGINALLY WRITTEN IN FORTRAN BY DICK HOUCHARD. WMU. REMARK TRANSLATED TO MACRO FOR INCREASED EFFICIENCY BY NORM GRANT. WMU. REMARK DECEMBER 19,1970. ; ; ; USAGE CALL SORT(IA,N,JA,ISF,IFIELD,IW,IB,ITAG) ; WHERE IA: MATRIX TO BE SORTED. ; N: NUMBER OF ROWS FILLED IN MATRIX. ; JA: NUMBER OF COLUMS FILLED IN MATRIX. ; ISF: NUMBER OF SORT FIELDS. ; IFIELD: VECTOR TELLING WHICH COLUMN IN MOST MAJOR, ; NEXT MOST,ETC. ; IW: NUMBER OF ROWS DIMENSIONED IN MATRIX. ; IB: WORKING STORAGE(AT LEAST 3N/2). ; ITAG: WORKING STORAGE(AT LEAST N). ; SEARCH FORPRM ; ; I=15 J=14 M=13 K=12 MA=11 MC=10 MP=7 JK=6 IC=5 ; HELLO (SORT, ) ;SORT ENTRY MOVEM 15,TEMP MOVEM 16,TEMP+1 MOVEI 0,TEMP+1 PUSH 0,@1(16) PUSH 0,@2(16) PUSH 0,@3(16) PUSH 0,@5(16) ; M0: MOVEI 2,@0(16) ;IA SOJ 2, HRRM 2,IA1 HRRM 2,IA2 HRRM 2,IA3 HRRM 2,IA4 ; MOVEI 2,@6(16) ;IB SOJ 2, HRRM 2,IB1 HRRM 2,IB2 HRRM 2,IB3 HRRM 2,IB4 HRRM 2,IB5 HRRM 2,IB6 HRRM 2,IB7 HRRM 2,IB8 HRRM 2,IB9 HRRM 2,IB10 HRRM 2,IB11 HRRM 2,IB12 HRRM 2,IB13 HRRM 2,IB14 ; MOVEI 2,@4(16) ;IFIELD SOJ 2, HRRM 2,IF1 ; MOVEI 2,@7(16) ;ITAG SOJ 2, HRRM 2,IT1 HRRM 2,IT2 HRRM 2,IT5 HRRM 2,IT6 HRRM 2,IT7 ; M1: MOVE 0,N IDIVI 0,2 ADD 0,1 MOVEM 0,KL# MOVEI I,1 M3: MOVE 2,KL ADD 2,I IB1: MOVEM I,777777(2) CAMGE I,N AOJA I,M3 MOVEI 2,1 MOVEM 2,IM# $15: MOVEI M,1 ADD M,KL MOVEI K,1 $13: MOVE 2,IM ADD 2,M MOVEM 2,IEND# MOVEM 2,J ADD 2,IM MOVEM 2,JEND# $5: MOVEI I,1 M4: MOVNI 2,1 IF1: ADD 2,777777(I) IMUL 2,IW MOVE MA,2 IB2: ADD MA,777777(J) MOVE MC,2 IB3: ADD MC,777777(M) IA1: MOVE 2,777777(MA) IA2: MOVE 3,777777(MC) CAMGE 2,3 JRST $3 CAME 2,3 JRST $4 $2: CAMGE I,ISF AOJA I,M4 $3:IB4: MOVE 3,777777(J) IB5: MOVEM 3,777777(K) AOJ K, AOJ J, CAMGE J,JEND JRST $5 $6:IB6: MOVE 3,777777(M) IB7: MOVEM 3,777777(K) AOJ K, AOJ M, CAML M,IEND JRST $7 JRST $6 $4:IB8: MOVE 3,777777(M) IB9: MOVEM 3,777777(K) AOJ K, AOJ M, CAMGE M,IEND JRST $5 $8:IB10:MOVE 3,777777(J) IB11: MOVEM 3,777777(K) AOJ K, AOJ J, CAMGE J,JEND JRST $8 $7: MOVN 2,KL SUB 2,N ADD 2,IM ADD 2,JEND JUMPG 2,$10 MOVE M,JEND ADD 2,IM JUMPLE 2,$13 MOVE 2,IM ADD 2,M MOVEM 2,IEND MOVEM 2,J MOVEI 2,1 ADD 2,KL ADD 2,N MOVEM 2,JEND JRST $5 $10: MOVNI I,1 ADD I,K M7: MOVE MP,KL ADD MP,I IB12: MOVE 3,777777(I) IB13: MOVEM 3,777777(MP) SOJG I,M7 MOVE 2,IM ASH 2,1 MOVN 3,N ADD 3,2 JUMPGE 3,$16 MOVEM 2,IM ADD 3,IM JUMPLE 3,$15 $20: MOVEI 2,1 ADD 2,KL MOVEM 2,JEND MOVEI K,1 JRST $7 ; ; BEGIN FINAL PHASE OF SORT PUTTING IN ORDER BY TAGS. ; $16: MOVEI I,1 ADD I,KL MOVE MC,KL ADD MC,N M9:IB14:MOVE M,777777(I) $21: MOVN 2,KL ADD 2,I IT1: MOVEM 2,777777(M) CAMGE I,MC AOJA I,M9 MOVEI I,1 M10:IT2:MOVE 2,777777(I) JUMPE 2,$22 $27: CAMN 2,I JRST $22 MOVE IC,2 MOVEI J,1 M13: MOVNI 2,1 ADD 2,J IMUL 2,IW MOVE JK,I ADD JK,2 $24:IA3:MOVE 2,777777(JK) MOVEM 2,IX-1(J) CAMGE J,JA AOJA J,M13 $25: MOVEI J,1 M15: MOVNI 2,1 ADD 2,J IMUL 2,IW MOVE JK,IC ADD JK,2 MOVE 0,IX-1(J) IA4: EXCH 0,777777(JK) MOVEM 0,IX-1(J) CAMGE J,JA AOJA J,M15 IT5: MOVE 2,777777(IC) IT6: SETZM 777777(IC) MOVE IC,2 IT7: MOVE 2,777777(IC) JUMPG 2,$25 $22: CAMGE I,N AOJA I,M10 M16: MOVE 15,TEMP MOVE 16,TEMP+1 GOODBY (10) TEMP: BLOCK 2 N: 0 JA: 0 ISF: 0 IW: 0 IX: BLOCK ^D40 PRGEND TITLE SSORT SEARCH FORPRM COMMENT * USAGE DESCRIPTION CALL SSORT(NV,NC,MV,MC,DATA,IS,KKL,IV,SP) OR CALL SSORT(NV,NC,MV,MC,DATA,IS,KKL,IV,SP,ITYP) WHERE DATA IS ARRAY TO BE SORTED (ONE OR TWO DIMENSIONAL) MC NUMBER OF ROWS DIMENSIONED IN MATRIX DATA (1ST SUBSCRIPT) MV NUMBER OF COLUMNS DIMENSIONED IN MATRIX (SECOND SUBSCRIPT OR 1 IF DATA IS SINGLE SUBSCRIPTED) NC NUMBER OF ROWS FILLED NV NUMBER OF COLUMNS FILLED KKL NUMBER OF SORT FIELDS TO BE USED IS VECTOR OF INDEXES OF SORT FIELDS IV WORKING STORAGE VECTOR. AT LEAST NC IN LENGTH SP WORKING STORAGE VECTOR. AT LEAST NV IN LENGTH ITYP OPTIONAL VECTOR TELLING HOW TO SORT. IF ITH ENTRY IS ZERO, SORT ITH FIELD AS SIGNED INTEGER IF NONZERO, SORT AS UNSIGNED INTEGER OR ALPHANUMERIC (LEFT JUSTIFIED) * COMMENT * ACCUMULATOR ASSIGNMENTS * NEXTRA=15 I=14 J=13 K=12 L=11 II=10 IJ=7 M=6 LL=5 P1==4 T1=0 T2=1 ; SUBROUTINE SSORT(NV,NC,MV,MC,DATA,IS,KKL,IV,SP) HELLO (SSORT, ) ;SSORT ENTRY MOVEM 15,TEMP. MOVEM 16,TEMP.+1 MOVEI 00,TEMP.+1 PUSH 00,@0(16) PUSH 00,@1(16) PUSH 00,@2(16) PUSH 00,@3(16) PUSH 00,@6(16) MOVEI 0,@4(16) SOJ 0, SUB 0,MC HRRM 0,DATA1 HRRM 0,DATA2 HRRM 0,DATA3 HRRM 0,DATA4 HRRM 0,DATA5 HRRM 0,DATA6 HRRM 0,DATA7 HRRM 0,DATA8 HRRM 0,DATA9 HRRM 0,DATA10 HRRM 0,DATA11 HRRM 0,DATA12 HRRM 0,DATA13 HRRM 0,DATA14 HRRM 0,DATA15 HRRM 0,DATA16 HRRM 0,DATA17 MOVEI 0,@5(16) SOJ 0, HRRM 0,IS1 HRRM 0,IS2 HRRM 0,IS3 HRRM 0,IS4 HRRM 0,IS5 HRRM 0,IS6 HRRM 0,IS7 HRRM 0,IS8 HRRM 0,IS9 HRRM 0,IS10 HRRM 0,IS11 HRRM 0,IS12 HRRM 0,IS13 MOVEI 0,@7(16) HRRM 0,IV1A HRRM 0,IV2A HRRM 0,IV3A SOJ 0, HRRM 0,IV1 HRRM 0,IV2 HRRM 0,IV3 HRRM 0,IV4 HRRM 0,IV5 HRRM 0,IV6 HRRM 0,IV7 HRRM 0,IV9 HRRM 0,IV10 HRRM 0,IV11 HRRM 0,IV12 HRRM 0,IV13 HRRM 0,IV14 HRRM 0,IV15 HRRM 0,IV17 HRRM 0,IV18 HRRM 0,IV19 HRRM 0,IV20 HRRM 0,IV21 HRRM 0,IV22 HRRM 0,IV23 HRRM 0,IV25 HRRM 0,IV26 HRRM 0,IV26.5 HRRM 0,IV27 HRRM 0,IV28 HRRM 0,IV30 HRRM 0,IV31 HRRM 0,IV32 HRRM 0,IV34 HRRM 0,IV35 HRRM 0,IV37 HRRM 0,IV38 HRRM 0,IV39 HRRM 0,IV40 HRRM 0,IV41 HRRM 0,IV42 HRRM 0,IV43 HRRM 0,IV44 HRRM 0,IV45 HRRM 0,IV46 HRRM 0,IV47 HRRM 0,IV48 MOVEI 0,@10(16) SOJ 0, HRRM 0,S$1 HRRM 0,S$2 MOVE 0,[JRST COMINT] ;ASSUME COMPARE SIGNED MOVEM COMTYP# IFN F40LIB,< TLNN 16,-1 ;F40 CALL? JRST CHKF10 ;NO. F10 HLRZ 0,^D9(16) ;OPTIONAL ARG PRESENT TRZ 0,777 CAIE 0,(JUMP 0) JRST NOTYPE ;NO. NO TYPE JRST CHKTYP ;MUST CHECK TYPES CHKF10:> HLRE 0,-1(16) ;GET NUMBER OF ARGUMENTS MOVN 0,0 CAIGE 0,^D10 ;OPTIONAL ARG PRESENT JRST NOTYPE CHKTYP: MOVE 0,[SKIPN 0(I)] ;SET UP SKIP WORD TO EXECUTE FOR TYPE ADDI 0,@^D9(16) SUBI 0,1 ;ACTUALLY DO SUB SINCE IF IN INSTRUCTION ;IT OVERFLOWS INTO INDEX FIELD MOVEM 0,COMTYP# NOTYPE: ; DIMENSION DATA(MC,MV),IV(1),IS(1),IU(16),IL(16),SP(1) ; DIMENSION GIP(25) ; DO 1 I=1,NC MOVE I,NC ; 1 IV(I)=I $1: IV1: MOVEM I,777777(I) SOJG I,$1 ; M=1 MOVEI M,1 ; II=1 MOVEI II,1 ; J=NC MOVE J,NC ; 11 IF(II.GE.J) GO TO 18 $11: CAML II,J JRST $18 ; 12 K=II $12: MOVE K,II ; IJ=(J+II)/2 MOVE IJ,II ADD IJ,J SKIPGE IJ ADDI IJ,1 ASH IJ,777777 ; I=0 MOVEI I,0 ; 31 I=I+1 $31: AOS I ; IF(I.GT.KKL) GO TO 33 CAMLE I,KKL JRST $33 ; T1=DATA(IV(IJ),IS(I)) IS1: MOVE 03,777777(I) IMUL 03,MC IV2: ADD 03,777777(IJ) DATA1: MOVE T1,777777(3) ; T2=DATA(IV(II),IS(I)) IS2: MOVE 03,777777(I) IMUL 03,MC IV3: ADD 03,777777(II) DATA2: MOVE T2,777777(3) ; IF(T2.EQ.T1) GO TO 31 ; IF(T2.LT.T1) GO TO 13 ; GO TO 32 JSP P1,COMPAR ;DO THE COMPARE JRST $32 ;T1.LT.T2 JRST $31 ;T1.EQ.T2 JRST $13 ;T1.GT.T2 ; 33 IF(IV(II).LE.IV(IJ)) GO TO 13 $33: IV4: MOVE 02,777777(II) IV5: CAMG 02,777777(IJ) JRST $13 ; 32 ISAV=IV(IJ) $32: IV6: MOVE 02,777777(IJ) ; IV(IJ)=IV(II) IV7: EXCH 02,777777(II) ;IV(IJ) INTO IV(II) AND IV(II) INTO 02 ; IV(II)=ISAV IV9: MOVEM 02,777777(IJ) ;IV(II) INTO IV(IJ) ; 13 LL=J $13: MOVE LL,J ; I=0 MOVEI I,0 ; 34 I=I+1 $34: AOS I ; IF(I.GT.KKL) GO TO 36 CAMLE I,KKL JRST $36 ; T1=DATA(IV(IJ),IS(I)) IS3: MOVE 03,777777(I) IMUL 03,MC IV10: ADD 03,777777(IJ) DATA3: MOVE T1,777777(3) ; T2=DATA(IV(J),IS(I)) IS4: MOVE 03,777777(I) IMUL 03,MC IV11: ADD 03,777777(J) DATA4: MOVE T2,777777(3) ; IF(T2.EQ.T1) GO TO 34 ; IF(T2.GT.T1) GO TO 5 ; GO TO 35 JSP P1,COMPAR ;DO THE COMPARE JRST $5 ;T1.LT.T2 JRST $34 ;T1.EQ.T2 JRST $35 ;T1.GT.T2 ; 36 IF(IV(J).GE.IV(IJ)) GO TO 5 $36: IV12: MOVE 02,777777(J) IV13: CAML 02,777777(IJ) JRST $5 ; 35 ISAV=IV(IJ) $35: IV14: MOVE 02,777777(IJ) ; IV(IJ)=IV(J) IV15: EXCH 02,777777(J) ;IV(IJ) INTO IV(J) AND IV(J) INTO 02 ; IV(J)=ISAV IV17: MOVEM 02,777777(IJ) ;IV(J) INTO IV(IJ) ; I=0 MOVEI I,0 ; 37 I=I+1 $37: AOS I ; IF(I.GT.KKL) GO TO 39 CAMLE I,KKL JRST $39 ; T1=DATA(IV(IJ),IS(I)) IS5: MOVE 03,777777(I) IMUL 03,MC IV18: ADD 03,777777(IJ) DATA5: MOVE T1,777777(3) ; T2=DATA(IV(II),IS(I)) IS6: MOVE 03,777777(I) IMUL 03,MC IV19: ADD 03,777777(II) DATA6: MOVE T2,777777(3) ; IF(T2.EQ.T1) GOTO 37 ; IF(T2.LT.T1) GO TO 5 ; GO TO 38 JSP P1,COMPAR ;DO THE COMPARE JRST $38 ;T1.LT.T2 JRST $37 ;T1.EQ.T2 JRST $5 ;T1.GT.T2 ; 39 IF(IV(II).LE.IV(IJ)) GO TO 5 $39: IV20: MOVE 02,777777(II) IV21: CAMG 02,777777(IJ) JRST $5 ; 38 ISAV=IV(IJ) $38: IV22: MOVE 02,777777(IJ) ; IV(IJ)=IV(II) IV23: EXCH 02,777777(II) ;IV(IJ) INTO IV(II) AND IV(II) INTO 02 ; IV(II)=ISAV IV25: MOVEM 02,777777(IJ) ;IV(II) INTO IV(IJ) ; GO TO 5 ; JRST $5 ; 5 DO 6 L=1,KKL $5: MOVEI L,1 M5: BLOCK 0 ; 6 GIP(L)=DATA(IV(IJ),IS(L)) $6: IS7: MOVE 03,777777(L) IMUL 03,MC IV26: ADD 03,777777(IJ) DATA7: MOVE 02,777777(3) MOVEM 02,GIP-1(L) CAMGE L,KKL AOJA L,M5 ; NEXTRA=IV(IJ) IV26.5: MOVE NEXTRA,777777(IJ) ; GO TO 15 JRST $15 ; 14 ISAV=IV(LL) $14: IV27: MOVE 02,777777(LL) ; IV(LL)=IV(K) IV28: EXCH 02,777777(K) ;IV(LL) INTO IV(K) AND IV(K) INTO 02 ; IV(K)=ISAV IV30: MOVEM 02,777777(LL) ;IV(K) INTO IV(LL) ; 15 LL=LL-1 $15: SOS LL ; I=0 MOVEI I,0 ; 40 I=I+1 $40: AOS I ; IF(I.GT.KKL) GO TO 41 CAMLE I,KKL JRST $41 ; T1=GIP(I) MOVE T1,GIP-1(I) ; T2=DATA(IV(LL),IS(I)) IS8: MOVE 03,777777(I) IMUL 03,MC IV31: ADD 03,777777(LL) DATA8: MOVE T2,777777(3) ; IF(T2.EQ.T1) GO TO 40 ; IF(T2.GT.T1) GO TO 15 ; GO TO 16 JSP P1,COMPAR ;DO THE COMPARE JRST $15 ;T1.LT.T2 JRST $40 ;T1.EQ.T2 JRST $16 ;T1.GT.T2 ; 41 IF(IV(LL).GT.NEXTRA) GO TO 15 $41: IV32: MOVE 02,777777(LL) CAMLE 02,NEXTRA JRST $15 ; 16 K=K+1 $16: AOS K ; I=0 MOVEI I,0 ; 42 I=I+1 $42: AOS I ; IF(I.GT.KKL) GO TO 44 CAMLE I,KKL JRST $44 ; T1=GIP(I) MOVE T1,GIP-1(I) ; T2=DATA(IV(K),IS(I)) IS9: MOVE 03,777777(I) IMUL 03,MC IV34: ADD 03,777777(K) DATA9: MOVE T2,777777(3) ; IF(T2.EQ.T1) GO TO 42 ; IF(T2.LT.T1) GO TO 16 ; GO TO 43 JSP P1,COMPAR ;DO THE COMPARE JRST $43 ;T1.LT.T2 JRST $42 ;T1.EQ.T2 JRST $16 ;T1.GT.T2 ; 44 IF(IV(K).LT.NEXTRA) GO TO 16 $44: IV35: MOVE 02,777777(K) CAMGE 02,NEXTRA JRST $16 ; 43 IF(K.LE.LL) GO TO 14 $43: CAMG K,LL JRST $14 ; IF((LL-II).LE.(J-K)) GO TO 17 MOVE 02,J SUB 02,K MOVN 03,II ADD 03,LL CAML 02,3 JRST $17 ; IL(M)=II MOVEM II,IL-1(M) ; IU(M)=LL MOVEM LL,IU-1(M) ; II=K MOVE II,K ; M=M+1 AOS M ; GOTO 19 JRST $19 ; 17 IL(M)=K $17: MOVEM K,IL-1(M) ; IU(M)=J MOVEM J,IU-1(M) ; J=LL MOVE J,LL ; M=M+1 ; GOTO 19 AOJA M,$19 ; 18 M=M-1 ; IF(M.EQ.0) GO TO 90 $18: SOJE M,$90 ; II=IL(M) MOVE II,IL-1(M) ; J=IU(M) MOVE J,IU-1(M) ; 19 IF((J-II).GE.11) GO TO 12 $19: MOVN 02,II ADD 02,J CAIL 02,13 JRST $12 ; IF(II.EQ.1) GO TO 11 CAIN II,1 JRST $11 ; C ; C BUBBLE SORT PORTION (FASTER THAN PARTITION ONLY IF SUBSET ; C BEING LOOKED AT IS 11 OBSERVATIONS OR LESS) ; C ; II=II-1 SOS II ; 20 II=II+1 $20: AOS II ; IF(II.EQ.J) GO TO 18 CAMN J,II JRST $18 ; I=0 MOVEI I,0 ; NEXTRA=IV(II+1) IV1A: MOVE NEXTRA,0(II) ; 45 I=I+1 $45: AOS I ; IF(I.GT.KKL) GO TO 47 CAMLE I,KKL JRST $47 ; T1=DATA(NEXTRA,IS(I)) IS10: MOVE 03,777777(I) IMUL 03,MC ADD 03,NEXTRA DATA10: MOVE T1,777777(3) ; T2=DATA(IV(II),IS(I)) IS11: MOVE 03,777777(I) IMUL 03,MC IV37: ADD 03,777777(II) DATA11: MOVE T2,777777(3) ; IF(T2.EQ.T1) GO TO 45 ; IF(T2.LT.T1) GO TO 20 ; GO TO 46 JSP P1,COMPAR ;DO THE COMPARE JRST $46 ;T1.LT.T2 JRST $45 ;T1.EQ.T2 JRST $20 ;T1.GT.T2 ; 47 IF(IV(II).LE.NEXTRA) GO TO 20 $47: IV38: CAML NEXTRA,777777(II) JRST $20 ; 46 K=II $46: MOVE K,II ; 21 IV(K+1)=IV(K) $21: IV39: MOVE 03,777777(K) IV2A: MOVEM 03,0(K) ; K=K-1 SOS K ; I=0 MOVEI I,0 ; 48 I=I+1 $48: AOS I ; IF(I.GT.KKL) GO TO 50 CAMLE I,KKL JRST $50 ; T1=DATA(NEXTRA,IS(I)) IS12: MOVE 03,777777(I) IMUL 03,MC ADD 03,NEXTRA DATA12: MOVE T1,777777(3) ; T2=DATA(IV(K),IS(I)) IS13: MOVE 03,777777(I) IMUL 03,MC IV40: ADD 03,777777(K) DATA13: MOVE T2,777777(3) ; IF(T2.EQ.T1) GOTO 48 ; IF(T1.LT.T2) GO TO 21 ; GO TO 49 JSP P1,COMPARE ;DO THE COMPARE JRST $21 ;T1.LT.T2 JRST $48 ;T1.EQ.T2 JRST $49 ;T1.GT.T2 ; 50 IF(NEXTRA.LT.IV(K)) GO TO 21 $50: IV41: CAMGE NEXTRA,777777(K) JRST $21 ; 49 IV(K+1)=NEXTRA $49: IV3A: MOVEM NEXTRA,0(K) ; GO TO 20 JRST $20 ; C ; C END SORT NOW PLACE TAGS IN CORRECT ORDER ; C ; 90 DO 91 J=1,NC $90: MOVEI J,1 M6: ; IF(IV(J).EQ.0) GOTO 91 IV42: MOVE 02,777777(J) JUMPE 02,$91 ; IF(IV(J).EQ.J) GO TO 91 IV43: CAMN J,777777(J) JRST $91 ; DO 92 K=1,NV MOVEI K,1 M9: BLOCK 0 ; 92 SP(K)=DATA(J,K) $92: MOVE 03,K IMUL 03,MC ADD 03,J DATA14: MOVE 02,777777(3) S$1: MOVEM 02,777777(K) CAMGE K,NV AOJA K,M9 ; M=J MOVEM J,M ; L=J MOVE L,J ; 93 DO 94 K=1,NV $93: MOVEI K,1 M11: BLOCK 0 ; 94 DATA(M,K)=DATA(IV(L),K) $94: MOVE 03,K IMUL 03,MC IV44: ADD 03,777777(L) DATA15: MOVE 02,777777(3) MOVE 03,K IMUL 03,MC ADD 03,M DATA16: MOVEM 02,777777(3) CAMGE K,NV AOJA K,M11 ; M=IV(L) IV45: MOVE 02,777777(L) MOVEM 02,M ; IV(L)=0 IV46: SETZM 777777(L) ; L=M MOVE L,M ; IF(IV(L).NE.J) GO TO 93 IV47: CAME J,777777(L) JRST $93 ; DO 96 K=1,NV MOVEI K,1 M13: BLOCK 0 ; 96 DATA(L,K)=SP(K) $96: MOVE 03,K IMUL 03,MC ADD 03,L S$2: MOVE 02,777777(K) DATA17: MOVEM 02,777777(3) CAMGE K,NV AOJA K,M13 ; IV(L)=0 IV48: SETZM 777777(L) ; 91 CONTINUE $91: CAMGE J,NC AOJA J,M6 ; RETURN ; END M14: MOVE 15,TEMP. MOVE 16,TEMP.+1 GOODBY (11) ; ROUTINE TO DO APPROPRIATE TYPE COMPARE ON T1,T2 ; USES ACS 2,3 IF ALPHA COMPARE ; RETURNS +1 IF T1.LT.T2 ; +2 IF T1.EQ.T2 ; +3 IF T1.GT.T2 COMPAR: XCT COMTYP ;DO SKIPN OR JRST JRST COMINT ;SIGNED INTEGER COMPARE TLC T1,(1B0) ;FLIP SIGN BIT TLC T2,(1B0) ;FLIP SIGN BIT COMINT: CAMGE T1,T2 ;COMPARE JRST (P1) ;T1.LT.T2 CAMG T1,T2 ;... JRST 1(P1) ;T1.EQ.T2 JRST 2(P1) ;T1.GT.T2 COMMENT * DATA AREA * TEMP.: BLOCK 2 NV: BLOCK 1 NC: BLOCK 1 MV: BLOCK 1 MC: BLOCK 1 KKL: BLOCK 1 IU: BLOCK ^D16 IL: BLOCK ^D16 GIP: BLOCK ^D25 PRGEND TITLE BUSY SEARCH FORPRM COMMENT % WRITTEN BY NORM GRANT. W.M.U. USAGE CALL BUSY(IDEV) WHERE IDEV: IS FORTRAN DEVICE NUMBER OF DESIRED DEVICE OR ASCII DEVICE NAME % HELLO (BUSY, ) ;BUSY ENTRANCE PUSHJ P,GTDV..## JUMPE 0,RETUR1 LOOPB: MOVE 0,2 DEVCHR TLNE 0,40 ;AVAILABLE? RETUR1: GOODBY (1) MOVEI 0,10 SLEEP 0, JRST LOOPB PRGEND TITLE CHKCHN ;WRITTEN BY RUSSELL R. BARR III - 7-DEC-77 - WMU. ;(WITH MUCH GRATEFUL THEFT FROM FORWMU.MAC, WRITTEN BY ;NORMAN D. GRANT - WMU) ; ;PURPOSE: ; FIND AN UNUSED FORTRAN UNIT NUMBER OR INQUIRE WHETHER A UNIT ; NUMBER IS IN USE, AND RETURN THAT NUMBER AND THE NUMBER OF THE ; ASSOCIATED SOFTWARE CHANNEL. ; ;USE: ; CALL CHKCHN(NMUNIT,NUMFND,NMSOFT) ; OR ; CALL CHKCHN(NMUNIT,NUMFND) ; WHERE: ; NMUNIT - FORTRAN UNIT NUMBER DESIRED ; 1-63 - UNIT NUMBER DESIRED ; 0(ZERO) - TO REQUEST ANY FREE UNIT NUMBER ; ; NUMFND - UNIT NUMBER FOUND ; 1-63 - FORTRAN UNIT NUMBER AVAILABLE ; 0(ZERO) - IF NONE AVAILABLE ; (OR REQUESTED UNIT NOT AVAILABLE) ; -1 - ARGUMENT RANGE ERROR ; ; NMSOFT - SOFTWARE CHANNEL RETURNED(OPTIONAL ARGUMENT) ; -1 - IF NMUNIT = 0 ; -1 - IF NMUNIT IS AVAILABLE ; 0-17 - IF NMUNIT IS NOT AVAILABLE ; SEARCH FORPRM HELLO (CHKCHN) PUSH P,2 ;SAV ACS PUSH P,3 SETZM @1(16) ;ZERO THE RETURNED UNIT # SETZM CHNFRE ;ZERO FREE CHANNEL NUMBER SETOM CHNSFT# ;# OF SOFTWARE CHANNEL MOVE 2,@0(16) ;GET ARGUMENT SETZM CHNFRE# ;# OF FREE CHANNEL MOVEI 0,^D15 ;# OF FREE CHANNELLS POSSIBLE MOVEM 0,NUMFRE# MOVNI 0,5 ;-5 IS LOOP LIMIT JUMPL 2,CKBADZ ;NO NEGATIVES ALLOWED CAILE 2,FLU.MX ;LEGAL UNIT #? JRST CKBADZ ;NO CKLUP: MOVE 2,0 ;GET COPY OF INDEX JUMPE 2,CHKINC ;UNIT 0 IS NOT ALLOWED CKLOOP: MOVEI 2,6(2) ;GET FOROTS INTERNAL FLU NUMBER IDIVI 2,6 ;SIX ENTRIES PER WORD IN OTS TABLE IMULI 3,6 ;# OF BITS LEFT ROT 3,-6 ;POSITION FOR BYTE POINTER HRRZ 1,.JBOPS## ;BASE FOR OTS DATA IOR 3,[POINT 6,FLU.TB(1),35] ;SET FULL SIZE ADDI 3,(2) ;POINT TO WORD ENTRY(SOFTWARE CHANNEL) LDB 2,3 ;LOAD CHANNEL ENTRY(SOFTWARE CHANNEL) MOVE 3,2 ;GET SOFTWARE CHANNEL ADDI 2,CHN.TB(1) ;SET OFSET FOR CHANNEL CONTROL WORD SKIPN (2) ;UNIT # FREE IF ZERO(PHYNAM IF NOT) JRST CKAVAL ;THIS UNIT # AVAILABLE SOS NUMFRE ;DECRIMENT NUMBER OF REMAINING FREE CHANELS SKIPN @(16) ;REQUESTS SPECIFIC UNIT #? JRST CHKINC ;NO, TRY NEXT CAME 0,@(16) ;YES,IS THIS THE ONE? JRST CHKINC ;NO, TRY NEXT MOVEM 3,CHNSFT ;RETAIN THE ASSOC. SOFTWARE CHANNEL JRST CHKINC ;MORE AVAILABLE, KEEP LOOKING CKAVAL: SKIPG NUMFRE ;ANY CHANNELS LEFT? JRST CHKINC ;NOPE? JUMPLE 0,CHKINC ;CAN'T RETURN NEG OR ZERO SKIPN @(16) ;REQUESTS SPECIFIC UNIT #? JRST CHKANY ;NO, RETURN ANY UNIT # CAME 0,@(16) ;YES, IS THIS THE ONE? JRST CHKINC ;THIS IS NOT THE ONE, TRY NEXT CHKANY: SKIPN CHNFRE ;FOUND A FREE CHANNEL YET? MOVEM 0,CHNFRE ;NO,SAVE LOWEST FREE FOUND CHKINC: ADDI 0,1 ;INCREMENT INDEX CAIG 0,FLU.MX ;END OF LIST? JRST CKLUP ;NO, GO BACK FOR ANOTHER MOVE 0,CHNFRE ;GET NUM OF FREE CHANNEL, IF ANY JUMPE 0,CKBAK ;JUMP IF NO FREE CHANNEL FOUND CKGOT: SKIPLE NUMFRE ;ANY LEFT? JRST CKGOTA ;YES SETZM CHNFRE ;CAN'T HAVE FREE UNIT #'S IF NO SOFT CHNLS JRST CKBAK ;NOPE CKGOTA: SKIPE @(16) ;SINGLE UNIT DESIRED? MOVE 0,@(16) ;YES, GET UNIT # DESIRED MOVEM 0,@1(16) ;RETURN INDEX TO ARG2 JRST CKBAK CKBADZ: SETOM @1(16) JRST CKBAK CKBAK: IFN F40LIB,< TLNN 16,-1 ;F10 CALL? JRST CHKF10 ;YES HLRZ 2,2(16) ;GET LEFT HALF FROM ARG BLOCK(3RD WORD) ANDI 2,777037 ;CLEAR AC BITS CAIN 2,(JUMP) ;ARG? JRST CKARG3 ;YES JRST CKARG2 ;NO, 2 ARGS ONLY CHKF10: > HLRE 2,-1(16) ;GET # OF ARGS MOVMS 2 ;MAKE IT POSITIVE CAIGE 2,3 ;3 ARGS? JRST CKARG2 ;LESS, WE'RE DONE CKARG3: SETOB 3,@2(16) SKIPN @0(16) ;SPECIFIC UNIT # REQUESTED? JRST CKNSFT ;NO, DON'T RETURN CHANNEL # SKIPN CHNFRE ;FOUND FREE CHANNEL? MOVE 3,CHNSFT ;NO, GET ASSCOC. SOFTWARE CHANNEL CKNSFT: MOVEM 3,@2(16) ;NO, STORE SOFTWARE CHANNEL CKARG2: POP P,3 ;RESTORE ACS POP P,2 GOODBY (3) PRGEND TITLE CHKDEV SEARCH FORPRM COMMENT % WRITTEN BY NORM GRANT. W.M.U. ASSIGN PURPOSE TO ASSIGN A DEVICE TO USER'S JOB.(TTY'S EXCLUDED) USAGE CALL ASSIGN(IDEV,IERR) OR CALL ASSIGN(IDEV,IERR,NSECS) WHERE IDEV: IS FORTRAN DEVICE NUMBER. IERR: ERROR CODE. IERR=-1 IF NO SUCH DEVICE OR DEVICE NOT ASSIGNABLE. IERR=0 IF DEVICE EXISTS. NSECS: MAXIMUM NUMBER OF SECONDS TO WAIT. IF NOT GIVEN, PROGRAM SLEEPS UNTIL DEVICE CAN BE ASSIGNED. DEASSI PURPOSE TO DEASSIGN A DEVICE FROM USER'S JOB.(TTY'S EXCLUDED) USAGE CALL DEASSI(IDEV) WHERE IDEV: IS FORTRAN DEVICE NUMBER. IF NOT ASSIGNED, CALL IS A NO-OP. REASSI PURPOSE TO TRANSFER AN ASSIGNED DEVICE TO ANOTHER JOB.(TTY'S EXCLUDED) USAGE CALL REASSI(IDEV,IJOB,IERR) WHERE IDEV: IS FORTRAN DEVICE NUMBER OF DEVICE. IJOB: IS JOB TO ASSIGN THE DEVICE TO. IERR: ERROR CODE. IERR=-1 IF DEVICE DOES NOT EXIST,IJOB DOES NOT EXIST, OR DEVICE CANNOT BE REASSIGNED. % OPDEF REASSI[CALLI 21] HELLO (ASSIGN, ) ;ASSIGN ENTRY SETOM @1(16) PUSHJ P,GTDV..## JUMPE 0,RETUR2 TLNE 0,DV.TTY JRST RETUR2 IFN F40LIB,< TLNN 16,-1 ;F10 CALL? JRST CHKF10 ;YES HLRZ 3,2(16) ;NO. F40 ANDI 3,777037 ;CLEAR AC BITS CAIE 3,(JUMP) ;ARG? JRST LOOPR ;NO JRST ARG3 ;YES. GET IT CHKF10:> HLRE 3,-1(16) ;GET -VE NUMBER OF ARGS MOVMS 3 ;GET ABS NUMBER CAIGE 3,3 ;AT LEAST THREE? JRST LOOPR ;NO. ARG3: SKIPA 3,@2(16) ;PICK UP ARG LOOPR: HRLOI 3,377777 ;SLEEP FOREVER IF NECESSARY MOVE 4,0 ANDI 4,177777 ;GET LEGAL MODES JFFO 4,.+1 ;FIRST BIT POSITION SUBI 5,^D35 ;-35 MOVM 4,5 ;ABS IS HIGHEST LEGAL MODE MOVE 5,2 ;SET UP OPEN BLOCK SETZ 6, ;NO BUFFERS LOOPR1: OPEN 0,4 ;TRY TO OPEN IT JRST [MOVEI 1,1 ;ONE SEC SLEEP 1, ;SLEEP IT SOJL 3,RETUR2 ; QUIT IF -VE JRST LOOPR1] PJOB 1, DRPOUT: REASSI 1, RELEAS 0,0 JUMPE 2,RETUR2 JUMPE 1,RETUR2 SETZM @1(16) RETUR2: GOODBY (2) HELLO (REASSI, ) ;REASSIGN ENTRY SETOM @2(16) PUSHJ P,GTDV.. MOVE 1,@1(16) AOJA 16,DRPOUT HELLO (DEASSI, ) ;DEASSIGN ENTRY PUSHJ P,GTDV.. SETZ 1, REASSI 1, GOODBY (1) PRGEND TITLE CHKNAM SUBTTL SUBROUTINE TO CHECK FILE-NAMES. SEARCH FORPRM COMMENT % WRITTEN BY NORM GRANT. WMU. CKNAME IS ASCII TO SIXBIT CONVERTER AND NAME CHECKER ; USAGE CALL CHKNAM(NAME,IERR) OR CALL CHKNAM(NAME,IERR,IEXT) WHERE NAME IS FILENAME.EXT(MUST BE A TWO WORD QUANTITY.) AND IERR IS ERROR CODE IERR=0 VALID NAME. IERR=-1 ILLEGAL NAME. IEXT: (IF PRESENT) IS -1 IF EXT. NOT NULL, 0 IF NULL. % NAME: BLOCK 2 HELLO (CHKNAM, ) SETZM @1(16) MOVEI 0,@0(16) ;GET ADDRESS OF NAME. HRRM 0,%1M PUSH P,16 MOVEI 16,%1M PUSHJ P,CKNAME## POP P,16 SKIPE IERR SETOM @1(16) IFN F40LIB,< TLNN 16,-1 ;F10 OR F40? JRST CHKF10 ;F10! HLRZ 0,2(16) TRZ 0,777 CAIE 0,(JUMP 0,0) GOODBY (2) JRST ARG3 CHKF10:> HLRE 1,-1(16) MOVMS 1 ;GET ABS NUMBER OF ARGS CAIGE 1,3 ;AT LEAST THREE? GOODBY (2) ;NO. LEAVE ARG3: SETZM @2(16) SKIPE NAME+1 SETOM @2(16) GOODBY (3) %1M: JUMP 0,0 JUMP 0,NAME JUMP 0,IERR# PRGEND TITLE DEVCHR SEARCH FORPRM COMMENT % WRITTEN BY NORM GRANT. W.M.U. DEVCHR PURPOSE TO DETERMINE THE CHARACTERISTICS OF A DEVICE USAGE CALL DEVCHR(IDEV,ICHAR) WHERE IDEV: IS FORTRAN UNIT NUMBER OF DEVICE. AND ICHAR: IS RETURNED DEVICE CHARACTERISTICS, AS FOLLOWS: BIT MEANING IF BIT IS SET 0 DECTAPE DIRECTORY IS IN CORE. 1 DEVICE IS A DISK. 2 DEVICE IS A CARD READER. 3 DEVICE IS A LINE PRINTER. 4 TTY ATTACHED TO JOB. 5 TTY IN USE AS A USER CONSOLE(EVEN IF DETACHED) 6 TTY IN USE AS I/O DEVICE. 7 DEVICE IS A DISPLAY. 8 DEVICE HAS A LONG DISPATCH TABLE(RECOGNIZES UUO'S OTHER THAN INPUT,OUTPUT,CLOSE, AND RELEAS) 9 DEVICE IS A PAPER TAPE PUNCH. 10 DEVICE IS A PAPER TAPE READER. 11 DEVICE IS A DECTAPE. 12 DEVICE IS AVAILABLE TO THIS JOB OR ALREADY ASSIGNED TO THIS JOB. 13 DEVICE IS A MAGNETIC TAPE. 14 DEVICE IS A TTY. 15 DEVICE HAS A DIRECTORY(DTA OR DSK) 16 DEVICE CAN DO INPUT. 17 DEVICE CAN DO OUTPUT. 18 DEVICE ASSIGNED BY CONSOLE COMMAND. 19 DEVICE ASSIGNED BY PROGRAM(INIT UUO) REMAINING BITS IF BIT (35-N) CONTAINS A 1, THEN MODE N IS LEGAL FOR THE DEVICE. % HELLO (DEVCHR, ) PUSHJ P,GTDV..## MOVEM 0,@1(16) GOODBY (2) PRGEND TITLE DEVICE COMMENT % USAGE CALL DEVICE(IDEV) WHERE IDEV IS FORTRAN DEVICE NUMBER WRITTEN BY NORM GRANT. WMU. DECEMBER 8,1970. THIS PROGRAM DETERMINES WHETHER PROGRAM IS RUNNING FROM TTY OR PTY,AND CALL EXIT IF FROM PTY. IF FROM TTY, IT TAKES A FORTRAN DEVICE NUMBER AND CHECKS WHETHER IT IS OTHER THAN TTY. IF IT IS, PROGRAM CALLS EXIT. OTHERWISE, NORMAL RETURN IS MADE. % SEARCH FORPRM HELLO (DEVICE, ) ;DEVICE ENTRY SETOM 1 ;MAKE LINE NEGATIVE. GETLCH 1 ;GET LINE CHARACTERISTICS. JUMPL 1,DOEXIT ;CALL EXIT IF LESS THAN ZERO(CONSOLE IS PTY) PUSHJ P,GTDV..## TLNE 0,DV.TTY GOODBY (1) ;IF USER IS ON TTY, AND DEVICE IS A TTY,RETURN. DOEXIT: MOVEI 16,[EXP 0,0]+1 ;ARG FOR EXIT. PUSHJ P,EXIT.## PRGEND TITLE DEVTYP SEARCH FORPRM COMMENT % USAGE CALL DEVTYP(IDEV,ICHAR) WHERE IDEV IS FORTRAN UNIT NUMBER OR ASCII DEVICE NAME ICHAR RETURNED WORD FROM DEVTYP UUO BIT MEANING 0 LOOKUP/ENTER MANDATORY. 1-11 RESERVED FOR FUTURE 12 DEVICE IS AVAILABLE TO THIS JOB. 13 SPOOLED ON DISK. (OTHER BITS REFLECT PROPERTIES OF READ DEVICE, EXCEPT VARIABLE BUFFER SIZE) 14 INTERACTIVE DEVICE (OUTPUT AFTER EACH BREAK CHARACTER) 15 CAPABLE OF VARIABLE BUFFER SIZE (USER CAN SET HIS OWN BUFFER LENGTHS) 16 CAPABLE OF INPUT 17 CAPABLE OF OUTPUT 18-26 JOB NUMBER THAT CURRENTLY HAS DEVICE ASSIGNED OR INITED 27-28 RESERVED FOR THE FUTURE 29 DEVICE IS A RESTRICTED DEVICE (I.E., CAN ONLY BE ASSIGNED BY A PRIVILEGED JOB OR THE MOUNT COMMAND) 30-35 DEVICE TYPE CODE (OCTAL) CODE MNEMONIC MEANING 0 DSK DISK OF SOME SORT 1 DTA DECTAPE 2 MTA MAGNETIC TAPE 3 TTY TTY OR EQUIVALENT 4 PTR PAPER-TAPE READER 5 PTP PAPER-TAPE PUNCH 6 DIS DISPLAY 7 LPT LINE PRINTER 10 CDR CARD READER 11 CDP CARD PUNCH 12 PTY PLOTTER 13 PLT PLOTTER 14 EXT EXTERNAL TASK 15 MPX SOFTWARE MPX 16 PAR PA611R ON DC44 17 YCR PC11(R) ON DC44 20 PAP PA611P ON DC44 21 LPC LPC-11 ON DC44 22 PCP PC-11(P) ON DC44 23-57 RESERVED FOR DIGITAL 60-77 RESERVED FOR CUSTOMER % OPDEF DEVTYP[CALLI 53] HELLO (DEVTYP) PUSHJ P,GTDV..## ;INTERPRET UNIT NUMBER DEVTYP 2, ;DO UUO SETZ 2, ;??? MOVEM 2,@1(16) ;RETURN ANSWER GOODBY 2 PRGEND TITLE DTRNAC SEARCH FORPRM COMMENT % WRITTEN BY NORM GRANT. W.M.U. PURPOSE RANDOM ACCESS ON DECTAPE. USAGE CALL DTRNAC(N,A,IA,IDTA,NWORDS) WHERE N: FIRST PHYSICAL BLOCK NUMBER DESIRED. 0 HLRE 0,-1(16) ;GET -VE NUMBER OF ARGS SKIPE LONG ;DID WE REALLY CALL EXISTS? HLRE 0,-2(16) ;YES. 16 HAS BEEN MODIFIED MOVMS 0 ;ABS NUMBER OF ARGS CAIGE 0,4 ;AT LEAST FOUR? JRST END1 ;NO. ARG4: HRLZ 0,@2(16) HRR 0,@3(16) MOVEM 0,NAME+3 ;STORE PPN FOR LOOKUP END1: OPEN 0,OPN ;INIT DSK. JRST ERMSG LOOKUP 0,NAME ;LOOKUP FILE. JRST NOFILE JRST RETURN ERMSG: OUTSTR [ASCIZ/ ERROR ON OPEN! /] ;PUT OUT ERROR MESSAGE JRST RETURN NOFILE: MOVEI 0,1 MOVEM 0,@1(16) RETURN: RELEAS 0,0 RETUR1: GOODBY (2) PRGEND TITLE FNDSPC - FIND STR WITH MOST FREE SPACE USEABLE BY US COMMENT % USAGE CALL FNDSPC(STR,IFREE) WHERE STR - IS THE ASCII NAME OF THE FILE STRUCTURE WITH THE MOST FREE SPACE ACCESSABLE BY THIS USER. IFREE - IS THE AMOUNT OF FREE SPACE ON STR AVAILABLE TO THE USER ON A FCFS BASIS % SEARCH FORPRM,UUOSYM N==3 STRBLK: BLOCK 2 ;JOBSTR BLOCK DSKBLK: BLOCK 3 ;DSKCHR BLOCK FILBLK: BLOCK .RBUSD+1 ;UFD LOOKUP BLOCK SAVSTR: BLOCK 1 ;SAVED STR NAME SAVSIZ: BLOCK 1 ;SAVED FREE SPACE HELLO (FNDSPC) SETOM STRBLK ;START AT BEGINNING MOVSI 0,'DSK' MOVEM 0,SAVSTR ;DEFAULT STR IS DSK SETZM SAVSIZ ;IS EMPTY NXTSTR: MOVE 0,[XWD 2,STRBLK] JOBSTR 0, ;GET NEXT STR JRST ENDSTR ;OOPS! MOVE 0,STRBLK ;GET STR NAME CAIE 0,0 ;FENCE? CAMN 0,[-1] ;OR END? JRST ENDSTR ;YES. END MOVEM 0,DSKBLK ;STORE FOR DSKCHR SKIPGE STRBLK+1 ;READ-ONLY? JRST NXTSTR ;YES. GET NEXT MOVE 0,[XWD 3,DSKBLK] DSKCHR 0, ;DSKCHR JRST NXTSTR ;OOPS? TLNE 0,140300 ;WRITE-LOCKED, ETC? JRST NXTSTR ;YES. IGNORE MOVE 0,DSKBLK+1 ;GET BLOCKS FCFS LEFT CAMN 0,[XWD 400000,0] ;DOES MONITOR KNOW? PUSHJ P,GETQUO ;NO. GET IT FROM UFD CAMLE 0,DSKBLK+2 ;QUOTA GREATER THAN FREE? MOVE 0,DSKBLK+2 ;YES. USE FREE CAMG 0,SAVSIZ ;BETTER THAN REMEMBERED ONE? JRST NXTSTR ;NO. GET NEXT MOVEM 0,SAVSIZ ;SAVE NEW GREATEST SIZE MOVE 1,STRBLK ;AND NAME MOVEM 1,SAVSTR ;... JRST NXTSTR ;LOOP AT ALL STRS ENDSTR: MOVE 0,SAVSIZ ;RETURN FREE SPACE MOVEM 0,@1(16) ;TO USER LDB 1,[POINT 4,0(L),12] PUSHJ P,TYPE..## ;GET SINGLE/DOUBLE PRECISION MOVE N,0 ;COPY IT MOVEI 2,@0(L) ;GET ARGUMENT ADDRESS MOVE 1,[ASCII " "];FIVE SPACES MOVEM 1,(2) ;STORE IT CAILE N,5 ;DOUBLE PRECISION ARG? MOVEM 1,1(2) ;YES. STORE IN SECOND WORD ALSO HRLI 2,440700 ;SET UP BYTE POINTER TO STORE NAME MOVE 1,SAVSTR ;GET STR NAME BACK RETNAM: SETZ 0, LSHC 0,6 JUMPE 0,RETFIN ;IF ZERO, NAME ENDS ADDI 0,40 IDPB 0,2 SOJG N,RETNAM RETFIN: GOODBY (2) ;AND RETURN TO USER GETQUO: MOVEI 0,16 ;OPEN IN DUMP MODE MOVE 1,STRBLK ;STR SETZ 2, ;NO BUFFERS OPEN 0,0 ;OPEN IT JRST GETQU2 ;CAN'T. ASSUME ZERO SETZM FILBLK ;CLEAR LOOKUP BLOCK MOVE 0,[XWD FILBLK,FILBLK+1] BLT 0,FILBLK+.RBUSD ;ENOUGH FOR QUOTA INFO MOVEI 0,25 ;SET RIBCNT MOVEM 0,FILBLK MOVSI 0,'UFD' ;EXTENSION MOVEM 0,FILBLK+.RBEXT GETPPN 0, ;OUR PPN JFCL MOVEM 0,FILBLK+.RBNAM ;IS NAME MOVE 0,[XWD 0,16] ;GET MFD PPN GETTAB 0, ;FROM MONITOR MOVE 0,[XWD 1,1] ;DEFAULT MOVEM 0,FILBLK+.RBPPN ;WHERE TO FIND UFD LOOKUP 0,FILBLK ;FIND IT JRST GETQU2 ;HUNH?? MOVE 0,FILBLK+.RBQTF ;GET FCFS SUB 0,FILBLK+.RBUSD ;MINUS USED GETQU1: RELEAS 0, ;FREE CHANNEL POPJ P, ;RETURN GETQU2: SETZ 0, ;ZERO QUOTA JRST GETQU1 ;DONE PRGEND TITLE MOUNTS - SUBROUTINE TO MOUNT AND DISMOUNT DEVICES SUBTTL COMMENTS SEARCH FORPRM COMMENT % USAGE CALL MOUNT(DEV,LOGNAM,LOCK,VID,PHYNAM,IERR) CALL MOUNT(DEV,LOGNAM,LOCK,VID,PHYNAM,IERR,REELID) WHERE DEV - IS ASCII NAME OF DEVICE TO MOUNT. THE NAME MAY BE PHYSICAL OR GENERIC, BUT MUST NOT BE A TTY, DSK, OR FILE STRUCTURE. ARGUMENT MAY BE SINGLE OR DOUBLE PRECISION. LOGNAM - IS LOGICAL NAME TO GIVE TO THE DEVICE. LOCK - SIGNAL WHETHER TO WRITE ENABLE TAPE. VALID ONLY FOR DECTAPE AND MAGTAPE. 0 = WRITE LOCKED 1 = WRITE ENABLED VID - VISUAL IDENTIFICATION STRING. ASCII STRING OF UP TO 25 LETTERS,DIGITS,PERIODS, AND HYPHENS TERMINATED BY A BLANK OR UP TO 50 CHARACTERS ENCLOSED IN QUOTES (' OR ") PHYNAM - IS PHYSICAL NAME OF DEVICE OBTAINED, IF ANY. THIS SHOULD BE A DOUBLE PRECISION ARGUMENT, SINCE 510/602 USES SIX CHARACTER DEVICE NAMES. IF THE ARGUMENT IS SINGLE PRECISION, ONLY FIVE CHARACTERS WILL BE RETURNED. IERR - IS AN ERROR CODE. 0 = NO ERRORS. DEVICE OBTAINED. 1 = DEV IS NOT RECOGNIZED OR DOES NOT EXIST 2 = LOGNAM IS ALREADY IN USE OR IS ZERO. 3 = NO MOUNT JOB RUNNING -1 = MOUNT UNSUCCESSFUL REELID - OPTIONAL ARGUMENT FOR MTA ONLY, GIVING REELID OF TAPE USAGE CALL DISMOU(LOGNAM,IERR) WHERE LOGNAM - IS LOGICAL OR PHYSICAL NAME OF DEVICE TO DISMOUNT IERR - IS ERROR CODE 0 = NO ERROR. DISMOUNT SUCCESSFUL 1 = ILLEGAL OR NONEXISTENT DEVICE NAME -1 = DISMOUNT UNSUCCESSFUL % SUBTTL DATA AREA CH=14 NUM=13 WD=12 M=11 N1=10 N=7 .ERPRT==2 .ERIPP==1 .ERFBM==3 .ERNRM==14 DSKCHN: XWD 400000,0 Z XWD OBUF,0 OBUF: BLOCK 3 SUBTTL CHECK ARGUMENTS FOR MOUNT HELLO (MOUNT, ) ;MOUNT ENTRANCE PUSHJ P,MNTON ;SEE IF THE RIGHT MOUNT IS RUNNING JRST ERR3 ;IT ISN'T MOVEI 3,0(L) ;GET SIXBIT ARGUMENT PUSHJ P,ASC6..## ;FROM USERS ASCII ONE JUMPE 2,ERR1 ;ERROR IF NO DEVICE MOVEM 2,PHYNAM# DEVCHR 2,200000 ;GET CHARACTERISTICS JUMPE 2,ERR1 ;DOESN'T EXIST TLNE 2,230010 ;IF DISK OR TTY, REJECT IT JRST ERR1 SKIPN @1(L) ;GET LOGNAM JRST ERR2 ;ZERO IS AN ERROR MOVEI 3,1(L) ;ADDRESS OF ARGUMENT PUSHJ P,ASC6..## ;CONVERT ARGUMENT TO SIXBIT JUMPE 2,ERR2 ;ZERO IN SIXBIT ALWAYS ILLEGAL MOVEM 2,LOGSIX# ;SAVE IT FOR LATER DEVCHR 2, JUMPN 2,ERR2 ;EXISTENCE OF LOGNAM IS AN ERROR SUBTTL ENTER MOUNT REQUEST MOVSI NUM,'M ' PUSHJ P,QSTART MOVEI M,[ASCIZ\ MOUNT \] PUSHJ P,MSG MOVE M,PHYNAM ;GET DEVICE GENERIC NAME PUSHJ P,SIXMSG ;OUT IT PUSHJ P,SPACE MOVE M,LOGSIX ;LOGICAL NAME DESIRED PUSHJ P,SIXMSG ;OUT IT MOVE 0,PHYNAM ;GET DEVICE NAME DEVCHR 0,200000 ;SEE WHAT IT IS TLNN 0,DV.MTA ;MAG TAPE? JRST NOREEL ;NO. DON'T LOOK FOR REELID IFN F40LIB,< TLNN L,-1 ;IS IT F40 CALL? JRST REEF10 ;NO. F10 HLRZ 0,6(L) ;GET ARG WORD ANDI 0,777037 ;CLEAR AC BITS CAIE 0,(JUMP) ;IS IT AN ARG? JRST NOREEL ;NO JRST REELID ;YES. GET IT REEF10:> HLRE 0,-1(L) ;GET ARG COUNT MOVN 0,0 ;MAKE IT POSITIVE CAIGE 0,^D7 ;AT LEAST NUMBER 7 JRST NOREEL ;NO. NO REELID REELID: SKIPN 3,@6(L) ;ANY ARGUMENT? JRST NOREEL ;NO MOVEI 3,6(L) ;ADDRESS OF REELID ARGUMENT PUSHJ P,ASC6..## ;CONVERT IT TO SIXBIT JUMPE 2,NOREEL ;ANY NOW? MOVEI M,[ASCIZ" /REELID: "] PUSHJ P,MSG ;PUT SWITCH IN FILE MOVE M,2 ;MOVE ID PUSHJ P,SIXMSG ;PUT IT IN FILE NOREEL: LDB CH,[POINT 7,@3(L),6] SETZM VIDCNT# ;COUNT OF CHARACTERS IN VID SETZM VIDQT# ;FLAG FOR QUOTES AROUND VID SKIPE @3(L) ;ANY ID? PUSHJ P,VIDCH ;IS EVEN THE FIRST CHARACTER LEGAL? JRST VIDDON ;NO MOVEI M,[ASCIZ\ /VID:\] PUSHJ P,MSG SETZM VIDCNT# ;COUNT OF CHARACTERS IN VID SETZM VIDQT# ;FLAG FOR QUOTES AROUND VID MOVEI 1,@3(L) HRLI 1,440700 VIDOU2: ILDB CH,1 PUSHJ P,VIDCH JRST VIDDON ;NOT LEGAL CHARACTER SO DONE PUSHJ P,W.CMD JRST VIDOU2 VIDDON: MOVE 0,PHYNAM DEVCHR 0,200000 TLNN 0,DV.DTA!DV.MTA ;DECTAPE OR MAGTAPE? JRST NOSWIT ;NEITHER. NO /WX MOVEI M,[ASCIZ\ /WL\] SKIPE @2(L) MOVEI M,[ASCIZ\ /WE\] PUSHJ P,MSG NOSWIT: PUSHJ P,CRLF CLOSE 0, RELEAS 0, MOVE 0,SVJBFF MOVEM 0,.JBFF PUSHJ P,WAITUP ;WAIT WHILE OMOUNT PROCESS IT LDB 1,[POINT 4,4(L),12] PUSHJ P,TYPE..## ;GET SINGLE/DOUBLE PRECISION MOVE N,0 ;COPY IT MOVEI 2,@4(L) ;GET ARGUMENT ADDRESS MOVE 1,[ASCII " "];FIVE SPACES MOVEM 1,(2) ;STORE IT CAILE N,5 ;DOUBLE PRECISION ARG? MOVEM 1,1(2) ;YES. STORE IN SECOND WORD ALSO HRLI 2,440700 ;SET UP BYTE POINTER TO STORE NAME MOVE 1,LOGSIX ;GET BACK LOGICAL NAME DEVNAM 1, ;IS IT DEFINED? (GET PHYSICAL NAME IN 1) JRST ERRM1 ;NO. BAD MOUNT RETNAM: SETZ 0, LSHC 0,6 JUMPE 0,RETFIN ;IF ZERO, NAME ENDS ADDI 0,40 IDPB 0,2 SOJG N,RETNAM RETFIN: SETZM @5(L) GOODBY (6) SUBTTL ERROR ROUTINES ERRM1: MOVE 2,PHYNAM ;SEE IF PROBLEM IS "NOT AVAILABLE" DEVCHR 2,200000 TLNN 2,40 ;IS IT? JRST ERR4 ;YES. GIVE THAT ERROR SETOM @5(L) GOODBY (6) ERR4: MOVEI 0,4 JRST ERR3A ERR1: MOVEI 0,1 JRST ERR3A ERR2: MOVEI 0,2 JRST ERR3A ERR3: MOVEI 0,3 ERR3A: MOVEM 0,@5(L) GOODBY (6) ERRD1: MOVEI 0,1 ERRD1A: MOVEM 0,@1(L) GOODBY (2) ERRDM1: SETOM @1(L) GOODBY (2) ERRD2: SKIPE REASAN# ;SUCCESSFUL DEASSIGN JRST ERRDM1 ;NO SETZM @1(L) ;YES GOODBY (2) ;RETURN SUBTTL DISMOUNT COMMAND HELLO (DISMOU, ) ;DISMOUNT ENTRY SKIPN @0(L) JRST ERRD1 MOVEI 3,0(16) ;ADDRESS OF ARGUMENT PUSHJ P,ASC6..## ;CONVERT TO SIXBIT JUMPE 2,ERRD1 ;BLANK IS AN ERROR MOVEM 2,LOGSIX ;AND SAVE IT FOR LATER DEVCHR 2, ;GET CHARACTERISTICS. JUMPE 2,ERRD1 ;NON-EXISTENCE IS AN ERROR MOVE 0,LOGSIX DEVNAM 0, MOVE 0,LOGSIX ;TAKE WHAT WAS GIVEN IF IT WON'T TELL MOVEM 0,PHYNAM TLNE 2,DV.DTA!DV.MTA ;DECTAPE OR MAGTAPE? PUSHJ P,UNLOAD ;YES. DO UNLOAD MOVE 1,LOGSIX ;DO DEASSIGN FIRST FOR OMOUNT VERSION 26 SETZ 0, REASSI 0, MOVEM 0,REASAN# ;STORE ANSWER FROM REASSIGN PUSHJ P,MNTON ;MAKE SURE MOUNT IS RUNNING JRST ERRD2 ;NOT THERE MOVSI NUM,'D ' PUSHJ P,QSTART MOVEI M,[ASCIZ/ DISMOUNT /] PUSHJ P,MSG MOVE M,PHYNAM PUSHJ P,SIXMSG MOVEI M,[ASCIZ\ /R\] PUSHJ P,MSG PUSHJ P,CRLF CLOSE 0, RELEAS 0, MOVE 0,SVJBFF MOVEM 0,.JBFF ;RESTORE .JBFF PUSHJ P,WAKEUP ;WAKE UP OMOUNT JRST ERRD2 ;SEE WHETHER DEASSIGN WORKED, AND RETURN UNLOAD: MOVEI 0,16 ;OPEN TAPE IN DUMP MODE MOVE 1,LOGSIX SETZ 2, OPEN 0,0 POPJ P, ;OH WELL MTAPE 0,11 ;UNLOAD TAPE RELEAS 0, ;AND GET RID OF IT POPJ P, ;RETURN SUBTTL CONSTRUCT FIRST PART OF QUEUE ENTRY QSTART: MOVE 0,[XWD 4,16] GETTAB ;GET PPN FOR QUEUE AREA MOVE 0,[XWD 3,3] ;DEFAULT IS 3,3 MOVEM 0,CMDPPN# MOVE 0,[XWD 15,16] GETTAB ;GET STRUCTURE FOR QUEUE AREA MOVSI 0,'DSK' MOVEM 0,DSKCHN+1 PJOB MOVEM 0,THSJOB# GETLIN MOVEM 0,TTYLIN# GETPPN JFCL MOVEM 0,USRPPN# TSO 0,0 ;OR HALFS SWAPPED HRRZM 0,IORPPN# OPEN 0,DSKCHN HALT . SETZM CMDNAM# MOVEI 0,^D10 MOVEM 0,ENTERS# FILCL1: HLLZ WD,NUM TIMER CH, ;FORM A NAME ANDI CH,7777 ;TWELVE BITS FROM TIMER TLO WD,(CH) ;IN LEFT HALF OF WORD IOR WD,IORPPN ;RH OF NAME IS IOR'D PPN CAMN WD,CMDNAM JRST FILCL1 ;DON'T RETRY SAME NAME MOVEM WD,CMDNAM ;STORE NAME MOVE 0,CMDNAM MOVSI 1,'CMD' SETZ 2, MOVE 3,CMDPPN LOOKUP 0,0 ;IS THIS NAME FREE? TRNE 1,-1 ;MAYBE JRST FILCL1 ;NO MOVSI 1,'CMD' SETZ 2, MOVE 3,CMDPPN ENTER 0,0 JRST ENTFAI ;CHECK ON ENTER FAILURE MOVE 0,.JBFF## MOVEM 0,SVJBFF# OUTBUF 0,1 MOVE M,NUM PUSHJ P,SIXMSG MOVEI M,[ASCIZ/ JOB/] PUSHJ P,MSG MOVE N,THSJOB ;JOB NUMBER PUSHJ P,DECPRT PUSHJ P,SPACE SKIPN M,TTYLIN MOVE M,[SIXBIT/TTYXXX/] PUSHJ P,SIXMSG PUSHJ P,SPACE HLRZ N,USRPPN PUSHJ P,OCTPRT PUSHJ P,COMMA HRRZ N,USRPPN PUSHJ P,OCTPRT PUSHJ P,SPACE MOVSI M,'1 ' PUSHJ P,SIXMSG POPJ P, ENTFAI: HRRZS 1 SOSG ENTERS JRST ENTFI1 CAIN 1,.ERPRT ;PROTECTION FAILURE? JRST FILCL1 ;YES, TRY ANOTHER NAME. CAIN 1,.ERFBM ;FILE BEING MODIFIED? JRST FILCL1 ;YES, TRY ANOTHER NAME ENTFI1: MOVEI M,[ASCIZ/?SYSTEM ERROR ENTERING MOUNT REQUEST /] CAIN 1,.ERNRM ;OUT OF ROOM? MOVEI M,[ASCIZ/?NO ROOM TO ENTER MOUNT REQUEST /] CAIN 1,.ERIPP ;NO SUCH UFD? MOVEI M,[ASCIZ/?NO UFD FOR MOUNT REQUEST /] OUTSTR 0(M) HALT . SUBTTL IO SUBROUTINES SPACE: MOVEI CH," " PJRST W.CMD COMMA: MOVEI CH,"," ; PJRST W.CMD W.CMD: SOSLE OBUF+2 JRST W.CDOK OUTPUT 0,0 STATZ 0,740000 ;ANY ERRORS? HALT . W.CDOK: IDPB CH,OBUF+1 POPJ P, CRLF: MOVEI M,[ASCIZ/ /] MSG: HRLI M,440700 MSGL: ILDB CH,M JUMPE CH,CPOPJ PUSHJ P,W.CMD JRST MSGL OCTPRT: IDIVI N,10 HRLM N1,0(P) SKIPE N PUSHJ P,OCTPRT HLRZ CH,0(P) ADDI CH,"0" PJRST W.CMD DECPRT: IDIVI N,^D10 HRLM N1,0(P) SKIPE N PUSHJ P,DECPRT HLRZ CH,0(P) ADDI CH,"0" PJRST W.CMD SIXMSG: PUSH P,M MOVE M,[POINT 6,0(P)] SIXMSL: ILDB CH,M JUMPE CH,MPOPJ ;STOP ON FIRST NULL ADDI CH,40 PUSHJ P,W.CMD TLNE M,770000 ;OR ON SIX OUT JRST SIXMSL MPOPJ: POP P,M POPJ P, SUBTTL MISC. VIDCH: SKIPE VIDQT ;IN QUOTES? JRST QUOTVD ;YES. SKIPE VIDCNT ;FIRST CHARACTER? JRST VIDCHO ;NO. OLD KIND CAIE CH,"'" ;IS IT QUOTED? CAIN CH,42 ;(") JRST QTVID ;YES. REMEMBER VIDCHO: AOS 2,VIDCNT ;COUNT CHARACTERS CAILE 2,^D25 ;ALREADY DONE 25? POPJ P, ;YES CAIE CH,"." CAIN CH,"-" JRST CPOPJ1 CAIL CH,"0" CAILE CH,"Z" JRST CPOPJ CAILE CH,"9" CAIL CH,"A" JRST CPOPJ1 JRST CPOPJ QTVID: MOVEM CH,VIDQT ;REMEMBER THE QUOTES AOS VIDCNT ;REMEMBER THE CHARACTER JRST CPOPJ1 ;RETURN QUOTVD: CAMN CH,VIDQT ;CLOSING QUOTE? PJRST W.CMD AOS 2,VIDCNT ;OR LIMIT REACHED? CAILE 2,^D50 ;... POPJ P, ;YES CAIL CH,40 ;LESS THAN A SPACE? CAIL CH,175 ;AND LESS THAN OLD ALTMODES? POPJ P, ;RETURN. DONE JRST CPOPJ1 ;OK WAITUP: PUSHJ P,WAKEUP WAIT1: MOVEI 0,5 MOVE 1,[XWD ^D60000,400024] HIBER 1, SLEEP OPEN 0,DSKCHN JRST WAIT1 MOVE 0,CMDNAM MOVSI 1,'CMD' SETZ 2, MOVE 3,CMDPPN LOOKUP 0,0 ;SEE IF IT IS STILL THERE TRNE 1,-1 ;MAYBE JRST WAIT1 ;YES RELEAS 0, ;GET RID OF CHANNEL POPJ P, WAKEUP: MOVEI 1,1 WAKE1: HRLZ 0,1 HRRI 0,2 ;LOOK AT PPN GETTAB SETZ 0, CAME 0,[XWD 1,2] ;IS IT 1,2? JRST WAKEND HRLZ 0,1 HRRI 0,3 ;GET NAME GETTAB SETZ 0, CAME 0,[SIXBIT/OPROMO/] CAMN 0,[SIXBIT/OPRMNT/] JRST .+2 JRST WAKEND MOVE 0,1 WAKE POPJ P, ;GIVE UP ON FAILURE WAKEND: CAMGE 1,JOBS ;DONE YET? AOJA 1,WAKE1 ;NO POPJ P, MNTON: MOVE 0,[XWD 15,11] ;GET NUMBER OF JOBS GETTAB MOVEI 0,^D64+1 ;DEFAULT IF WON'T TELL HRRZS 0 SUBI 0,1 ;DON'T COUNT NULL JOB MOVEM 0,JOBS# MOVEI 1,1 ;START WITH JOB 1 RUNLOP: HRLZ 2,1 HRRI 2,2 ;SET UP TO LOOK AT PPN GETTAB 2, SETZ 2, CAME 2,[XWD 1,2] ;IS IT 1,2? JRST RUNEND ;NO HRLZ 2,1 HRRI 2,3 ;LOOK AT PROG NAME GETTAB 2, SETZ 2, CAME 2,[SIXBIT/OPROMO/] CAMN 2,[SIXBIT/OPRMNT/] JRST CPOPJ1 RUNEND: CAMGE 1,0 AOJA 1,RUNLOP ;NOT DONE, SO LOOP SKIPA CPOPJ1: AOS (P) CPOPJ: POPJ P, PRGEND TITLE RENAMS SUBTTL SUBROUTINE TO RENAME,PROTECT, AND DELETE FILE. REMARK WRITTEN BY NORM GRANT. WMU. REMARK CKNAME IS AN ASCII TO SIXBIT CONVERTER AND NAME CHECKER. SEARCH FORPRM ; COMMENT % USAGE CALL DELETE(NAME) CALL PROTEK(PROT,NAME) CALL RENAME(NAME1,NAME2) CALL RENAMS(IDEV,IFUNCT,NAME1,NAME2,PROT) WHERE NAME1 ASCII FILE NAME, TWO WORD,CURRENT FILE NAME. NAME2 ASCII FILE NAME, TWO WORD, DESIRED FILE NAME. IDEV FORTRAN DEVICE NUMBER. IFUNCT FUNCTION TO PERFORM. 1:DELETE 2:PROTECT 3:RENAME 4:RENAME AND PROTECT 5:DELETE EXISTING FILE OF NAME2,AND RENAME 6:DELETE EXISTING FILE OF NAME2, RENAME, AND PROTECT OTHER: NO OPERATION. PROT OCTAL PROTECTION CODE. % -3,,0 CK1: JUMP 0,0 JUMP 0,NAME JUMP 0,IERR# -5,,0 %1M: JUMP 0,[0] JUMP 0,[1] D1: JUMP 0,0 JUMP 0,[0] JUMP 0,[0] -5,,0 %2M: JUMP 0,[0] JUMP 0,[2] $P2: JUMP 0,0 JUMP 0,[0] $P1: JUMP 0,0 -5,,0 %3M: JUMP 0,[0] JUMP 0,[3] R1: JUMP 0,0 R2: JUMP 0,0 JUMP 0,[0] HELLO (DELETE, ) ;DELETE ENTRY MOVEI 0,@0(16) HRRM 0,D1 PUSH P,16 MOVEI 16,%1M PUSHJ P,RENAMS POP P,16 GOODBY (1) HELLO (PROTEK, ) ;PROTECT ENTRY MOVEI 0,@0(16) HRRM 0,$P1 MOVEI 0,@1(16) HRRM 0,$P2 PUSH P,16 MOVEI 16,%2M JRST PREREN HELLO (RENAME, ) ;RENAME ENTRY MOVEI 0,@0(16) HRRM 0,R1 MOVEI 0,@1(16) HRRM 0,R2 PUSH P,16 MOVEI 16,%3M PREREN: PUSHJ P,RENAMS POP P,16 GOODBY (2) HELLO (RENAMS, ) ;RENAMS ENTRY MOVE 1,@0(16) JUMPE 1,UNDEF PUSHJ P,GTDV..## JUMPN 0,BOTH UNDEF: MOVSI 2,'DSK' MOVE 0,2 ;COPY DEVICE NAME DEVCHR 0, ;SIMULATE GTDV.. BOTH: MOVEM 2,DEVICE ANDI 0,177777 JFFO 0,.+1 SUBI 1,^D35 MOVMS 1 HRRM 1,INITS ;STORE MODE FOR INIT MOVEM P,SAVP# SETZM NAME+3 MOVE 14,@1(16) JUMPLE 14,RETURN CAILE 14,6 JRST RETURN PUSHJ P,@LIST-1(14) JRST RETURN LIST: EXP DEL,PRO,PRO,PRO,DELREN,DELREN DEL1: MOVEI 1,@3(16) CAIA DEL: MOVEI 1,@2(16) HRRM 1,CK1 PUSHJ P,CHNAME PUSHJ P,INITS LOOKUP 0,NAME POPJ P, SETZM NAME SETZM NAME+1 SETZM NAME+3 RENAME 0,NAME JFCL POPJ P, PRO: MOVEI 1,@2(16) HRRM 1,CK1 PUSHJ P,CHNAME PUSHJ P,INITS AGAIN: LOOKUP 0,NAME JRST NOFIL SETZM NAME+3 CAIG 14,2 JRST PRO1 MOVE 1,3(16) HRRM 1,CK1 PUSH P,NAME+1 PUSHJ P,CHNAME POP P,0 HRRM 0,NAME+1 ;DON'T MESS UP HIGH ORDER DATE PRO1: MOVE 0,14 IDIVI 0,2 JUMPN 1,PRO2 MOVE 0,@4(16) DPB 0,[POINT 9,NAME+2,8] PRO2: RENAME 0,NAME JRST RENERR POPJ P, DELREN: PUSHJ P,DEL1 JRST PRO RETURN: MOVE P,SAVP RELEAS 0,0 GOODBY (5) NAME: BLOCK 4 BADNAM: OUTSTR [ASCIZ/ILLEGAL FILENAME./ ] JRST RETURN NODEV: OUTSTR [ASCIZ/ DEVICE NOT AVAILABLE. /] JRST RETURN RENERR: OUTSTR [ASCIZ/RENAME ERROR! /] JRST RETURN NOFIL: HLLZ 0,NAME+1 JUMPN 0,TYPEIT MOVSI 0,'DAT' MOVEM 0,NAME+1 JRST AGAIN TYPEIT: OUTSTR [ASCIZ/NO SUCH FILE. /] JRST RETURN INITS: INIT 0,16 DEVICE: 0 0 JRST NODEV POPJ P, CHNAME: PUSH P,16 MOVEI 16,CK1 PUSHJ P,CKNAME## POP P,16 SKIPN IERR POPJ P, JRST BADNAM PRGEND TITLE CKNAME SUBTTL SUBROUTINE TO TRANSLATE FILENAMES. REMARK WRITTEN BY NORM GRANT. WMU. SEARCH FORPRM COMMENT % USAGE CALL CKNAME(NAME1,NAME2,IERR) WHERE NAME IS FILENAME.EXT(MUST BE A TWO WORD QUANTITY.) NAME2: FILENAME.EXT IN SIXBIT FORMAT(TWO WORDS.) (RETURNED.) IERR: ERROR CODE RETURNED. IERR=0 ALL RIGHT. IERR=-1 ILLEGAL. IERR=1 WARNING. IMBEDDED SPACE(S)OR OVERLENGTH NAME. % POINTN: POINT 7,0, ;POINTER TO ASCII NAME. POINTS: POINT 6,NAME, ;POINTER TO SIXBIT NAME. POINTE: POINT 6,NAME+1, ;POINTER TO SIXBIT EXTENSION. POINT: 0 NAME: BLOCK 2 ;FILE-NAME BLOCK. ; HELLO (CKNAME, ) SETZ 4, SETZM @2(16) MOVSI 0,440700 ;SET UP POINTER TO NAME ADDI 0,@0(16) MOVEM 0,POINTN ;STORE POINTER TO ASCII NAME. MOVE 0,POINTS MOVEM 0,POINT ;STORE POINTER TO SIXBIT NAME. SETZM NAME ;ZERO SIXBIT NAME AND EXTENSION. SETZM NAME+1 MOVEI 3,^D10 MOVEI 1,6 ;SET COUNTER TO 6 CHARACTERS MAXIMUM. L1: ILDB 2,POINTN ;LOAD CHARACTER TO AC2. SOJ 3, CAIN 2,"." JRST ENDNAM ;IF PERIOD, END FILE-NAME. JSR CHK SOJG 1,L1 ;CHECK FOR END OF LOOP, AND JUMP ELSE. ILDB 2,POINTN ;CHECK FOR NULL EXTENSION. SOJ 3, CAIE 2,"." JRST BLANK1 ENDNAM: SETO 4, MOVEI 1,3 ;SET COUNTER TO 3 CHARACTERS MAXIMUM. MOVE 0,POINTE MOVEM 0,POINT ;STORE POINTER TO SIXBIT EXTENSION. L2: ILDB 2,POINTN SOJ 3, JSR CHK SOJG 1,L2 ;CHECK FOR END OF LOOP. ENDEXT: END1: SKIPN NAME ILNAM: SETOM @2(16) RETURN: MOVEI 0,@1(16) SOJ 0, PUSH 0,NAME PUSH 0,NAME+1 GOODBY (3) BLANK: SOJL 3,ENDEXT ILDB 2,POINTN BLANK1: CAIN 2," " JRST BLANK IMBED: MOVEI 0,1 MOVEM 0,@2(16) JRST END1 CHK: 0 CAIN 2," " JRST BLANK ;IF SPACE, END FILE-NAME AND EXTENSION. CAIGE 2,"0" JRST ILNAM ;CHECK FOR ILLEGAL CHARACTERS. CAIG 2,"9" JRST OKBIT CAIL 2,"A" CAILE 2,"Z" JRST ILNAM OKBIT: MOVEI 2,40(2) ;CONVERT TO SIXBIT. IDPB 2,POINT ;AND STORE IN NAME BLOCK. JRST @CHK PRGEND TITLE GTDV.. SEARCH FORPRM IFNDEF FTWMU, ENTRY GTDV.. GTDV..: LDB 1,[POINT 4,@0(16),12] ;GET ARG TYPE PUSHJ P,TYPE..## ;AND FIND IF ITS DOUBLE CAIE 0,5 ;SINGLE? JRST ASCII2 ;NO. MOVE 1,@0(16) ;GET DEVICE NAME OR NUMBER JUMPE 1,ERMSG ;ZERO IS ILLEGAL SETCM 2,1 ;COMPLEMENT IT TLNN 2,-1 ;DEFAULT DEVICE? JRST NEG ;YES TLNE 1,-1 ;ASCII DEVICE NAME JRST ASCII2 ;YES MOVEI 2,6(1) ;GET FOROTS INTERNAL FLU NUMBER CAILE 2,FLU.MX+6 ;IN RANGE? JRST ERMSG ;NO. ILL NUMBER IDIVI 2,6 ;SIX ENTRIES PER WORD IMULI 3,6 ;NUMBER OF BITS LEFT ROT 3,-6 ;POSITION FOR THE BYTE POINTER HRRZ 4,.JBOPS## ;BASE FOR OTS DATA IOR 3,[POINT 6,FLU.TB(4),35];SET THE SIZE FIELD ADDI 3,(2) ;POINT TO THE WORD ENTRY LDB 2,3 ;LOAD THE CHANNEL ENTRY ADDI 2,CHN.TB(4) ;SET THE OFFSET FOR CHANNEL CONTROL WD SKIPN 3,(2) ;GET THE I/O REG JRST TRYLOG ;NOT OPEN. TRY LOGICAL NAME MOVE 2,DD.DEV(3) ;GET DEVICE MOVE 0,DD.STS(3) ;GET DEVCHR STORED BY FOROTS POPJ P, ;RETURN TRYLOG: MOVE 2,1 ANDI 2,77 IDIVI 2,^D10 LSH 2,6 IORI 2,2020(3) CAIGE 2,2120 ;SIXBIT 10, RIGHT JUSTIFIED LSH 2,6 LSH 2,^D24 MOVE 0,2 DEVCHR 0, JUMPN 0,CPOPJ GETDV1: IFN FTWMU,< MOVE 3,.JBOPS## CAMLE 1,DEV.SZ(3) ;ABOVE MAXIMUM? JRST DEFDSK ;YES, ASSUME DSK MOVE 3,DEV.TB(3) ;ADDRESS OF DEVTAB ADDI 3,(1) ;OFFSET FROM DEVTAB SKIPN 2,(3) ;GET DEVICE NAME > IFE FTWMU,< CAILE 1,DEV.SZ ;ABOVE MAXIMUM? JRST DEFDSK ;YES, ASSUME DSK SKIPN 2,DEVTB.(1) ;GET DEVICE NAME > DEFDSK: MOVSI 2,'DSK' ;NO. USE DSK JRST DODEV ;NOW GO RETURN DEVCHR NEG: CAML 1,[-5] ;NEGATIVE NUMBER OK? JRST GETDV1 ;YES ASCII2: MOVEI 3,0(16) ;ADDRESS OF ARG POINTER PUSHJ P,ASC6..## ;GET SIXBIT FOR NAME DODEV: MOVE 0,2 DEVCHR 0, CPOPJ: POPJ P, ERMSG: OUTSTR [ASCIZ/ILLEGAL DEVICE NUMBER! /] MOVEI 16,[EXP 0,0]+1 ;ARG FOR EXIT PUSHJ P,EXIT.## IFE FTWMU,< ;COPY FOR DEVTB. SIXBIT .REREAD. ;-6; REREAD SIXBIT .CDR. ;-5; READ SIXBIT .TTY. ;-4; ACCEPT SIXBIT .LPT. ;-3; PRINT SIXBIT .PTP. ;-2; PUNCH SIXBIT .TTY. ;-1; TYPE DEVTB.: Z ;00; ILLEGAL DEVICE NUMBER SIXBIT .DSK. ;01; DISC SIXBIT .CDR. ;02; CARD READER SIXBIT .LPT. ;03; LINE PRINTER SIXBIT .CTY. ;04; CONSOLE TELETYPE SIXBIT .TTY. ;05; USER'S TELETYPE SIXBIT .PTR. ;06; PAPER TAPE READER SIXBIT .PTP. ;07; PAPER TAPE PUNCH SIXBIT .DIS. ;08; DISPLAY SIXBIT .DTA1. ;09; DECTAPE SIXBIT .DTA2. ;10; SIXBIT .DTA3. ;11; SIXBIT .DTA4. ;12; SIXBIT .DTA5. ;13; SIXBIT .DTA6. ;14; SIXBIT .DTA7. ;15; SIXBIT .MTA0. ;16; MAG TAPE SIXBIT .MTA1. ;17; SIXBIT .MTA2. ;18; SIXBIT .FORTR. ;19; SIXBIT .DSK. ;20; SIXBIT .DSK. ;21; SIXBIT .DSK. ;22; SIXBIT .DSK. ;23; SIXBIT .DSK. ;24; SIXBIT .DEV1. ;25; SIXBIT .DEV2. ;26; SIXBIT .DEV3. ;27; SIXBIT .DEV4. ;28; SIXBIT .CDP. ;29; SIXBIT .TTY. ;30; DEV.SZ==.-DEVTB.-1 > PRGEND TITLE ASC6.. SEARCH FORPRM ENTRY ASC6.. CH==14 ;USAGE MOVEI 3,ADR OF ARGUMENT POINTER ; PUSHJ P,ASC6..## ; ALWAYS RETURNS HERE WITH SIXBIT IN 2 ; USES 0,1,2,3,4,14 ASC6..: LDB 1,[POINT 4,(3),12] ;GET TYPE OF ARGUMENT PUSHJ P,TYPE..## ;GET NUMBER OF CHARACTERS TO READ MOVEI 3,@(3) ;GET ADDRESS OF STRING HRLI 3,440700 ;AND SET UP POINTER MOVE 4,[POINT 6,2] SETZ 2, ASCSX1: ILDB CH,3 CAIG CH," " POPJ P, CAIGE CH,140 ;LOWER CASE DOESN'T NEED THE +40 ADDI CH,40 IDPB CH,4 SOJG 0,ASCSX1 POPJ P, PRGEND TITLE TYPE.. SEARCH FORPRM ENTRY TYPE.. ; USAGE ; LDB 1,[POINT 4,n(L),12] ; PUSHJ P,TYPE..## ; RETURNS NUMBER OF CHARACTERS TO PICK UP IN 0 ; IF F10, 6 IFF CODE IS 10,14,17 ; IF F40, 6 IFF CODE IS 5,6,7 ; ELSE 5 TYPE..: MOVEI 0,6 ;ASSUME WE WILL RETURN SIX CHARACTERS IFN F40LIB,< TLNN L,-1 ;F40? JRST F10TYP ;NO. F10 CAIL 1,5 ;IS IT IN RANGE FOR DOUBLE WORD? CAILE 1,7 ;.. SUBI 0,1 ;NO. MAKE THE 6 A FIVE POPJ P, F10TYP:> CAIE 1,10 ;IS IT DOUBLE WORD? CAIN 1,14 ;.. POPJ P, ;YES CAIE 1,17 ;IS IT? SUBI 0,1 ;NO POPJ P, PRGEND TITLE CHAINB EXTERN OVTAB,OVBEG,.JBSA SEARCH FORPRM CHN==0 HELLO (CHAINB, ) ;CHAINB ENTRY MOVEM 5,SAVAC+5 MOVEI 5,SAVAC BLT 5,SAVAC+4 MOVEI T0,CHAINB HLRZ T1,.JBSA CAIL T0,OVBEG ;CHECK IF CHAIN IN OVERLAY CAILE T0,(T1) ; JRST OK1 ; JRST CHNBD1 ;OUTPUT DIAGNOSTIC TO TTY OK1: MOVE T0,16 ;NOW CHECK RETURN ADDRESS TLZN T0,-1 ; HRRZ T0,(P) ;GET ADDRESS FROM PUSH DOWN LIST CAIG T0,(T1) ; CAIGE T0,OVBEG ; JRST OK2 ; JRST CHNBD2 ;TRAPPED! OK2: MOVEI T1,@1(16) ;ADDRESS OF FILE NAME STRING HRLI T1,440700 ; MOVE T2,[POINT 6, CHNLK] MOVEI T3,5 SETZM CHNLK ; ;CONVERT FIRST FIVE CHARACTERS TO SIXBIT CHN2: ILDB T0,T1 CAIL T0,140 ;LOWER CASE? SUBI T0,40 ;NO. MAKE IT SUBI T0,40 JUMPLE T0,CHN1A ;SPACE OR LESS? IDPB T0,T2 SOJG T3,CHN2 CHN1A: SKIPE CHNDEV ;DO WE KNOW WHERE FILE IS? JRST FNDCHN ;YES. USE IT HRROI T0,40 ;JBTLIM TABLE GETTAB T0, SETZ T0, ;ASSUME NOT SYS TLNE T0,(1B11) ;PROGRAM FROM SYS? JRST CHNSYS ;YES. GET CHAIN FROM SPECIAL AREA HRRZ T3,.JBOPS## ;GET OBJECT TIME SYSTEM MOVE T0,REGS.1(T3) ;PPN CAME T0,[1,,4] ;DSK:[1,4]? CAMN T0,[1,,5] ;OR [1,5]? JRST CHNSYS ;YES. ASSUME FROM SYS SOME WAY ;DON'T TRY TO HANDLE FUNNY LIB OR PATHS, AND ;BOMB ON PSEUDO:[1,4] MOVEM T0,CHNPPN ;STORE SKIPN T1,REGS.2(T3) ;SAVE DEVICE MOVSI T1,'DSK' ;ASSUME DISK MOVEM T1,CHNDEV MOVEI T0,17 ;MODE. NOT PHY ONLY MOVEM T0,OPNWRD ;REMEMBER FNDCHN: MOVE T0,OPNWRD ;LOOK UP THE CHAIN MOVE T1,CHNDEV SETZ T2, OPEN CHN,T0 ;IF NOT THERE, ERROR JRST NOFILE HLLZS CHNLK+1 ;CLEAR POSSIBLE JUNK SETZM CHNLK+2 MOVE T3,CHNPPN ;GET CHAIN PPN MOVEM T3,CHNLK+3 ;STORE LOOKUP CHN,CHNLK ;LOOKUP FILE IN USER'S AREA JRST NOFILE ;ERROR IF NOT THERE GETCHN: SKIPG T1,CURCHN ;GET CURRENT CHAIN NUMBER JRST REDCHN ;IF ANY HLRE T2,OVTAB-1(T1) ;GET LENGTH OF CURRENT OVERLAY MOVM T2,T2 ADDI T2,OVBEG-1 ;GET HIGHEST ADDRESS IN OVERLAY HRRZ T3,.JBOPS## ;GET FORMAT CHAIN MOVEI T3,FMT.DY(T3) ;... FUNRA0: HRRZ T1,(T3) ;LOCATE FORMAT POINTED TO JUMPE T1,REDCHN ;DONE HRRZ T4,1(T1) ;LOAD FORMAT ADDRESS CAIL T4,OVBEG ;LOWER THAN OVERLAYS? CAILE T4,(T2) ;OR HIGHER THAN TOP OF OVERLAY? JRST FUNRA2 ;YES. GET NEXT FORMAT MOVE T0,(T1) ;LINK FORMATS AROUND OVERLAY HRRM T0,(T3) ADDI T1,1 ;SET POINTER FOR DECOR. HLLZS -1(T1) ;AND CLEAR POINTER MOVEM T1,CORADR ;STORE ADDRESS OF CORE TO RETURN PUSH P,16 ;SAVE AN AC MOVEI 16,ARGBLK ;SET UP ARGUMENT PUSHJ P,DECOR.## ;RETURN FORMATS CORE TO FOROTS POP P,16 ;RESTORE AC JRST FUNRA0 ;LOOP FUNRA2: HRRZ T3,(T3) ;GET NEXT FORMAT JRST FUNRA0 REDCHN: MOVE T1,@(16) JUMPLE T1,BADCHN ;MUST BE POSITIVE HLRE T2,OVTAB-1(T1) ;GET SIZE OF OVERLAY JUMPGE T2,BADCHN ;MUST HAVE SOME SIZE! MOVE T2,OVTAB-1(T1) ;NUMBER OF OVERLAY DESIRED USETI CHN,(T2) HRRI T2,OVBEG-1 MOVEI T3,0 INPUT CHN,T2 STATZ CHN,760000 JRST INERR RELEAS CHN, MOVEM T1,CURCHN ;REMEMBER CURRENT OVERLAY MOVSI 5,SAVAC BLT 5,5 ;RESTORE ALL ACS GOODBY (1) CHNSYS: MOVEI T3,WHRNUM ;NUMBER OF PLACES TO LOOK MOVE T0,[XWD 400000,17];DUMP MODE, PHY ONLY CHNSY1: MOVE T1,WHRTAB-1(T3) ;GET DEVICE TO TRY SETZ T2, OPEN CHN,T0 ;OPEN IT SOJA T3,NXTDEV ;TRY NEXT DEVICE HLLZS CHNLK+1 ;SET LOOKUP BLOCK SETZM CHNLK+2 SETZM CHNLK+3 LOOKUP CHN,CHNLK ;FIND FILE SOJA T3,NXTDEV ;NOT THERE MOVEM T1,CHNDEV ;REMEMBER DEVICE SETZM CHNPPN ;NO PPN MOVEM T0,OPNWRD ;AND HOW TO OPEN JRST GETCHN ;GET CHAIN. ALREADY LOOKUP UP NXTDEV: JUMPLE T3,NOFILE ;ERROR IF NO MORE DEVICES JRST CHNSY1 ;TRY ANOTHER DEVICE CHNLK: 0 SIXBIT .CHN. 0 0 WHRTAB: SIXBIT .NEW. ;DEVICE NEW:[1,5] SIXBIT .OVL. ;DEVICE OVL: (NEW DEVICE FOR CHAINB,OVERLAY) WHRNUM==.-WHRTAB CURCHN: 0 ;CURRENT CHAIN IN CORE CHNDEV: 0 ;DEVICE FOR CHAIN FILE CHNPPN: 0 ;PPN FOR CHAIN FILE OPNWRD: BLOCK 1 ;MODE TO OPEN CHAIN DEVICE CORADR: BLOCK 1 1,,0 ARGBLK: EXP CORADR CHNBD2: OUTSTR [ASCIZ . CALL TO CHAIN MUST NOT BE IN THE OVERLAY .] EXIT CHNBD1: OUTSTR [ASCIZ . CHAIN MUST NOT BE IN THE OVERLAY .] EXIT NOFILE: SETZM CHNDEV ;FORGET WHERE FOUND DEVICE IF LOSE IT OUTSTR [ASCIZ . CAN'T FIND CHAIN FILE .] EXIT INERR: OUTSTR [ASCIZ . ERROR READING OVERLAY .] EXIT BADCHN: OUTSTR [ASCIZ . INVALID CHAIN NUMBER .] EXIT SAVAC: BLOCK 6 ;AC SAVE AREA PRGEND TITLE CORAL CORE ALLOCATION ROUTINES SUBTTL ALLCOR SUBROUTINE TO ALLOCATE CORE SEARCH FORPRM COMMENT % WRITTEN BY NORM GRANT. W.M.U. MARCH 17, 1977 CALL ALLCOR(MAX,IERR,IREL,S(1)) WHERE MAX: TOTAL NUMBER OF WORDS OF STORAGE TO BE ALLOCATED. IERR: ERROR CODE. 0 OK -1 INSUFFICIENT ROOM OR ILLEGAL ARGUMENT 1 WARNING! CAN'T GET MUCH BIGGER IREL: SUBSCRIPT ON SINGLE PRECISION ARRAY S SUCH THAT S(IREL) IS FIRST LOCATION IN ALLOCATED CORE. OTHER ARRAYS (BEYOND FIRST) ARE AT S(IREL+LENGTH1), S(IREL+LENGTH1+LENGTH2),ETC. S: A ONE ELEMENT SINGLE PRECISION ARAY WHICH ALL ALLOCATED CORE IS TO BE ADDRESSED RELATIVE TO. THE WARNING(IERR=1) WILL ONLY BE GIVEN IF DOING ALLOCATION VIA CORE UUO. ON PAGING SYSTEMS (VM) ALLOCATION WILL BE DONE BY PAGE. UUOS ABOVE THE HIGH SEGMENT, SO THAT THE OBJECT TIME SYSTEM MAY BE SHARED. THIS REQUIRES A CHANGE TO FOROTS (ALSO FORFUN AND FORPRM) SO THAT THE CBC FUNCTION TRYING TO REDUCE CORE DOESN'T ZAP OUR NON-CONTIGUOUS PAGES, AND NEITHER DOES QMANGR. NOTE THAT GALAXY QMANGR STILL WILL ZAP OUR NON-CONTIGUUOUS PAGES SINCE IT DOES A CORE UUO EVEN WHEN TOLD NOT TO. THIS PATCH IS SHOWN ON THE NEXT TWO PAGES FOR FOROTS VERSION 4B. AFTER INSTALLATION OF THE PATCH, IT WILL BE NECESSARY TO REASSEMBLE FORPRM.MAC, FORINI.MAC, FOROTS.MAC, AND FORFUN.MAC. IT WILL ALSO BE NECESSARY TO FUDGE FORINI,FOROTS, AND FORFUN INTO FORLIB, AND RELOAD FOROTS.SHR. THIS PROCEDURE WILL HAVE NO EFFECT ON EXISTING SAVE FILES, UNLESS THE ADDITIONAL SIZE SHOULD MAKE THEM TOO LARGE TO RUN. % IFDEF PAG.TB, ;IF THEY PATCHED FORPRM, ASSUME WANT PAGE. UUOS IFNDEF FTPAGE, ;OTHERWISE, ASSUME DON'T WISH TO DO PAGE. UUOS COMMENT % File 1) DSKB:FORPRM.ORG[10,7] created: 0000 20-MAY-1976 File 2) DSKB:FORPRM.MAC[10,7] created: 0925 20-APR-1977 1)13 LOW.SZ==ZZ. ;SIZE OF THE STATIC LOW SEGMENT **** 2)13 STATIC(PAG.TB,20) ;WORDS FOR FORFUN TO DO PAGE. UUOS 2) LOW.SZ==ZZ. ;SIZE OF THE STATIC LOW SEGMENT ************** File 1) DSKB:FORFUN.ORG[10,7] created: 0000 19-MAY-1976 File 2) DSKB:FORFUN.MAC[10,7] created: 0932 20-APR-1977 1)16 MOVEI P1,-1(T2) ;[311] LAST WORD WE NEED 1) CORE P1, ;[311] 1) JRST FUNST0 ;[311] NO CHANGE IF WE FAILED 1) CAMLE T2,.JBREL## ;[311] INCASE WE GAVE IT ALL AWAY 1) JRST FUNCB1 ;[311] JUST CLEAR PREVIOUS **** 2)16 IFN ,< ;IF NOT A KA10 2) MOVE T3,[XWD 4,T4] ;CHECK FOR EXISTENCE OF PAGE. UUO 2) MOVEI T4,1 ;BY GETTING A WORD OF WORKING SET TABLE 2) PAGE. T3, ;DO CALL 2) JRST FUNCB3 ;DOES NOT EXIST. NOT PAGING SYSTEM 2) MOVEI P1,776(T2) ;GET FIRST UNWANTED PAGE 2) LSH P1,-^D9 2) HRRZ T3,.JBREL## ;GET LAST UNWANTED PAGE 2) LSH T3,-^D9 2) TLO P1,(1B0) ;SET DELETING PAGES BIT IN P1 2) RETAGN: MOVSI T5,-17 ;MAX PAGES TO DO AT ONE TIME 2) HRRI T5,PAG.TB(P4) ;WHERE TO STORE WORDS 2) SETZM PAG.TB(P4) ;START WITH ZERO PAGES 2) RETMOR: CAIGE T3,(P1) ;FINISHED? 2) JRST RETDON ;YES. DO FINAL PAGE. UUO 2) MOVEM P1,1(T5) ;NO. STORE THIS PAGE. (SHOULD BE AT LEAST ONE) 2) AOS PAG.TB(P4) ;AND COUNT IT 2) ADDI P1,1 ;STEP TO NEXT PAGE 2) AOBJN T5,RETMOR ;LOOP FOR MORE PAGES 2) RETDON: MOVEI T5,PAG.TB(P4) ;SET UP UUO ARG 2) HRLI T5,1 ;DELETE PAGES FUNCTION 2) PAGE. T5, ;DO IT 2) JFCL ;IGNORE IT. MAY CAUSE PROBS? 2) CAIL T3,(P1) ;WAS THAT THE END? 2) JRST RETAGN ;NO. DO MORE 2) JRST FUNCB4 ;YES. DONE 2) > ;END IFN 2) FUNCB3: MOVEI P1,-1(T2) ;[311] LAST WORD WE NEED 2) CORE P1, ;[311] 2) JRST FUNST0 ;[311] NO CHANGE IF WE FAILED 2) FUNCB4: CAMLE T2,.JBREL## ;[311] INCASE WE GAVE IT ALL AWAY 2) JRST FUNCB1 ;[311] JUST CLEAR PREVIOUS ************** File 1) DSKC:FOROTS.CUR[10,6] created: 0000 21-APR-1977 File 2) DSKC:FOROTS.MAC[10,6] created: 1038 12-OCT-1977 1)55 PUSH P,.JBHRL## ;[346] SAVE HIGH SEGMENT LENGTH **** 2)55 ; CLOS.Q+ S.M. #485.25 NDG/ 10-12-77 2) TLO T1,40000 ;TELL QMANGR NOT TO DO ANY CORE SHRINKING 2) PUSH P,.JBHRL## ;[346] SAVE HIGH SEGMENT LENGTH ************** 1)55 PJRST UPDCHN ;[240] UPDATE CHANNEL TABLE 1) QUE.TB: ;TABLE OF QUEUE CODES **** 2)55 PUSHJ P,UPDCHN ;[240] UPDATE CHANNEL TABLE 2) HRRZ T2,.JBFF ;GET WHERE WE THINK CORE ENDS 2) CAML T2,.JBREL ;QMANGR CHANGE? 2) POPJ P, ;NO. OK 2) IFN ,< ;IF NOT A KA10 2) MOVE T3,[XWD 4,T4] ;CHECK FOR EXISTENCE OF PAGE. UUO 2) MOVEI T4,1 ;BY GETTING A WORD OF WORKING SET TABLE 2) PAGE. T3, ;DO CALL 2) JRST QUECB3 ;DOES NOT EXIST. NOT PAGING SYSTEM 2) MOVEI P1,776(T2) ;GET FIRST UNWANTED PAGE 2) LSH P1,-^D9 2) HRRZ T3,.JBREL## ;GET LAST UNWANTED PAGE 2) LSH T3,-^D9 2) TLO P1,(1B0) ;SET DELETING PAGES BIT IN P1 2) RETAGN: MOVSI T5,-17 ;MAX PAGES TO DO AT ONE TIME 2) HRRI T5,PAG.TB(P4) ;WHERE TO STORE WORDS 2) SETZM PAG.TB(P4) ;START WITH ZERO PAGES 2) RETMOR: CAIGE T3,(P1) ;FINISHED? 2) JRST RETDON ;YES. DO FINAL PAGE. UUO 2) MOVEM P1,1(T5) ;NO. STORE THIS PAGE. (SHOULD BE AT LEAST ONE) 2) AOS PAG.TB(P4) ;AND COUNT IT 2) ADDI P1,1 ;STEP TO NEXT PAGE 2) AOBJN T5,RETMOR ;LOOP FOR MORE PAGES 2) RETDON: MOVEI T5,PAG.TB(P4) ;SET UP UUO ARG 2) HRLI T5,1 ;DELETE PAGES FUNCTION 2) PAGE. T5, ;DO IT 2) JFCL ;IGNORE IT. MAY CAUSE PROBS? 2) CAIL T3,(P1) ;WAS THAT THE END? 2) JRST RETAGN ;NO. DO MORE 2) POPJ P, ;YES. DONE 2) > ;END IFN 2) QUECB3: MOVEI P1,-1(T2) ;WHERE TO SHRINK BY CORE UUO 2) CORE P1, ;DO IT 2) JFCL ;CAN'T FAIL 2) POPJ P, ;RETURN 2) QUE.TB: ;TABLE OF QUEUE CODES ************** % HELLO (ALLCOR) ;ALLCOR ENTRY SKIPL T1,@0(16) ;MAX NEGATIVE? CAILE T1,400000 ;OR GREATER THAN 128 K? JRST NOCORE ;YES. CAN'T DO ANYTHING SETZM @1(16) ;ASSUME NO ERRORS IFN &FTPAGE,< MOVE T1,[XWD 4,T2] ;GET WORKING SET BIT TABLE MOVEI T2,1 PAGE. T1, ;GET TABLE FROM MONITOR JRST OLDCOR ;MUST DO OLD WAY. NOT VM SYSTEM MOVEI T1,377777 ;DO VIA PAGE. CHECK ARG MORE SKIPE .JBHRL## ;ANY HIGHSEG? HRRZ T1,.JBHRL## ;GET HIGHEST ADR IN HIGHSEG ADDI T1,1 ;PLUS ONE IS OUR FIRST ADDRESS MOVE T2,@0(16) ;GET MAX AGAIN JUMPE T2,DELALL ;ASKING FOR ZERO? ADDI T2,-1(T1) ;NO. GET HIGHEST ADDR LSH T1,-^D9 ;FIRST PAGE NEEDED LSH T2,-^D9 ;HIGHEST PAGE NEEDED CAILE T2,776 ;LEAVE ROOM FOR PFH JRST NOCORE ;NOT ROOM. DO NOTHING MOVEM T1,LOWPAG# ;STORE LOWEST PAGE MOVEM T2,HIPAGE# ;HIGHEST PAGE MOVEI T4,-1(T1) ;MAKE T4 CURRENT HIGHEST PAGE (MAY NOT EXIST) CHKPAG: MOVEI T3,1(T4) ;SEE IF PAGES REALLY EXISTS HRLI T3,6 ;.PAGCA FUNCTION PAGE. T3, ;ASK MONITOR JRST ENDPAG ;ASSUME T4 IS HIGH PAGE JUMPL T3,ENDPAG ;DOES PAGE EXIST? CAIGE T4,775 ;YES. HIGH AS WANT TO LOOK? AOJA T4,CHKPAG ;LOOP FOR MORE PAGES ENDPAG: MOVEM T4,CURHGH# ;STORE HIGHEST PAGE CAMN T4,HIPAGE ;IS IT THE HIGHEST DESIRED ALSO? JRST NOCHNG ;YES. NOTHING TO DO CAML T4,HIPAGE ;NO. MORE THAN HE WANTS? JRST LESPAG ;YES. REDUCE CORE ADDI T4,1 ;WANTS MORE CORE. CAMGE T4,LOWPAG ;START ALLOCATING AT MOVE T4,LOWPAG ;LARGER OF (CURHGH+1), LOWPAG MOVEM T4,FIRSTP# ;REMEMBER WHERE WE STARTED SETZM ONDISK# ;START ALLOCATING PAGES IN CORE CREPAG: SETZM PAGTAB ;ZERO PAGES SO FAR HRLZI T1,-20 ;AT MOST 16.P PER CALL CREPG0: HRRZM T4,PAGTAB+1(T1) ;ALWAYS AT LEAST ONE TO ALLOCATE. STORE NUMBER AOS PAGTAB ;AND COUNT IN TABLE ALSO ADDI T4,1 ;STEP TO NEXT PAGE CAMG T4,HIPAGE ;WAS THAT THE LAST? AOBJN T1,CREPG0 ;NO. DO NEXT IF IT WILL FIT CREPG1: MOVSI T2,(1B1) ;MUST WE ALLOCATE ON DISK? SKIPE ONDISK ;??? IORM T2,PAGTAB+1 ;YES. SETTING FOR ONE SETS FOR ALL MOVE T2,[XWD 1,PAGTAB] ;ALLOCATE PAGES PAGE. T2, ;FROM MONITOR JRST CREFAI ;FAILED. ON DISK INSTEAD? CAMG T4,HIPAGE ;GOT THEM. MORE TO DO? JRST CREPAG ;YES. START ANOTHER BLOCK NOCHNG: MOVE T3,LOWPAG ;WHERE ALLOCATED CORE STARTS LSH T3,^D9 ;IN WORDS JRST WHRCOR ;TELL WHERE IS AND LEAVE CREFAI: SKIPE ONDISK ;ALREADY TRYING DISK? JRST UNCRPG ;YES. GIVE BACK ANY WE ALLOCATED AND GIVE ERROR SETOM ONDISK ;NO. TRY PUTTING SOME ON DISK JRST CREPG1 ;TRY THE ALLOCATION AGAIN. SAME PAGES UNCRPG: SETOM @1(16) ;THIS WILL BE AN ERROR ON RETURN HRRZ T1,PAGTAB+1 ;GET FIRST PAGE IN BLOCK THAT FAILED CAMG T1,FIRSTP ;ABOVE FIRST THAT TRIED FOR? JRST NOCORE ;NO. WE NEVER GRABBED ANY SUBI T1,1 ;LAST PAGE TO RETURN EXCH T1,CURHGH ;GOES INTO CURHGH MOVEM T1,HIPAGE ;AND OLD HIGHEST GOES INTO DESIRED HIGHEST JRST DELPAG ;DEALLOCATE IT LESPAG: SETZM @1(16) ;DEALLOCATING PAGES IS ALWAYS OK DELPAG: MOVE T4,HIPAGE ;START DELETING AT HIPAGE DESIRE PLUS ONE AOS T4 ;PLUS ONE MOVSI T3,(1B0) ;DELETEING PAGES BIT DELPG0: SETZM PAGTAB ;START WITH ZERO COUNT MOVSI T1,-20 ;AT MOST 16.P PER CALL DELPG1: MOVEM T4,PAGTAB+1(T1) ;STORE COMMAND. MUST BE AT LEAST ONE AOS PAGTAB ;COUNT IT TOO IORM T3,PAGTAB+1(T1) ;SET DELETE BIT ADDI T4,1 ;STEP TO NEXT PAGE CAMG T4,CURHGH ;WAS THAT LAST ONE? AOBJN T1,DELPG1 ;DO NEXT PAGE IF IT WILL FIT DELPG2: MOVE T2,[XWD 1,PAGTAB] ;DELETE THE PAGES PAGE. T2, ;FROM OUR IMAGE JFCL ;IGNORE FAILURE CAMG T4,CURHGH ;WAS THAT END OF IT JRST DELPG0 ;NO. START ANOTHER BLOCK SKIPE @1(16) ;DID WE HAVE ERROR JRST NOCORE ;YES. ON ALLOCATION JRST NOCHNG ;NO ERROR. RETURN ADDRESS DELALL: HRRZ T1,.JBREL## ;GET CURRENT HIGHEST IN CONTIGUOUS LOWSEG CORE T1, ;CUT TO JUST THAT JFCL ;IF POSSIBLE SETZB T3,@1(16) ;NO ERRORS JRST WHRCR1 ;AND AN OFFSET OF 1 = S(1) PAGTAB: BLOCK 21 ;ROOM FOR HEADER WORD AND 16P = 8K > ;END IFE !FTPAGE ; HERE TO DO ALLOCATION BY CORE UUO IN HIGH SEGMENT OLDCOR: SKIPE .JBHRL## ;ANY HIGH SEGMENT? JRST GOTHI ;YES. DON'T MAKE ONE HRRZ T2,.JBREL## ;WHERE DOES LOW SEG END? ADDI T2,1 ;PLUS ONE CAIGE T2,400000 ;BELOW 400000? MOVEI T2,400000 ;YES. START OUR HIGHSEG AT 400000 MOVS T2,T2 ;... CORE T2, ;MAKE HIGHSEG JRST NOCORE ;CAN'T? MOVEI T2,10 ;RELATIVE LENGTH OF INITIAL HIGHSEG HRLM T2,.JBHRL## GOTHI: PUSHJ P,CLRUWP ;WRITE ENABLE HIGHSEG MOVE T1,@0(16) ;GET MAX HRRZ T2,.JBREL## ;FIGURE OUT HIGH SEG ORIGIN TRNN T2,400000 ;OVER 400000? MOVEI T2,377777 ;NO. ASSUME ORIGIN IS 400000 MOVE T3,[XWD -2,100] ;GET ORIGIN FROM .GTUPM GETTAB T3, ;IN MONITOR HRLI T3,1(T2) ;ASSUME LOW PLUS ONE HLRZ T3,T3 ;GET ORIGIN IN RIGHT HLRZ T2,.JBHRL## ;GET RELATIVE LENGTH ADDI T3,0(T2) ;ADD TO ORIGIN ADDI T1,-1(T3) ;AND ADD THAT TO MAX -1 TLNE T1,-1 ;EXCEED ADDRESS SPACE? JRST NOCORE ;YES. NO CAN DO MOVS T2,T1 ;MAKE CORE WORD ADDI T1,^D512 ;ALSO TRY FOR EXTRA PAGE MOVSS T1 ;CORE WORD FOR THAT TRNN T1,-1 ;EXCEED ADDRESS SPACE? CORE T1, ;NO. GET CORE AOS @1(16) ;CAN'T. WARNING CORE T2, ;GET RIGHT AMOUNT JRST NOCORE ;THAT NEITHER WHRCOR: SUBI T3,@3(16) ;CALCULATE OFFSET INTO S WHRCR1: ADDI T3,1 ;SUBSCRIPT CALC IS BASE-1+SUBSCRIPT MOVEM T3,@2(16) ;RETURN IT GOODBY 4 NOCORE: SETOM @1(16) ;ERROR RETURN GOODBY 4 SUBTTL CLRUWP CLEAR HISEG WRITE PROTECTION COMMENT % WRITTEN BY NORM GRANT. WMU. JANUARY 22, 1974 USAGE CALL CLRUWP PURPOSE CLEAR USER WRITE PROTECTION ON HIGH SEGMENT % HELLO (CLRUWP) ;CLRUWP ENTRY SETZ 0, SETUWP 0, JRST .+2 GOODBY OUTSTR [ASCIZ/ Cannot write-enable high segment data area. /] EXIT PRGEND TITLE CORE MANIPULATION FOR LOW SEGS VIA FOROTS SEARCH FORPRM COMMENT % USAGE CALL GTCORE(WORDS,BASE,OFFSET,ERROR,RESERVE) WHERE WORDS - IS NUMBER OF WORDS OF CORE TO GET BASE - IS ARRAY RELATIVE TO WHICH ADDRESS IS TO BE RETURNED OFFSET - IS ADDRESS OF CORE RELATIVE TO BASE ERROR - ERROR CODE 0 = OK -1 = INSUFFICIENT CORE 1 = CANNOT OBTAIN REQUESTED RESERVE CORE RESERVE - NUMBER OF WORDS TO RESERVE FOR LATER CALL LSCORE(BASE,OFFSET) WHERE BASE AND OFFSET HAVE SAME MEANING AS ABOVE. THIS ROUTINE MUST BE CALLED TO RETURN CORE BEFORE IT CAN BE REUSED. NOTE: GTCORE DOES NOT FUNCTION PROPERLY WITH LINK-10 OVERLAYS IN MOST CASES. SEE FORLIB.MAN FOR MORE COMMENTS % XWD -1,0 M1: Z 2,AMT# ;TO ALLOCATE CORE XWD -1,0 M2: Z 2,[-1] ;TO ALLOCATE ALL OF CORE XWD -1,0 M3: Z 2,ADR# ;TO RETURN CORE HELLO (GTCORE) SETOM GETTNG# ;GETTING CORE. DO NOT DELETE FORMATS ON RETURN MOVEM 16,SAVE16# PUSH P,P4 ;SAVE P4 MOVE P4,.JBOPS## ;GET BASE OF OTS SETZM @2(16) ;CLEAR OFFSET SETZM @3(16) ;CLEAR ERROR SKIPLE T1,@0(16) ;MUST BE POSITIVE TLNE T1,-1 ;MORE THAN 18 BITS? JRST NOCORE ;YES. NO WAY MOVEM T1,SAVESZ# ;SAVE THE SIZE FOR LATER SETZM RSVSW# ;FLAG RESERVE ARG ABSENT SETZM RSVADR# ;FLAG NO RESERVE CORE YET IFN F40LIB,< TLNN 16,-1 ;F10 CALL JRST NOTF40 ;YES HLRZ 0,4(16) ;F40 CALL TRZ 0,740 ;CLEAR AC FIELD CAIE 0,(JUMP) ;IS IT AN ARG? JRST RSVNOT ;NO JRST RSVYES ;YES NOTF40:> HLRE 0,-1(16) MOVN 0,0 ;CHANGE SIGN CAIGE 0,5 ;AT LEAST FIVE ARGS? JRST RSVNOT ;NO. RSVYES: MOVE 0,@4(16) ;GET AMOUNT OF RESERVE JUMPLE 0,RSVNOT ;OK IF NONE SETOM RSVSW ;ASKED FOR RESERVE TLNN 0,-1 ;MORE THAN 18 BITS? PUSHJ P,GETCOR ;GET THE RESERVE CORE JRST NORESV ;NO RESERVE MOVEM 1,RSVADR ;SAVE RESERVE ADR RSVNOT: PUSHJ P,DEFRAG ;FIND LARGEST POSSIBLE PIECE MOVE 1,ADR ;WHERE IS IT? HLRZ 0,-1(1) ;HOW BIG? CAMG 0,SAVESZ ;BIG ENOUGH FOR REQUEST AND OVERHEAD WORD? JRST GETOWN ;NO MOVE 0,SAVESZ ;YES. GET SIZE BACK PUSHJ P,GETCOR ;GET CORE FROM FOROTS JRST CORERR ;CAN'T GET IT SETADR: MOVE 16,SAVE16 ;GET ARG LIST BACK SUBI 1,@1(16) ;SUBTRACT BASE FROM ADDRESS ADDI 1,1 ;FORTRAN PASSES BASE-1+OFFSET MOVEM 1,@2(16) ;STORE AS OFFSET RETRSV: SKIPN RSVSW ;RESERVE ARG GIVEN? JRST GTRET ;NO. RETURN MOVE 0,RSVADR ;YES. GET ADDRESS ALLOCATED JUMPLE 0,GTRET ;NONE. RETURN PUSHJ P,GIVCOR ;GIVE CORE BACK TO FOROTS GTRET: MOVE 16,SAVE16 ;GET ARG LIST BACK POP P,P4 ;RESTORE P4 GOODBY 400004 ;RETURN CORERR: SKIPLE T1,RSVADR ;DID USER WANT A RESERVE? JRST CORER1 ;NO. (OR WE COUDN'T GET IT) MOVE 16,SAVE16 ;GET ARG LIST BACK SETO 0, ;ERROR IS -1 EXCH 0,@3(16) ;REPLACE ANY OLD ERROR AND REMEMBER JUMPE 0,RETRSV ;IF NO PREVIOUS ERROR, RETURN ANY RESERVE JRST GTRET ;ELSE JUST RETURN CORER1: MOVEM T1,ADR ;STORE ADDRESS PUSHJ P,RETADR ;RETURN THE CORE SETZM RSVADR ;DON'T HAVE IT ANYMORE NORESV: MOVE 16,SAVE16 ;GET ARGS BACK MOVEI 0,1 ;NO RESERVE ERROR MOVEM 0,@3(16) JRST RSVNOT ;NOW FIND REAL CORE NOCORE: SETOM @3(16) ;COMPLETE FAILURE JRST GTRET ;RETURN HELLO (LSCORE) SETZM GETTNG# ;RETURNING CORE FROM PROGRAM. RETURN FORMATS ;AND ETC. SO CAN TRY TO SHRINK PUSH P,P4 ;SAVE P4 MOVE P4,.JBOPS## ;GET OTS WORD MOVEI 1,@(16) ;GET ARG WORD ADD 1,@1(16) ;PLUS OFFSET SUBI 1,1 ;MINUS THE FUDGE FACTOR FROM FORTRAN HLRZ 2,.JBSA## ;CHECK AGAINST LOWER CORE CAIGE 1,1(2) ;INCLUDING LINK WORD JRST ILCORE ;TO LOW HLRZ 2,-1(1) ;AND CHECK UPPER END ADDI 2,-2(1) ;GET EXACT UPPER ADDRESS TLNN 2,-1 ;NEGATIVE? CAMLE 2,.JBREL## ;OR GREATER THAN .JBREL? JRST ILCORE ;YES. ILLEGAL MOVE 0,1 ;CALL GIVCOR MOVEM 16,SAVE16# PUSHJ P,GIVCOR ;GIVE IT BACK MOVE 16,SAVE16 LSRET: POP P,P4 ;RESTORE P4 GOODBY (2) ILCORE: OUTSTR [ASCIZ/ Attempting to return core at illegal address in LSCORE /] HALT LSRET GETCOR: MOVEM 0,AMT ;ALLOCATE CORE PUSHJ P,DEFRAG ;DEFRAGMENT CORE FIRST AND ALWAYS MOVEI 16,M1 PUSHJ P,ALCOR.## ;GET IT FROM FOROTS JUMPL 0,GIVCOR ;IF ERROR, TRY TO SHRINK CORE MOVE 1,0 ;RETURN ADDRESS IN AC 1 MOVE 0,AMT ;RETURN AMOUNT IN ZERO CPOPJ1: AOS (P) ;SKIP RETURN CPOPJ: POPJ P, ;RETURN GETBIG: MOVEI 16,M2 ;GET LARGEST POSSIBLE CHUNK PUSHJ P,ALCOR.## ;FROM FOROTS MOVEM 0,ADR ;STORE ADRRESS POPJ P, ;RETURN DEFRAG: PUSHJ P,GETBIG ;GET LARGEST POSSIBLE PIECE JRST RETADR ;AND RETURN IT TO FOROTS (DEFRAGMENTS CORE) FNDHGH: SETZ T1, ;ASSUME ZERO HIGHEST MOVEI T2,FRE.DY(P4) ;GET ADDRESS OF FIRST BLOCK MOVE T3,T2 ;SAVE AS PREVIOUS FNDHG1: MOVE T4,T3 ;SAVE PREVIOUS HRRZ T3,(T3) ;GET ADDRESS OF BLOCK JUMPE T3,CPOPJ ;RETURN IF NONE CAILE T1,(T3) ;IS NEW ADDRESS HIGHER JRST FNDHG1 ;NO. LOOP MOVEI T1,(T3) ;YES. REMEMBER MOVE T2,T4 ;AND REMEMBER PREVIOUS JRST FNDHG1 ;LOOP GETOWN: SETZM GOTHGH# ;ASSUME WILL NOT FIND BLOCK AT TOP PUSHJ P,FNDHGH ;TRY TO FIND BLOCK AT TOP OF CORE JUMPE T1,GETOW1 ;NO CORE BLOCKS AT ALL HLRZ T3,(T1) ;GET SIZE OF HIGHEST BLOCK ADDI T3,-1(T1) ;GET HIGHEST ADDRESS IN BLOCK CAME T3,.JBREL## ;TOP OF CORE? JRST GETOW1 ;NO. SETOM GOTHGH ;YES. REMEMBER HRRZ T3,(T1) ;GET ADDRESS OF NEXT HRRM T3,(T2) ;LINK FROM PREVIOUS HLLZS (T1) ;CLEAR FORWARD LINK JRST GETOW2 ;STORE ADDRESS OF BLOCK AS LOWEST FREE GETOW1: MOVE T1,.JBFF## ;GET ADDRESS OF FIRST FREE WORD GETOW2: MOVEM T1,SAVLOW# ;STORE THAT ADD T1,SAVESZ ;PLUS SIZE IS OUR HIGHEST CORE T1, ;TRY TO GRAB CORE JRST OWNERR ;DIDN'T GET IT. FAIL HRRZ T3,.JBREL## ;GOT IT MOVE T1,.JBFF## ;GET OLD FIRST FREE SUBI T3,-1(T1) ;GET SIZE OF CHUNK ADDB T3,.JBFF## ;AND UPDATE .JBFF SUB T3,SAVESZ ;GET ADR OF LOWEST WORD FOR USER MOVEM T3,SAVUSR# ;SAVE IT MOVE T2,SAVESZ ;GET SIZE TO STORE ADDI T2,1 ;INCLUDING OVERHEAD HRLZM T2,-1(T3) ;STORE IN BLOCK SUB T3,SAVLOW ;FIND SIZE OF REMAINDER SOJLE T3,GETOWX ;MUST BE POSITIVE TO RETURN HRLZM T3,@SAVLOW ;STORE SIZE AOS T1,SAVLOW ;GET ADDRESS MOVEM T1,ADR ;AND STORE IT PUSHJ P,RETADR ;RETURN TO FOROTS GETOWX: MOVE 1,SAVUSR ;GET THE ADDRESS OF THE BLOCK BACK JRST SETADR ;SET UP THE OFFSET AND RETURN TO USER OWNERR: AOS T1,SAVLOW ;GET LOWEST PLUS ONE MOVEM T1,ADR ;STORE IT SKIPE GOTHGH ;GOT IT FROM FOROTS? PUSHJ P,RETADR ;YES. RETURN IT TO FOROTS JRST CORERR ;GIVE CORE ERROR GIVCOR::MOVEM 0,ADR ;DEALLOCATE CORE PUSHJ P,RETADR ;RETURN THE CORE SKIPE GETTNG ;IF JUST GETTING CORE, SKIP FORMATS JRST SHRINK ;AND COMPRESS CORE GVCOR1: PUSHJ P,DEFRAG ;DEFRAGMENT THE CORE SETZM FRAGED# ;AND SAY ITS NOT FRAGMENTED PUSHJ P,FNDHGH ;FIND HIGHEST BLOCK OF CORE JUMPE T1,CPOPJ ;IF NONE (IMPOSSIBLE) RETURN HLRZ T3,(T1) ;GET SIZE OF HIGHEST BLOCK ADDI T3,-1(T1) ;GET HIGHEST ADDRESS OF BLOCK CAMN T3,.JBREL## ;TOP OF CORE? JRST SHRINK ;YES. SHRINK THE CORE IF WORTH IT SKIPE GETTNG ;WORTH LOOKING AT FORMATS? POPJ P, ;NO. RETURN MOVEM T1,CURHGH# ;SAVE ADDRESS OF HIGHEST BLOCK HLRZ T1,FMT.DY(P4) ;GET ADDRESS OF FORMAT ENCODING BLOCK CAMG T1,CURHGH ;ABOVE HIGHEST? JRST GVCOR2 ;NO. CONTINUE HRRZS FMT.DY(P4) ;YES. DELETE IT ADDI T1,1 ;SET ADDRESS THE WAY FOROTS EXPECTS MOVEM T1,ADR ;AND RETURN THE CORE PUSHJ P,RETADR ;TO FOROTS SETOM FRAGED ;THE CORE IS NOW FRAGMENTED GVCOR2: MOVEI T1,FMT.DY(P4) ;NOW LOOK AT THE ENCODED FORMATS GVCOR3: HRRZ T1,(T1) ;GET NEXT ONE JUMPE T1,GVCOR4 ;NO MORE CAMG T1,CURHGH ;ABOVE HIGHEST BLOCK JRST GVCOR3 ;NO. LOOK AT NEXT HRRZ T1,FMT.DY(P4) ;GET THE ADDRESS OF FIRST ENCODED FORMAT ADDI T1,1 ;PLUS ONE FOR FOROTS MOVEM T1,ADR ;STORE ADDRESS HLLZS FMT.DY(P4) ;DELETE THE ENCODED FORMAT LIST PUSHJ P,RETADR ;RETURN THE CORE TO FOROTS JRST GVCOR1 ;CORE IS NOW FRAGMENTED, SO TRY AGAIN GVCOR4: SKIPE FRAGED ;IS CORE FRAGMENTED? JRST GVCOR1 ;YES POPJ P, ;NO SHRINK: HRRZ T3,(T1) ;GET ADDRESS OF NEXT BLOCK HRRM T3,(T2) ;STORE IN PREVIOUS AS LINK HLLZS (T1) ;ZERO POINTER ADDI T1,1 ;CHANGE POINTER TO WAY FOROTS EXPECTS MOVEM T1,ADR ;STORE FOR LATER TROE T1,777 ;ROUND ADDRESS UP TO PAGE ADDI T1,1000 ;EXTRA PAGE CAML T1,.JBREL## ;WORTH DELETING? JRST RETADR ;NO. RETURN THE BLOCK CORE T1, ;RETURN SOME CORE HALT . ;OOPS? HRRZ T3,.JBREL## ;GET NEW HIGHEST ADDI T3,1 ;NEW .JBFF MOVEM T3,.JBFF## MOVE T1,ADR ;GET THE BLOCK ADDRESS BACK SUBI T3,-1(T1) ;COMPUTE SIZE HRLM T3,-1(T1) ;AND STORE IT RETADR: MOVEI 16,M3 ;RETURN IT PUSHJ P,DECOR.## ;VIA FOROTS POPJ P, END