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 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: 20,,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 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 1,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 PRINTS - ROUTINE TO ENTER FILE IN PRINT QUEUE SUBTTL USAGE INSTRUCTIONS SEARCH FORPRM,QPRM,MACTEN,UUOSYM ; FORPRM IS UNIVERSAL FILE FROM FOROTS ; QPRM IS UNIVERSAL FILE FOR QUEUE DEFINITIONS. SEE ... ; MACTEN IS UNIVERSAL FILE WITH USEFUL MACRO DEFINITIONS SEE ... ; UUOSYM IS UNIVERSAL FILE WITH UUO SYMBOLS DEFINITIONS SEE ... COMMENT % THE PURPOSE OF THIS ROUTINE IS TO ENTER A REQUEST IN THE PRINT(SPOOL) QUEUE FROM A FORTRAN OR MACRO PROGRAM. CALLING SEQUENCE CALL PRINTS('FILENAME.EXT',IARG1,IARG2,IARG3) OR CALL PRINTS('FILENAME.EXT',IARG1,IARG2,IARG3,IARG4) WHERE FILENAME 6 OR FEWER CHARACTERS. EXT 3 OR FEWER CHARACTERS.(MAY BE NULL) IARG1 2 IF FILE IS TO BE RENAMED OUT OF AREA. 1 IF FILE IS TO BE DELETED. 0 IF FILE IS TO BE PRESERVED. IARG2 1 IF FORTRAN FORMATTED OUTPUT 0 IF OTHER THAN FORTRAN FORMATTED OUTPUT IARG3 LESS THAN OR EQUAL 0 IMPLIES 1 COPY. GREATER THAN 63 IMPLIES 1 COPY. 1-63 IMPLIES THAT NUMBER OF COPIES. IARG4 OPTIONAL PAGE LIMIT.[DEFAULT IF OMITTED IS (#BLOCKS WRITTEN)*COPIES+20] % SUBTTL DATA AND DEFINITIONS ; AC DEFINITIONS F=0 A=1 B=2 C=3 WD=4 ;SIXBIT ANSWER FROM ASCSIX T1=WD BP6=5 ;SIXBIT POINTER T2=BP6 BP7=6 ;ASCII POINTER T3=BP7 N=7 ;NUMBER T4=N CH=10 ;CHARACTER T5=CH V=11 ;POINTER TO ARG VECTOR QD=12 ;QUE TYPE QF=13 ;POINTER TO CURRENT FILE BLOCK IN QUE BLOCK Q=14 ;POINTER TO QUE AREA SUBTTL PRINTS - DO THE WORK HELLO (PRINTS) ;PRINTS ENTRY MOVE A,[BYTE(9).QOHED,Q.FMOD+1(18)1] ;1 FILE PUSHJ P,GTINF$## ;GET SOME INFO AND INIT QUE BLOCK SETZ QD, ;MODE IS PRINT QUEUE PUSHJ P,OPDSK$## ;OPEN THE DISK JRST NODSK HRRZI A,111000 ;SINGLE SPACED ASCII SKIPE @2(16) ADDI A,1000 ;MAKE THAT FORTRAN MOVEM A,Q.OMOD(Q) MOVEI A,^D10 ;DEFAULT PRIORITY IS 10 MOVEM A,Q.PRI(Q) MOVEI B,.QFDDE ;ASSUME /DISP:DEL SKIPG A,@1(16) ;IS IT /DISP:PRE? MOVEI B,.QFDPR ;YES CAIN A,2 ;IS IT /DISP:REN MOVEI B,.QFDRE ;YES DPB B,[POINTR(Q.OMOD(Q),QF.DSP)] PUSHJ P,FILNMO MOVEI QF,Q.OSTR(Q) ;WHERE FILE IS PUSHJ P,DOFIL$## ;GO DO THE FILE THINGS JRST NTFND ;FILE NOT FOUND SKIPLE A,@3(16) ;/COPIES CAILE A,^D63 MOVEI A,1 DPB A,[POINTR(Q.OMOD(Q),QF.COP)] IMUL A,$RBSIZ## MOVE B,A ;MAKE A COPY ASH A,-^D10 ;DIVIDE BY 1024 ADDI A,1 HRRM A,Q.OSIZ(Q) ;QS.BLK IDIVI B,200 ADDI B,^D21 ;FUDGE FACTOR IFN F40LIB,< TLNN 16,-1 ;F10? JRST CHKF10 ;YES HLRZ A,4(16) TRZ A,740 CAIE A,(JUMP 0) JRST DEFALT JRST F40ARG > CHKF10: HLRE A,-1(16) MOVMS A CAIGE A,5 ;LIMIT ARG? JRST DEFALT ;NO F40ARG: SKIPLE A,@4(16) MOVE B,A ;ONLY ACCEPT ESTIMATE IF POSITIVE CAILE B,777776 ;LESS THAN MAX? MOVEI B,777776 ;NO DEFALT: HRLM B,Q.OSIZ(Q) ;PAGE LIMIT (QS.LIM) PUSHJ P,$DOQUE## ;ACTUALLY QUE THE FILE JFCL ;ALREADY GAVE ERROR MESSAGE GOODBY 200004 ;AT LEAST FOUR ARG RETURN NODSK: OUTSTR [ASCIZ\ CANNOT INIT DISK! \] GOODBY 200004 NTFND: OUTSTR [ASCIZ\ FILE NOT FOUND! \] GOODBY 200004 FILNMO: SETZB A,B MOVEI BP7,@(16) HRROI N,-11 ;NINE POSSIBLE CHARACTERS. HRLI BP7,440700 ;MAKE POINTER TO STRING. MOVE BP6,[POINT 6,A] GETCHR: ILDB CH,BP7 JUMPE CH,CPOPJ CAIN CH,"." JRST [HRROI N,-3 MOVE BP6,[POINT 6,B] JRST GETCHR] SUBI CH,40 IDPB CH,BP6 AOJL N,GETCHR CPOPJ: POPJ P, PRGEND TITLE QUEOUT - ROUTINES TO MAKE OUTPUT QUEUE ENTRIES SUBTTL USAGE INSTRUCTIONS SEARCH FORPRM,QPRM,MACTEN,UUOSYM ; FORPRM IS UNIVERSAL FILE FROM FOROTS ; QPRM IS UNIVERSAL FILE FOR QUEUE DEFINITIONS. SEE ... ; MACTEN IS UNIVERSAL FILE WITH USEFUL MACRO DEFINITIONS SEE ... ; UUOSYM IS UNIVERSAL FILE WITH UUO SYMBOLS DEFINITIONS SEE ... COMMENT % USAGE CALL QUEOUT(DEVICE,FILENAME,QUE,VECTOR,ERROR) WHERE DEVICE - IS DEVICE FILE IS ON. (MUST BE SOME KIND OF DSK) FILENAME - IS TWO WORD ASCII FILENAME TO OUTPUT QUE - IS ASCII NAME OF QUEUE TO PUT FILE IN (MAY BE LPT, CDP, PTP, OR PLT) IERR - IS ERROR CODE VALUE MEANING 0 OK 1 UNDEFINED QUE 2 ILLEGAL DEVICE 3 ILLEGAL FILE NAME 4 NO SUCH FILE 5 ILLEGAL ARGUMENT IN VECTOR 6 CANNOT OPEN QUE DEVIE 7 CANNOT ENTER QUEUE COMMAND FILE VECTOR - IS A FOURTEEN(14) WORD INTEGER ARRAY OF ARGUMENTS VECTOR(1) /FILE: ARGUMENT 1=ASCII (DEFAULT) 2=FORTRAN DATA 3=COBOL 4=CREF(NOT IMPLEMENTED. ASSUMES ASCII) 5=RUNOFF(NOT IMPLEMENTED. ASSUMES ASCII) 6=ELEVEN VECTOR(2) /LIMIT: ARGUMENT VECTOR(3) /COPIES:N (FROM 1 TO 63) VECTOR(4) /DISP: 1=PRESERVE 2=RENAME 3=DELETE VECTOR(5) AFTER SWITCH PART ONE TIME OF DAY OR PLUS TIME IN MINUTES PLUS TIME IS INDICATED BY A NEGATIVE IN VECTOR(6) VECTOR(6) AFTER SWITCH PART TWO DATE IN 15 BIT FORMAT OR ZERO FOR TODAY NEGATIVE INDICATES TIME IS PLUS FORMAT VECTOR(7) DEADLINE SWITCH PART ONE. SAME AS AFTER VECTOR(8) DEADLINE SWITCH PART TWO. SAME AS AFTER VECTOR(9) /PRIORITY:(N+1) GIVE NUMBER IN RANGE 1 TO 63. ACTUAL PRIORITY IS ONE LESS. DEFAULT IT 10 VECTOR(10) /PAPER: ARGUMENT VALUE MEANING LPT CDP PTP PLT 1 ARROW(*) ASCII(*) ASCII(*) IMAGE 2 ASCII 026 IMAGE ASCII(*) 3 OCTAL BINARY IMG BIN BINARY 4 SUPPRESS D029 BINARY 5 IMAGE VECTOR(11) /HEAD:N 0=NO HEADER 1=FILE HEADER VECTOR(12) /SPACING: ARGUMENT 1=SINGLE 2=DOUBLE 3=TRIPLE VECTOR(13) /FORMS:NAME FIRST FIVE CHARACTERS VECTOR(14) REMAINING CHARACTER TO FORMS NAME ASCII NAME OF SPECIAL FORMS TO USE % SUBTTL DEFINITIONS AND DATA ; BITS THAT WE MUST DEFINE BECAUSE FORPRM AND UUOSYM DISAGREE DV.DSK==1B1 ;DEVICE IS A DSK DV.TTY==1B14 ;DEVICE IS A TTY ; AC DEFINITIONS F=0 A=1 B=2 C=3 WD=4 ;SIXBIT ANSWER FROM ASCSIX T1=WD BP6=5 ;SIXBIT POINTER T2=BP6 BP7=6 ;ASCII POINTER T3=BP7 N=7 ;NUMBER T4=N CH=10 ;CHARACTER T5=CH V=11 ;POINTER TO ARG VECTOR QD=12 ;QUE TYPE QF=13 ;POINTER TO CURRENT FILE BLOCK IN QUE BLOCK Q=14 ;POINTER TO QUE AREA ; FLAGS IN LH OF F NEDREN==400000 ;FLAG IN DOFIL$ THAT A RENAME IS NEEDED LOGFIL==200000 ;FLAG TO DOFIL$ THAT THIS IS THE LOG FILE CTLFIL==100000 ;FLAG TO DOFIL$ THAT THIS IS THE CTL FILE QUENAM: ASCII/LPT / ASCII/CDP / ASCII/PTP / ASCII/PLT / QUESZ==.-QUENAM ; TABLE OF MAXIMUM LEGAL PAPER MODES BY DEVICE MAXPAP: %QFLSU ;LPT %QFCIM ;CDP %QFTBI ;PTP %QFPBI ;PLT ; TABLE OF DIVISORS FOR CALCULATING DEFAULT LIMITS LIMDIV: 1 ;LPT 1 ;CDP 1 ;PTP ^D20 ;PLT ; TABLE OF ADDITIONAL QUANTA FOR CALCULATING DEFAULT LIMITS LIMADD: ^D20 ;LPT ^D100 ;CDP ^D20 ;PTP ^D5 ;PLT ; TABLE OF DEFAULT MODES FOR CDP(LH),PTP(RH) PUNMOD: XWD %QFCAS,%QFTAS XWD %QFCAS,%QFTAS XWD 77, 77 XWD 77, 77 XWD 77, 77 XWD 77, 77 XWD 77, 77 XWD 77, 77 XWD %QFCIM,%QFTIM XWD 77, 77 XWD 77, 77 XWD %QFCIM,%QFTIB XWD %QFCBI,%QFTBI XWD 77,%QFTBI XWD %QFCBI,%QFTBI XWD %QFCBI,%QFTBI FILDEV: BLOCK 1 ;DEVICE FILE IS ON FILNAM: BLOCK 2 ;FILE NAME FILEXT=FILNAM+1 ;EXTENSION SUBTTL QUEOUT - INITIALIZATION CODE HELLO (QUEOUT) ;ENTRANCE MOVE A,[BYTE(9).QOHED,Q.FMOD+1(18)1] PUSHJ P,GTINF$## ;GET QUE DEVICE, OTHER INFO SKIPN A,@2(16) ;SPECIFYING OUTPUT QUEUE? MOVE A,QUENAM ;NO. ASSUME LPT MOVSI QD,-QUESZ ;FIND IT IN TABLE CAME A,QUENAM(QD) ;MATCH? AOBJN QD,.-1 ;NO. TRY NEXT JUMPGE QD,NOSUCH ;ANY MATCH? TLZ QD,-1 ;JUST KEEP INDEX PUSHJ P,GETDEV ;GET THE DEVICE NAME JRST ILLDEV ;ILLEGAL PUSHJ P,GETNAM ;GET THE FILE NAME JRST ILLNAM ;ILLEGAL MOVEI A,16 ;DUMP MODE MOVE B,FILDEV ;DEVICE SETZ C, ;NO BUFFERS OPEN 0,A ;OPEN DEVICE JRST ILLDEV ;CAN'T SUBTTL QUEOUT - PICK UP VECTOR ARGUMENTS MOVEI V,@3(16) ;SET ADDRESS OF ARG VECTOR SKIPG A,(V) ;GET FILE:XX ARG MOVEI A,.QFFAS ;DEFAULT IS ASCII CAILE A,.QFF11 ;LEGAL ARG? JRST ILLARG ;NO. ERROR CAIE A,.QFFCR ;CREF? CAIN A,.QFFRU ;RUNOFF? MOVEI A,.QFFAS ;TREAT AS ASCII DPB A,[POINTR(Q.OMOD(Q),QF.FFM)] SKIPG A,2(V) ;GET /COPIES:N MOVEI A,1 ;DEFAULT ONE COPY CAILE A,^D63 ;LEGAL NUMBER? MOVEI A,^D63 ;NO. MAXIMUM MOVEM A,COPIES# ;REMEMBER DPB A,[POINTR(Q.OMOD(Q),QF.COP)] SKIPG A,3(V) ;GET /DISP: MOVEI A,.QFDPR ;DEFAULT IS PRESERVE CAILE A,.QFDDE ;LEGAL DISPOSITION? JRST ILLARG ;NO. ERROR DPB A,[POINTR(Q.OMOD(Q),QF.DSP)] DMOVE A,4(V) ;GET /AFTER WORDS PUSHJ P,DDAFT$## ;CONVERT TO PROPER FORMAT MOVEM C,Q.AFTR(Q) ;STORE DMOVE A,6(V) ;GET /DEADLINE WORDS PUSHJ P,DDAFT$## ;CONVERT TO PROPER FORMAT MOVEM C,Q.DEAD(Q) ;STORE SKIPG A,^D8(V) ;GET /PRIORITY:N MOVEI A,^D11 ;DEFAULT IS 10 CAILE A,^D63 ;LEGAL? MOVEI A,^D63 ;MAXIMUM SUBI A,1 ;REAL RANGE IS 0-62 DPB A,[POINTR(Q.PRI(Q),QP.PRI)] SKIPG A,^D9(V) ;GET /PAPER:XXX SWITCH (PRINT,PLOT,PUNCH,TAPE) PUSHJ P,DEFPAP ;GET DEFAULT PAPER MODE CAMLE A,MAXPAP(QD) ;LEGAL? JRST ILLARG ;NO. ERROR DPB A,[POINTR(Q.OMOD(Q),QF.PFM)] MOVSI A,(QF.NFH) ;GET /HEAD:N SKIPLE ^D10(V) ;WANT A HEADER? IORM A,Q.OMOD(Q) ;YES. SET IT SKIPG A,^D11(V) ;GET /SPACE:XXX MOVEI A,1 ;DEFAULT IS SINGLE CAILE A,3 ;LEGAL? JRST ILLARG ;NO. ERROR DPB A,[POINTR(Q.OMOD(Q),QF.SPC)] MOVEI BP7,^D12(V) ;GET /FORMS SWITCH PUSHJ P,ASC6.6## ;WHICH IS IN ASCII JFCL ;ANY TERMINATOR OK MOVEM WD,Q.OFRM(Q) ;STORE IT DMOVE A,FILNAM ;GET FILE NAME ;AND EXTENSION MOVEI QF,Q.OSTR(Q) ;AND WHERE FILE BLOCK STARTS PUSHJ P,DOFIL$## ;DO NECESSARY THINGS TO FILE JRST NOFILE ;FILE NOT FOUND MOVE A,COPIES ;GET COPIES BACK IMUL A,$RBSIZ## ;COMPUTE BLOCKS*COPIES/8 IDIVI A,^D1024 ADDI A,1 HRRM A,Q.OSIZ(Q) ;QS.BLK SKIPG A,1(V) ;GET /LIMIT:N PUSHJ P,DEFLIM ;GET DEFAULT LIMIT BASED ON FILE SIZE CAILE A,777776 ;LEGAL SIZE? MOVEI A,777776 ;NO. MAKE MAXIMUM HRLM A,Q.OSIZ(Q) ;QS.LIM PUSHJ P,$DOQUE## ;GO ACTUALLY DO THE QUEING JRST ERRRET ;ERROR RETURN GOODBY (5) ;RETURN SUBTTL SUBROUTINE TO STORE COMPLEX DEFAULTS DEFPAP: JUMPE QD,DFPAPL ;LPT. LDB B,[POINT 4,$RBPRV##,12] ;GET FILE MODE CAIN QD,3 ;PLOTTER? JRST DFPAPP ;YES CAIN QD,1 ;CDP? JRST DFPAPC ;YES DFPAPT: HRRZ A,PUNMOD(B) ;PTP. GET /TAPE BASED ON FILE MODE POPJ P, DFPAPP: MOVEI A,%QFPAS ;PLOT. ASSUME DEFAULT IS ASCII CAILE B,1 ;IS IT ASCII FILE? MOVEI A,%QFPIM ;NO. USE OTHER MODE POPJ P, DFPAPC: HLRZ A,PUNMOD(B) ;CDP. GET /PUNCH BASED ON FILE MODE POPJ P, DFPAPL: MOVEI A,%QFLAR ;LPT. DEFAULT IS ARROW POPJ P, DEFLIM: MOVE A,$RBSIZ## ;GET FILE SIZE IN WORDS IMUL A,COPIES ;TIMES COPIES IDIVI A,^D128 ;CONVERT TO BLOCKS SKIPE B ADDI A,1 ;AND FRACTION IDIV A,LIMDIV(QD) ;CALCULATE LIMIT ADD A,LIMADD(QD) ;BASED ON DEVICE POPJ P, ;RETURN SUBTTL SUBROUTINES TO READ ASCII ARGS GETNAM: MOVEI BP7,@1(16) ;GET ADDRESS OF ARGUMENT PUSHJ P,ASC6.6## ;READ THE FILE NAME JRST GETNM1 ;FUNNY TERMINATOR ILDB CH,BP7 ;GET THE TERMINATOR GETNM1: JUMPE WD,CPOPJ ;ERROR MOVEM WD,FILNAM ;STORE FILE NAME SETZM FILEXT CAIN CH," " ;NO EXTENSION? JRST CPOPJ1 ;YES. OK CAIE CH,"." ;EXTENSION COMING? POPJ P, ;NO. ERROR MOVEI N,3 ;NOW GET EXTENSION PUSHJ P,ASC6.C## ;CONTINUING ON JRST GETNM3 ;TERMINATOR GETNM2: HLLZM WD,FILEXT ;STORE EXTENSION CPOPJ1: AOS (P) ;SKIP RETURN. GOOD NAME CPOPJ: POPJ P, GETNM3: CAIN CH," " ;VALID TERMINATOR FOR EXT? JRST GETNM2 ;YES. STORE IT POPJ P, ;NO. ERROR GETDEV: MOVEI BP7,@0(16) ;GET ADDRESS OF ARGUMENT PUSHJ P,ASC6.5## ;FIVE CHARACTERS JRST GETDV2 ;IGNORE COLON IF PRESENT GETDV1: JUMPN WD,.+2 ;GIVE A DEVICE? MOVSI WD,'DSK' ;NO. ASSUME DISK MOVEM WD,FILDEV DEVCHR WD, ;GET CHARACTERISTICS TLNN WD,(DV.TTY) ;IS IT A REAL DISK? TLNN WD,(DV.DSK) ;SINCE NUL: HAS DV.DSK SET TOO POPJ P, ;NO. ERROR JRST CPOPJ1 ;GOOD DEVICE GETDV2: CAIE CH," " ;END WITH SPACE CAIN CH,":" ;OR COLON? JRST GETDV1 ;YES. OK POPJ P, ;NO. ERROR SUBTTL ERROR ROUTINES NOSUCH: MOVEI 1,1 ;UNDEFINED QUEUE ERRRET: MOVEM 1,@4(16) ;STORE ERROR CODE GOODBY (5) ;RETURN ILLDEV: MOVEI 1,2 ;ILLEGAL DEVICE JRST ERRRET ;RETURN ILLNAM: MOVEI 1,3 ;ILLEGAL FILE NAME JRST ERRRET ;RETURN NOFILE: MOVEI 1,4 ;NO SUCH FILE JRST ERRRET ;RETURN ILLARG: MOVEI 1,5 ;ILLEGAL ARGUMENT IN VECTOR JRST ERRRET ;RETURN PRGEND TITLE SUBMIT - ROUTINES TO MAKE INPUT QUEUE ENTRIES SUBTTL USAGE INSTRUCTIONS SEARCH FORPRM,QPRM,MACTEN,UUOSYM ; FORPRM IS UNIVERSAL FILE FROM FOROTS ; QPRM IS UNIVERSAL FILE FOR QUEUE DEFINITIONS. SEE ... ; MACTEN IS UNIVERSAL FILE WITH USEFUL MACRO DEFINITIONS SEE ... ; UUOSYM IS UNIVERSAL FILE WITH UUO SYMBOLS DEFINITIONS SEE ... COMMENT % USAGE CALL SUBMIT(VECTOR) WHERE VECTOR IS AN 19 WORD SINGLE PRECISION ARRAY CONTAINING VECTOR(1) NAME OF CTL FILE. MAX. OF FIVE CHARACTERS ASCII. EXT IS ALWAYS .CTL VECTOR(2) NAME OF LOG FILE. MAX. OF FIVE CHARACTERS ASCII. EXT IS ALWAYS .LOG. DEFAULT IS SAME AS CTL FILE VECTOR(3) DISPOSITION FOR CTL FILE. 0=PRESERVE 1=DELETE VECTOR(4) DISPOSITION FOR LOG FILE. 0=PRESERVE 1=DELETE VECTOR(5) TIME LIMIT IN SECONDS. DEFAULT IS 60. VECTOR(6) PAGE LIMIT. DEFAULT IS 200 VECTOR(7) CARD LIMIT. DEFAULT IS 0 VECTOR(8) PAPER TAPE LIMIT. DEFAULT IS 0 VECTOR(9) PLOTER LIMIT. DEFAULT IS 0 VECTOR(10) CORE LIMIT. DEFAULT IS CORMAX VECTOR(11) RESTARTABLITY. 0=YES 1=NO VECTOR(12) UNIQUENESS. 0=RUN ANY NUMBER OF JOBS UNDER PPN 1=GUARANTEE UNIQUE UNDER PPN 2=GUARANTEE UNIQUE TO SFD VECTOR(13) PRIORITY (1-62) STANDARD IS 10 VECTOR(14) OUTPUT SWITCH (0,1,2,3,4) VECTOR(15) DEPENDENCY SWITCH (0-177777) VECTOR(16) AFTER SWITCH PART ONE TIME OF DAY OR PLUS TIME IN MINUTES PLUS TIME IS INDICATED BY A NEGATIVE IN VECTOR(17) VECTOR(17) AFTER SWITCH PART TWO DATE IN 15 BIT FORMAT OR ZERO FOR TODAY NEGATIVE INDICATES TIME IS PLUS FORMAT VECTOR(18) DEADLINE SWITCH PART ONE. SAME AS AFTER VECTOR(19) DEADLINE SWITCH PART TWO. SAME AS AFTER % SUBTTL DEFINITIONS AND DATA ; BITS THAT WE MUST DEFINE BECAUSE FORPRM AND UUOSYM DISAGREE DV.DSK==1B1 ;DEVICE IS A DSK DV.TTY==1B14 ;DEVICE IS A TTY ; AC DEFINITIONS F=0 A=1 B=2 C=3 WD=4 ;SIXBIT ANSWER FROM ASCSIX T1=WD BP6=5 ;SIXBIT POINTER T2=BP6 BP7=6 ;ASCII POINTER T3=BP7 N=7 ;NUMBER T4=N CH=10 ;CHARACTER T5=CH V=11 ;POINTER TO ARG VECTOR QD=12 ;QUE TYPE QF=13 ;POINTER TO CURRENT FILE BLOCK IN QUE BLOCK Q=14 ;POINTER TO QUE AREA ; FLAGS IN LH OF F NEDREN==400000 ;FLAG IN DOFIL$ THAT A RENAME IS NEEDED LOGFIL==200000 ;FLAG TO DOFIL$ THAT THIS IS THE LOG FILE CTLFIL==100000 ;FLAG TO DOFIL$ THAT THIS IS THE CTL FILE SUBTTL SUBMIT - INITIALIZATION CODE HELLO (SUBMIT) MOVE A,[BYTE(9).QIHED,Q.FMOD+1(18)2] PUSHJ P,GTINF$## ;GET QUE DEVICE, OTHER INFO MOVEI QD,4 ;INP QUEUE MOVEI V,@0(16) ;GET ADDRESS OF ARGUMENT VECTOR MOVEI A,111301 ;SET DEFAULT BITS ON CTL,LOG FILE MODES MOVEM A,Q.CMOD(Q) TLO A,(QF.LOG) ;SET LOG BIT TOO MOVEM A,Q.LMOD(Q) MOVEI BP7,(V) ;GET ADDRESS OF CTL NAME PUSHJ P,ASC6.5## ;FIVE CHARACTERS JFCL ;IGNORE ERRORS JUMPE WD,ERRNAM ;ZERO NAME ILLEGAL MOVE A,WD MOVSI B,'CTL' MOVEI QF,Q.CSTR(Q) ;ADDRESS OF CTL FILE BLOCK PUSHJ P,OPDSK$## ;OPEN UP THE DISK JRST NODSK ;OOPS TLO F,CTLFIL ;CTL FILE PUSHJ P,DOFIL$## ;DO THE FILE THINGS JRST NTFND ;OOPS TLZ F,CTLFIL ;NOT CTL FILE NOW MOVEI BP7,1(V) ;GET ADDRESS OF LOG FILE NAME PUSHJ P,ASC6.5## ;FIVE CHARACTERS JFCL SKIPN A,WD ;NOW DO THIS FILE MOVE A,Q.LNAM(Q) ;DEFAULT IS CTL NAME MOVSI B,'LOG' ;SET EXTENSION PUSHJ P,OPDSK$## ;OPEN UP THE DISK JRST NODSK ;OOPS TLO F,LOGFIL ;LOG NOW MOVEI QF,Q.LSTR(Q) ;ADDRESS OF LOG FILE BLOCK PUSHJ P,DOFIL$## ;DO THE FILE THINGS JFCL ;OK IF LOG DOESNT EXIST TLZ F,LOGFIL ;NOT LOG FILE NOW MOVE A,Q.PPN(Q) ;ASSUME NO SFDS MOVEM Q.IDDI(Q) ;IN DEFAULT PATH HRLO A,THSJB$## ;GET OUR DEFAULT PATH MOVEM A,PTHBL$## MOVE A,[XWD ^D8,PTHBL$##] PATH. A, JRST SUBARG ;JUST PPN MOVSI A,PTHBL$##+2 ;MOVE IT HRRI A,Q.IDDI(Q) BLT A,Q.IDDI+5(Q) SUBTTL SUBMIT - PICK UP VECTOR ARGUMENTS SUBARG: SKIPL A,2(V) ;/DISPOSE .CTL CAILE A,1 ;LEGAL? MOVEI A,1 ;DEFAULT IS DELETE MOVEI B,.QFDDE SKIPN A ;DELETE? MOVEI B,.QFDPR ;PRESERVE DPB B,[POINTR(Q.CMOD(Q),QF.DSP)] SKIPG A,3(V) ;/DISPOSE .LOG CAILE A,1 ;LEGAL? MOVEI A,1 ;NO MOVEI B,.QFDDE SKIPN A ;DELETE? MOVEI B,.QFDPR ;PRESERVE DPB B,[POINTR(Q.LMOD(Q),QF.DSP)] SKIPG A,4(V) ;GET /TIME MOVEI A,^D60 ;DEFAULT IS 60 SECONDS TLNE A,-1 ;TOO LONG? MOVEI A,777777 ;YES HRRM A,Q.ILIM(Q) SKIPG A,5(V) ;GET /PAGES MOVEI A,^D200 ;DEFAULT IS 200 PAGES TLNE A,-1 ;TOO LARGE MOVEI A,777777 ;YES HRLM A,Q.ILM2(Q) SKIPG A,6(V) ;GET /CARDS MOVEI A,0 ;USE DEFAULT LIMITS TLNE A,-1 ;TOO LARGE? MOVEI A,777777 ;YES HRRM A,Q.ILM2(Q) SKIPG A,7(V) ;GET /FEET (PAPER TAPE) MOVEI A,0 ;USE DEFAULT LIMITS TLNE A,-1 ;TOO LARGE? MOVEI A,777777 ;YES HRLM A,Q.ILM3(Q) SKIPG A,^D8(V) ;GET /TPLOT (PLOT TIME) MOVEI A,0 ;USE DEFAULT LIMITS TLNE A,-1 ;TOO LARGE? MOVEI A,777777 ;YES HRRM A,Q.ILM3(Q) SKIPG A,^D9(V) ;GET /CORE PUSHJ P,DEFCOR ;GET DEFAULT LIMIT CAIGE A,^D512 ;AT LEAST ONE PAGE? LSH A,^D10 ;NO. MUST MEAN K TLNE A,-1 ;TOO BIG? MOVEI A,777777 ;YES HRLM A,Q.ILIM(Q) SKIPE A,^D10(V) ;RESTARTABLE? MOVSI A,(QI.NRS) ;NO. SAY SO IORM A,Q.IDEP(Q) SKIPL A,^D11(V) ;UNIQUENESS CAILE A,.QIUSD ;VALID? MOVEI A,.QIUSD ;NO. USE DEFAULT DPB A,[POINTR(Q.IDEP(Q),QI.UNI)] SKIPLE A,^D12(V) ;/PRIORITY CAILE A,^D62 ;LEGAL? MOVEI A,^D10 ;NO. USE DEFAULT DPB A,[POINTR(Q.PRI(Q),QP.PRI)] SKIPL A,^D13(V) ;/OUTPUT CAILE A,.QIOAL MOVEI A,.QIOAL ;INVALID. USE DEFAULT DPB A,[POINTR(Q.IDEP(Q),QI.OUT)] SKIPG A,^D14(V) ;DEPENDENCY MOVEI A,0 ;DEFAULT IS ZERO CAILE A,177777 ;LEGAL? MOVEI A,177777 ;USE MAX IF ILLEGAL DPB A,[POINTR(Q.IDEP(Q),QI.DEP)] DMOVE A,^D15(V) ;GET TWO WORDS OF /AFTER PUSHJ P,DDAFT$## ;CONVERT TO INTERNAL FORMAT MOVEM C,Q.AFTR(Q) ;STORE AFTER TIME DMOVE A,^D17(V) ;GET TWO WORDS OF /DEAD PUSHJ P,DDAFT$## ;CONVERT TO INTERNAL FORMAT MOVEM C,Q.DEAD(Q) ;STORE DEADLINE TIME PUSHJ P,$DOQUE## ;GO ACTUALLY DO THE QUEING JRST ERRXIT ;ERROR RETURN GOODBY (1) ;RETURN SUBTTL SUBROUTINE TO STORE COMPLEX DEFAULTS DEFCOR: MOVE A,[%NSCMX] ;GET CORMAX GETTAB A, MOVEI A,^D26*^D1024 ;DEFAULT IS 26 K SETO B, ;LESS ONE PAGE IF KI OR KL AOBJN B,.+1 SKIPN B ;KA? SUBI A,^D512 ;KI OR KL POPJ P, SUBTTL ERROR ROUTINES NTFND: OUTSTR [ASCIZ/ % FILE NOT FOUND IN SUBMIT! /] ERRXIT: RELEAS 0, GOODBY 1 NODSK: OUTSTR [ASCIZ/ % CANNOT OPEN DISK! /] JRST ERRXIT ERRNAM: OUTSTR [ASCIZ/% NULL FILE NAME ILLEGAL. JOB NOT SUBMITTED. /] GOODBY 1 PRGEND TITLE MISC. - DO /DEADLINE , /AFTER , CONVERT ASCII TO SIXBIT SUBTTL DEFINITIONS AND DATA SEARCH FORPRM ENTRY DDAFT$,ASC6.5,ASC6.6,ASC6.C ; FORPRM IS UNIVERSAL FILE FROM FOROTS ; AC DEFINITIONS F=0 A=1 B=2 C=3 WD=4 ;SIXBIT ANSWER FROM ASCSIX T1=WD BP6=5 ;SIXBIT POINTER T2=BP6 BP7=6 ;ASCII POINTER T3=BP7 N=7 ;NUMBER T4=N CH=10 ;CHARACTER T5=CH V=11 ;POINTER TO ARG VECTOR QD=12 ;QUE TYPE QF=13 ;POINTER TO CURRENT FILE BLOCK IN QUE BLOCK Q=14 ;POINTER TO QUE AREA SUBTTL SUBROUTINES TO DO /DEADLINE AND /AFTER DDAFT$::SETZ C, ;ASSUME NO TIME JUMPL A,CPOPJ ;NEGATIVE TIME IS ILLEGAL DATE T1, ;GET DATE MSTIME T2, ;AND TIME IDIVI T2,^D1000*^D60 ;IN MINUTES JUMPL B,PLSTIM ;NEGATIVE DATE IS FLAG FOR PLUS TIME JUMPN B,DEDAF1 ;ANY DATE GIVEN? JUMPE A,CPOPJ ;NO. ANY ARG AT ALL? MOVE B,T1 ;NO DATE. USE TODAY DEDAF1: PUSHJ P,CNVDAT ;CONVERT DATE TO INTERNAL FORMAT HRLZ C,T3 ;AND STORE IN C MOVE T3,A ;GET TIME MUL T3,[1000000] ;* 2^18 DIVI T3,^D24*^D60 ;/MINUTES PER DAY ADD C,T3 ;ALLOW TO OVERFLOW INTO DAYS CPOPJ: POPJ P, PLSTIM: MOVE B,T1 ;TODAYS DATE ADD A,T2 ;TIME PLUS CURRENT TIME JRST DEDAF1 ;AND PROCESS THAT RADIX 10 DATOFS==38395 CNVDAT: PUSH P,T1 PUSH P,T2 MOVE T2,B ;GET DATE IDIVI T2,12*31 ;T2=YEARS-1964 IDIVI T3,31 ;T3=MONTHS-JAN, T4=DAYS-1 ADD T4,DAYTAB(T3) ;T4=DAYS-JAN 1 MOVEI T5,0 ;LEAP YEAR ADDITIVE IF JAN,FEB CAIL T3,2 ;CHECK MONTH MOVEI T5,1 ;ADDITIVE IF MAR-DEC MOVE T1,T2 ;SAVE YEARS FOR REUSE ADDI T2,3 ;MAKE LEAP YEARS COME OUT RIGHT IDIVI T2,4 ;HANDLE REGULAR LEAP YEARS CAIE T3,3 ;SEE IF THIS IS LEAP YEAR MOVEI T5,0 ;NO--WIPE OUT ADDITIVE ADDI T4,DATOFS(T2) MOVE T2,T1 ;RESTORE YEARS SINCE 1964 IMULI T2,365 ;DAYS SINCE 1964 ADD T4,T2 ;T4 = DAYS EXCEPT FOR 100 YR. FUDGE HRREI T2,64-99(T1) ;T2=YEARS SINCE 2000 JUMPLE T2,CNVDT1 ;ALL DONE IF NOT YET 2000 IDIVI T2,100 ;GET CENTURIES SINCE 2000 SUB T4,T2 ;ALLOW FOR LOST LEAP YEARS CAIE T3,99 ;SEE IF THIS IS A LOST L.Y. CNVDT1: ADD T4,T5 ;ALLOW FOR LEAP YEAR THIS YEAR MOVE T3,T4 ;RETURN IN T3 POP P,T2 ;RESTORE T2 POP P,T1 ;T1 POPJ P, DAYTAB: EXP 0,31,59,90,120,151,181,212,243,273,304,334 RADIX 8 SUBTTL SUBROUTINES TO READ ASCII ARGS ASC6.5::SKIPA N,[5] ;GET FIVE CHARACTERS ASC6.6::MOVEI N,6 ;GET SIX CHARACTERS HRLI BP7,440700 ;SET UP ASCII BYTE POINTER ASC6.C::SETZ WD, ;START WITH A BLANK MOVE BP6,[POINT 6,WD] ASCSIX: ILDB CH,BP7 ;GET A CHARACTER CAIG CH," " ;BREAK? MOVEI CH," " ;MAKE IT A SPACE CAIL CH,140 ;LOWER CASE? CAILE CH,172 ;... CAIA ;NO SUBI CH,40 ;YES. MAKE UPPER CAIL CH,"0" ;ALPHANUMERIC? CAILE CH,"Z" ;... POPJ P, ;NO. CAILE CH,"9" ;... CAIL CH,"A" ;... TRCA CH,40 ;YES. CONVERT TO SIXBIT POPJ P, ;NO. ERROR TLNE BP6,770000 ;IF THERE IS ROOM, IDPB CH,BP6 ;STORE IT SOJG N,ASCSIX ;LOOP FOR N CHARACTERS AOS (P) ;GIVE GOOD RETURN POPJ P, PRGEND TITLE QUEUES - ROUTINES TO MAKE INPUT/OUTPUT QUEUE ENTRIES SUBTTL DEFINITIONS AND DATA SEARCH FORPRM,QPRM,MACTEN,UUOSYM ; FORPRM IS UNIVERSAL FILE FROM FOROTS ; QPRM IS UNIVERSAL FILE FOR QUEUE DEFINITIONS. SEE ... ; MACTEN IS UNIVERSAL FILE WITH USEFUL MACRO DEFINITIONS SEE ... ; UUOSYM IS UNIVERSAL FILE WITH UUO SYMBOLS DEFINITIONS SEE ... ENTRY DOFIL$,GTINF$,OPDSK$,$DOQUE ; BITS THAT WE MUST DEFINE BECAUSE FORPRM AND UUOSYM DISAGREE DV.DSK==1B1 ;DEVICE IS A DSK DV.TTY==1B14 ;DEVICE IS A TTY ; AC DEFINITIONS F=0 A=1 B=2 C=3 WD=4 ;SIXBIT ANSWER FROM ASCSIX T1=WD BP6=5 ;SIXBIT POINTER T2=BP6 BP7=6 ;ASCII POINTER T3=BP7 N=7 ;NUMBER T4=N CH=10 ;CHARACTER T5=CH V=11 ;POINTER TO ARG VECTOR QD=12 ;QUE TYPE QF=13 ;POINTER TO CURRENT FILE BLOCK IN QUE BLOCK Q=14 ;POINTER TO QUE AREA ; FLAGS IN LH OF F NEDREN==400000 ;FLAG IN DOFIL$ THAT A RENAME IS NEEDED LOGFIL==200000 ;FLAG TO DOFIL$ THAT THIS IS THE LOG FILE CTLFIL==100000 ;FLAG TO DOFIL$ THAT THIS IS THE CTL FILE QUESIX: SIXBIT/LPT/ SIXBIT/CDP/ SIXBIT/PTP/ SIXBIT/PLT/ SIXBIT/INP/ SPLNAM: SIXBIT/LPTSPL/ SIXBIT/CDPSPL/ SIXBIT/PTPSPL/ SIXBIT/PLTSPL/ SIXBIT/BATCON/ Q.LGTO==Q.OMOD ;LENGTH OF OUTPUT QUE Q.LGTI==Q.LMOD ;LENGTH OF INPUT QUE Q.LGTH==Q.LMOD ;LENGTH OF MAXIMUM QUE RECORD QHEAD: BLOCK 1 ;UNUSED HEADER FOR QMANGR QUEBLK: BLOCK Q.LGTH ;QUE RECORD OLIST: IOWD Q.LGTH,QUEBLK 0 QUEDIR: BLOCK 1 ;PPN FOR QUE QUESTR: BLOCK 1 ;STR FOR QUE THSJB$::BLOCK 1 $RBBLK::.RBDEV ;INCLUDE FILE STR/UNIT ARG BLOCK .RBDEV ;ROOM FOR ARGUMENTS $RBPPN=:$RBBLK+.RBPPN $RBNAM=:$RBBLK+.RBNAM $RBEXT=:$RBBLK+.RBEXT $RBPRV=:$RBBLK+.RBPRV $RBSIZ=:$RBBLK+.RBSIZ $RBVER=:$RBBLK+.RBVER $RBSPL=:$RBBLK+.RBSPL $RBEST=:$RBBLK+.RBEST $RBALC=:$RBBLK+.RBALC $RBPOS=:$RBBLK+.RBPOS $RBFT1=:$RBBLK+.RBFT1 $RBNCA=:$RBBLK+.RBNCA $RBMTA=:$RBBLK+.RBMTA $RBDEV=:$RBBLK+.RBDEV PTHBL$::BLOCK 10 SUBTTL COMMON CODE FOR OUTPUT, SUBMIT $DOQUE::MOVE A,QUESIX(QD) ;GET GENERIC OUTPUT DEVICE MOVEM A,Q.DEV(Q) ;AND STORE THAT CAIN QD,4 ;INP: ? MOVSI A,'LPT' ;USE LPT FOR BATCH WHERE A, ;FIND STATION FOR REQUEST SETZ A, ;ASSUME CENTRAL HRRM A,Q.DEV(Q) ;STORE IT MOVE A,[XWD 400000,16] ;PHYSICAL OPEN MOVE B,QUESTR ;QUE DEVICE SETZ C, ;NO BUFFERS OPEN 0,A ;OPEN IT JRST NOQUE ;CAN'T MOVSI T3,'QUE' ;EXTENSION FOR UNINAM PUSHJ P,UNINAM ;GET A UNIQUE NAME LOOKUP 0,T2 ;CHANNEL ZERO. T2-T5 MOVSI T4,177000 ;NOW ENTER IT AND PROTECT IT ENTER 0,T2 ;ENTER IT JRST NOENT ;CAN'T ENTER IT MOVNI A,Q.LGTO ;NEGATIVE LENGTH OF OUTPUT ENTRY CAIN QD,4 ;INP:? MOVNI A,Q.LGTI ;NEGATIVE LENGTH OF INPUT ENTRY HRLM A,OLIST ;FIX IOWD OUTPUT 0,OLIST ;WRITE IT RELEAS 0, ;RELEAS IT MOVE A,[%NSHJB] ;GET HIGHEST JOB NUMBER GETTAB A, MOVEI A,^D64 ;?? MOVEI B,1 CREDN2: HRLZ C,B ;LOOK AT JOB NAMES HRRI C,.GTPRG ;IN MONITOR GETTAB C, JRST CPOPJ1 CAME C,SPLNAM(QD) ;WHO WE QUEUED FOR? JRST CREDN3 ;NO. LOOK AT MORE MOVE C,B ;WAKE HIM WAKE C, JFCL ;OH WELL CREDN3: CAIGE B,(A) ;LOOKED AT ALL JOBS? AOJA B,CREDN2 ;NO. CONTINUE CPOPJ1: AOS (P) ;SKIP RETURN TO USER CPOPJ: POPJ P, SUBTTL SUBROUTINES TO DO COMMON THINGS FOR INPUT/OUTPUT ; GET COMMON INFO GTINF$::MOVEI Q,QHEAD ;SET ADDRESS OF QUEUE BLOCK SETZB F,QHEAD ;START WITH NO FLAGS MOVE T1,[XWD QHEAD,QHEAD+1] BLT T1,Q.LMOD ;CLEAR QUEUE BLOCK MOVEM A,Q.LEN(Q) ;STORE QUE HEADER MOVEI A,12001 ;VERSION 1, US, CREATE MOVEM A,Q.OPR(Q) ;STORE IT HRROI A,.GTNM1 ;GET USER NAME GETTAB A, SETZ A, MOVEM A,Q.USER(Q) ;REMEMBER IT HRROI A,.GTNM2 ;GET REST OF USER NAME GETTAB A, SETZ A, MOVEM A,Q.USER+1(Q) ;REMEMBER THAT TOO HRROI A,.GTCNO ;GET CHARGE NUMBER GETTAB A, SETZ A, MOVEM A,Q.CNO(Q) ;REMEMBER THAT MOVE A,[%LDSTP] ;GET STANDARD PROTECTION GETTAB A, MOVSI A,055000 ;DEFAULT LSH A,-^D27 ;REALIGN DPB A,[POINTR(Q.PRI(Q),QP.PRO)] PJOB A, ;GET OUR JOB NUMBER MOVEM A,THSJB$ ;REMEMBER IT GETPPN A, ;GET OUR PPN JFCL ;JUST IN CASE MOVEM A,Q.PPN(Q) ;STORE IT IN QUE BLOCK MOVSI A,'QUE' ;FIND QUE DEVICE DEVCHR A, ;SEE WHAT IT IS TLNE A,(DV.DSK) ;REAL DISK? TLNE A,(DV.TTY) ;MAYBE JRST PUBQUE ;NO MOVSI A,'QUE' ;GET PPN ASSOCIATED DEVPPN A, MOVE A,Q.PPN(Q) CAME A,Q.PPN(Q) ;IS IT HIMSELF? JRST PUBQUE ;NO. PUBLIC QUEUE MOVSI B,'QUE' ;GET ASSOCIATED STR DEVNAM B, MOVSI B,'DSK' JRST STOQUE ;STORE QUE PUBQUE: MOVE A,[%LDQUE] ;GET QUE PPN GETTAB A, MOVE A,[XWD 3,3] ;DEFAULT MOVE B,[%LDQUS] ;GET QUE STR GETTAB B, MOVSI B,'DSK' STOQUE: MOVEM A,QUEDIR ;STORE QUE PPN MOVEM B,QUESTR ;STORE QUE STR POPJ P, DOFIL$::SETZM $RBPPN ;CLEAR UUO BLOCK MOVE T1,[XWD $RBPPN,$RBNAM] BLT T1,$RBDEV MOVEM A,$RBNAM ;SET NAME TO FIND MOVEM A,Q.FNAM(QF) ;AND IN QUE BLOCK MOVEM A,Q.JOB(Q) ;STORE AS NAME OF JOB ;(MAKES DEFAULT JOB NAME LOG NAME) MOVEM B,$RBEXT ;EXTENSION TOO MOVEM B,Q.FEXT(QF) ;AND IN QUE BLOCK MOVEI B,0 ;GET PPN ASSOCIATED WITH DEVICE DEVPPN B, MOVE B,Q.PPN(Q) ;ASSUME SELF MOVEM B,$RBPPN ;PPN OF FILE MOVEM B,Q.FDIR(QF) ;AND IN QUE BLOCK MOVEI A,.QFDPR CAME B,Q.PPN(Q) ;IS IT HIS PPN? DPB A,[POINTR(Q.FMOD(QF),QF.DSP)] ;NO. MAKE IS DISP:PRES HISFIL: TLZ F,NEDREN ;ASSUME NO RENAME NEEDED MOVEI A,1 ;START AT BEGINNING DPB A,[POINTR(Q.FBIT(QF),QB.SLN)] ; MAY COME BACK HERE IF DIS:REN FAILS REFILE: LOOKUP 0,$RBBLK ;IS FILE THERE? JRST [ ;NOT THERE. MAY BE NEW LOG TLNN F,LOGFIL ;LOG FILE? POPJ P, ;NO. ERROR MOVSI A,(QF.DEF) ;FILE DOESN'T EXIST YET IORM A,Q.LMOD(Q) ;ONLY ON LOG JRST REL0 ;RELEAS CHANNEL AND SKIP RETURN ] MOVE A,$RBDEV ;GET DEVICE FILE IS ON MOVEM A,Q.FSTR(QF) ;STORE IT SETZM PTHBL$ ;SET ARG TO PATH MOVE A,[XWD ^D8,PTHBL$] PATH. A, ;GET FULL PATH TO FILE JRST NOPTH ;JUST PPN MOVSI A,PTHBL$+2 ;GET PPN AND SFDS HRRI A,Q.FDIR(QF) ;INTO FILE DESCRIPTION BLT A,Q.FDIR+5(QF) ;JUST SIX WORDS NOPTH: MOVSI A,Q.CSTR(Q) HRRI A,Q.LSTR(Q) TLNE F,CTLFIL ;IS THIS THE CTL FILE BLT A,Q.LNAM(Q) ;DEFAULT WHERE TO FIND LOG ; INCLUDED STR,PATH,NAME. NOT EXT LDB A,[POINT 9,$RBPRV,8] MOVEI B,177 ;MAKE SURE FILE IS PROTECTED IF WE RENAME DPB B,[POINT 9,$RBPRV,8] TRNE A,700 ;IS IT PROTECTED? JRST PROTOK ;YES TLO F,NEDREN ;FLAG TO DO A RENAME MOVSI A,(QB.APF) ;MARK ARTIFICIALLY PROTECTED IORM A,Q.FBIT(QF) PROTOK: LDB A,[POINTR(Q.FMOD(QF),QF.DSP)] CAIE A,.QFDRE ;IS IT DISPOSE RENAME? JRST NOCROS ;NO. SKIP THIS MOVEI A,20 ;FIND A FREE CHANNEL GETCHN: SOSG B,A JRST NOREN ;NO CHANNEL IF ZERO DEVCHR B, ;DOES MONITOR KNOW ABOUT CHANNEL? JUMPN B,GETCHN ;NOT FREE DPB A,[POINT 4,CH1,12] ;MODIFY SOME INSTRUCTIONS DPB A,[POINT 4,CH2,12] DPB A,[POINT 4,CH3,12] MOVE A,[XWD 400000,16] MOVE B,$RBDEV SETZ C, CH1: OPEN A ;OPEN THE STR JRST NOREN ;CAN'T. THEREFORE NO DIS:REN MOVSI T3,'QUD' ;EXTENSION FOR UNINAM PUSHJ P,UNINAM ;FIND UNIQUE NAME VIA NEXT LOOKUP CH2: LOOKUP T2 ;MODIFIED BY CHANNEL NUMBER CH3: RELEAS ;MODIFIED BY CHANNEL HRR T3,$RBEXT ;GET BLOCK WAY WE WANT IT MOVE T4,$RBPRV ;INCLUDING DATES, PROTECTIONS, ETC RENAME 0,T2 ;RENAME ACROSS DIRECTORIES JRST NOREN ;FAILED MOVEM T2,Q.FRNM(QF) ;STORE RENAMED NAME REL0: RELEAS 0, JRST CPOPJ1 ;SKIP RETURN NOREN: OUTSTR [ASCIZ/ % Cannot do DISPOSE:RENAME. DISPOSE:DELETE assumed. /] MOVEI A,.QFDDE ;CHANGE DISP TO DELETE DPB A,[POINTR(Q.FMOD(QF),QF.DSP)] JUMPGE F,REL0 ;IF WE DON'T NEED A RENAME, WE'RE DONE JRST REFILE ;YES. GET FILE BACK NOCROS: JUMPGE F,REL0 ;IF WE DON'T NEED A RENAME, WE'RE DONE RENAME 0,$RBBLK ;YES. DO IT JFCL ;OOPS? JRST REL0 ;DONE ; SUBROUTINE TO FIND A UNIQUE QUE NAME ; CALL IS ; MOVSI T3,'EXT' ; PUSHJ P,UNINAM ; LOOKUP CHAN,T2 ; RETURNS HERE ALWAYS ; WITH NAME IN T2, EXT IN T3, QUEDIR IN T5 ; USES A, T1-T5 UNINAM: MSTIME T1, ;FIND A UNIQUE NAME IDIVI T1,^D100 UNINM1: MOVE T2,QUESIX(QD) ;QUE NAME MOVE A,[POINT 6,T2,11] ADD T1,THSJB$ MOVE T4,T1 UNINM2: IDIVI T4,^D10 ADDI T5,'0' IDPB T5,A TLNE A,(77B5) ;FILLED OUT SIX CHAR NAME YET? JRST UNINM2 ;NO TRZ T3,-1 ;JUST THE EXTENSION SETZ T4, MOVE T5,QUEDIR XCT @(P) ;DO THE LOOKUP TRNE T3,-1 ;NO SUCH FILE? JRST UNINM1 ;IT EXISTS MOVE T5,QUEDIR ;NAME IS UNIQUE. RETURN PPN JRST CPOPJ1 ; SUBROUTINE TO OPEN DSK, CHANNEL ZERO OPDSK$::MOVEI T1,16 ;OPEN DSK IN DUMP MODE MOVSI T2,'DSK' SETZ T3, OPEN 0,T1 POPJ P, JRST CPOPJ1 SUBTTL ERROR ROUTINES NOQUE: MOVEI 1,6 ;CAN'T OPEN QUE DEVICE CAIE QD,4 ;INP REQUEST? POPJ P, ;RETURN NOENT: MOVEI 1,7 ;CAN'T ENTER QUEUE FILE OUTSTR [ASCIZ/ % CANNOT ENTER QUEUE REQUEST IN QUE UFD! % PLEASE NOTIFY OPERATOR! /] POPJ P, ;RETURN ERROR. 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 (ACTUALLY FORFUN AND FORPRM) SO THAT THE CBC FUNCTION TRYING TO REDUCE CORE DOESN'T ZAP OUR NON-CONTIGUOUS PAGES. THIS PATCH IS SHOWN ONE THE NEXT PAGE 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 ************** % 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