TITLE SAVEACS ROUTINE TO SAVE REGISTERS 2-17 ENTRY SAVEACS,RESTORE,SACS TWOSEG 400000 SEARCH IMPPRM ; SAVEACS SAVES REGISTERS 2-17 SAVEACS: MOVEM 17,SACS+17 ;SAVE THE ACS MOVEI 17,SACS ;LOCALLY BLT 17,SACS+16 MOVE 17,SACS+17 ;GET OLD STACK POINTER POPJ 17, ;RETURN SUBTTL RESTORE ROUTINE TO RESTORE PREVIOUS ENVIRONMENT ; RESTORE RESTORES THE PREVIOUS ENVIRONMENT AFTER A CALL TO SAVEACS ; EXCEPT FOR AC'S 0 AND 1, SO THAT RESULTS MAY BE PASSED BACK ; FROM IMP FUNCTIONS AND MAPS. HENCE PREVIOUS CONTENT ; OF ACS 0 AD 1 ARE LOST. RESTORE: MOVE 2,(P) ;GET RETURN ADDRESS HRRZ 3,SACS+17 MOVEM 2,(3) ;AND OVERWRITE WITH PRESENT ONE HRLI 17,SACS+2 HRRI 17,2 BLT 17,17 ;RESTORE POPJ P, ;RETURN RELOC 0 SACS: BLOCK 20 PRGEND TITLE ZERO %SYSTEMROUTINE ZERO(%NAME FROM, TO) ENTRY $ZERO TWOSEG 400000 SEARCH IMPPRM $ZERO: SETZM (ARG1) HRL ARG1,ARG1 AOS ARG1 HLRZ AC,ARG2 LSH AC,-^D9 ;GET LENGTH OF "TO" ITEM SOSGE AC ;SUBTRACT 1 SETZ AC, ;BUT IF AC WAS ZERO MAKE IT 1-1 ADD ARG2,AC BLT ARG1,(ARG2) ;ZERO AREA POPJ P, PRGEND TITLE BLT %SYSTEMROUTINE BLT(%NAME FROM, TO, %INTEGER LEN) ENTRY $BLT TWOSEG 400000 SEARCH IMPPRM $BLT: MOVEI AC,(ARG2) ;"TO" AREA ADDRESS ;; CAIL AC,(ARG1) ;IS IT A BLT OR REVERSE BLT ;; JRST REVBLT ;REVERSE BLT HRL AC,ARG1 ;"FROM" AREA ADDRESS ADDI ARG3,(ARG2) ;FINAL ADDRESS+1 BLT AC,-1(ARG3) ;DO IT POPJ P, ;;REVBLT: SOS ARG3 ;N-1 ;; ADDI ARG3,400000 ;N-1+400000 ;; HRL ARG1,ARG3 ;ARG1=XWD N-1+400000,"FROM" ;; SUBI AC,(ARG1) ;"TO-"FROM" ;; HRRM AC,PNTR ;SET UP POINTER ;; POP ARG1,@PNTR ;; JUMPL ARG1,.-1 ;; POPJ P, ;; ;; RELOC 0 ;;PNTR: (ARG1) PRGEND TITLE IOWD %SYSTEMINTEGERFN IOWD(%INTEGER LEN, %INTEGERNAME LOC) ENTRY $IOWD TWOSEG 400000 SEARCH IMPPRM $IOWD: MOVN AC,ARG1 ;GET -VE LENGTH HRLZ AC,AC ;INTO LH IORI AC,-1(ARG2) ;AND ADDRESS-1 IN RH POPJ P, ;RETURN PRGEND TITLE IOUUO %SYSTEMPREDICATE IOUUO(%INTEGER FN,CHAN, %INTEGERNAME ADDR) ENTRY $IOUUO TWOSEG 400000 SEARCH IMPPRM $IOUUO: SETO AC, MOVE T1,ARG1 LSH T1,33 HRLZ T2,ARG2 LSH T2,5 IOR T1,T2 HRR T1,ARG3 XCT 0,T1 SETZ AC, ;ERROR RETURN POPJ P, PRGEND TITLE GETTAB %SYSTEMPREDICATE GETTAB(%INTEGER TABLE,INDEX %INTEGERNAME RESULT) ENTRY $GETTAB TWOSEG 400000 SEARCH IMPPRM $GETTAB:SETOM AC ;SET %TRUE MOVS T1,ARG2 ;GET INDEX OR JOBNUM HRR T1,ARG1 ;AND TABLE NUMBER GETTAB T1, ;GETTAB SETZM AC ;%FALSE MOVEM T1,(ARG3) ;RETURN RESULT POPJ P, ;RETURN PRGEND TITLE CLOSE %SYSTEMROUTINE CLOSE(%INTEGER CHAN) AND %SYSTEMROUTINE RELEASE(%INTEGER CHAN) ENTRY $CLOSE,$RELEASE TWOSEG 400000 SEARCH IMPPRM $RELEASE: SKIPA T1,[ XWD 071000,000000 ] ;RELEASE OPCODE $CLOSE: HRLZI T1,70000 ;CLOSE OPCODE HRLZ T2,ARG1 ;GET CHANNEL NUMBER LSH T2,5 IOR T1,T2 XCT 0,T1 ;DO IT POPJ P, LIT PRGEND TITLE TMPCOR %SYSTEMROUTINE TMPCOR(%INTEGER TYPE, BLOCK-IOWD, SIXBIT-FILENAME) ENTRY $TMPCOR TWOSEG 400000 SEARCH IMPPRM $TMPCOR: HRL AC,ARG1 ;TYPE SETZM ARG1 ;CLEAR IT HRRI AC,ARG3 ;BLOCK ADDRESS [NAME,,0 ; IOWD BUFLEN,,BUFFER] HLLZ ARG3,ARG3 ;ZAP RH TMPCOR AC, ;DO THE TMPCOR SETZM AC ;FAIL POPJ P, PRGEND TITLE RRUN RUN PROCEDURE CALLED BY IMP RUN ENTRY RRUN TWOSEG 400000 SEARCH IMPPRM ; RRUN RUNS THE PROGRAM SPECIFIED ON THE STACK ; AS CALLED BY %EXTERNALROUTINE RUN(%STRING(6) DEV,FILE,EXT, %INTEGER PPN, OFFSET) RRUN: MOVEM ARG1,ARGLST(P) ; MOVE TOP 3 ARGS ONTO STACK MOVEM ARG2,ARGLST+1(P) MOVEM ARG3,ARGLST+2(P) HRLI AC,ARGLST(P) ; DEV ON THE STACK HRRI AC,144 ; JOBS LOWEST CORE+4 BLT AC,152 ; THE 7 WORD ARGUMENT BLOCK MOVS AC,CODEX ; XWD 140,CODE BLT AC,143 ; MOVE THE CODE DOWN HRL T1,ARGLST+7(P) ; STARTING OFFSET HRRI T1,144 ; STARTING ADDRESS OF SPEC MOVE AC,ONEONE JRST 140 ;GO TO THE CODE CODE: CORE AC,0 ;REDUCE CORE HALT 141 RUN T1,0 ;RUN THE PROGRAM HALT 143 CODEX: XWD 140,CODE ONEONE: XWD 1,1 PRGEND TITLE GGETSEG FOR USE WITH IMP GETSEG ROUTINE ; %EXTERNALROUTINE GETSEG(%STRING(6) DEV,FILE,EXT, %INTEGER PPN) ENTRY GGETSEG TWOSEG 400000 SEARCH IMPPRM GGETSEG: MOVEM ARG1,ARGLST(P) ;PUT TOP 3 ARGS ONTO THE STACK MOVEM ARG2,ARGLST+1(P) MOVEM ARG3,ARGLST+2(P) MOVEM 17,.SAC17 ;SAVE AC17 MOVEI 17,.SAC0 BLT 17,.SAC16 ;SAVE ACS MOVE P,.SAC17 ;RESTORE STACK POINTER HRLI AC,GETS01 HRRI AC,ARGLST+4(P) ;WHERE TO SAVE THE CODE ON THE STACK HRRI T1,ARGLST+4(P) BLT AC,4(T1) ;SAVE CODE IN LOW SEG HRLZI T1,1 HRRZI AC,ARGLST(P) ;ADDRESS OF SPEC LIST JRST ARGLST+4(P) ;JUMP TO CODE GETS01: CORE T1,0 ;KILL HIGH SEG HALT GETSEG AC,0 ;GET NEW SEGMENT HALT JRST ENDBLOCK ENDBLOCK: HRLZI 17,.SAC0 BLT 17,17 ;RESTORE ACS JRST 400010 ;START ADDR RELOC 0 .SAC0: BLOCK ^D14 .SAC16: 0 .SAC17: 0 LIT PRGEND TITLE CHARNO %INTEGERFN CHARNO(%STRINGNAME S, %INTEGER I) ENTRY CHARNO TWOSEG 400000 SEARCH IMPPRM CHARNO: HLRZ AC,(ARG1) LSH AC,-9 ;GET LENGTH SKIPL ARG2 ; %IF I<0 %C CAMGE AC,ARG2 ; %OR I>LENGTH(S) %C JRST CHA001 ; %THEN %RESULT=0 MOVEM ARG2,T1 LSH T1,-2 ;DIVIDE BY FOUR ADD T1,ARG1 ;ADDRESS OF WORD MOVE AC,(T1) ;GET WORD TRNN ARG2,2 ;L OR R HALF HLRZ AC,AC TRNN ARG2,1 ;L OR R QUARTER CHA001: LSH AC,-9 ANDI AC,777 ;MASK OFF BYTE POPJ P, ;RETURN PRGEND TITLE MATCH %INTEGERFN MATCH(%STRINGNAME S,%STRING(255) T) ENTRY MATCH TWOSEG 400000 SEARCH IMPPRM MATCH: MOVE T1,[POINT 9,(ARG1),8] MOVEM T1,SPTR MOVE T1,[POINT 9,(AC),8] ;SECOND STRING ARGUMENT MOVEM T1,TPTR LDB T1,SPTR ;GET LENGTH OF S LDB T2,TPTR JUMPE T2,MATNOK ;FAIL IF T IS NULL MOVN T2,T2 HRLZM T2,TLEN ;SAVE AOBJP POINTER FOR T ILDB T4,TPTR ;POINT TO FIRST CHAR ADD T1,T2 ;LEN1-LEN2 FOR AMMOUNT OF STRING1 TO LOOK AT ADDI T1,2 ;ADJUST FOR ALLIGNMENT MOVN T1,T1 HRLZM T1,MATLEN ;SAVE AOBJP POINTER FOR S MATLP: MOVE T3,MATLEN MATLP1: AOBJP T3,MATNOK ;END OF STRING? ILDB T1,SPTR CAME T1,T4 ;MATCH FIRST CHAR? JRST MATLP1 ;NO ;HERE TO SEE IF REST OF STRING MATCHES MOVEM T3,MATLEN ;SAVE AOBJN POINTER MOVE T1,SPTR MOVEM T1,SPTR1 ;GET LOCAL VERSION OF POINTERS MOVE T1,TPTR MOVEM T1,TPTR1 MOVE T3,TLEN ;AOBJN POINTER MATLP2: AOBJP T3,MATOK ;END OF STRING T? ILDB T1,SPTR1 ILDB T2,TPTR1 CAME T1,T2 JRST MATLP ;MISMATCH FOUND JRST MATLP2 ;SO FAR SO GOOD MATOK: HRRZ AC,MATLEN ;GET CHAR POSITION POPJ P, MATNOK: SETZ AC, POPJ P, RELOC 0 SPTR: Z SPTR1: Z TPTR: Z TPTR1: Z TLEN: Z MATLEN: Z LIT PRGEND TITLE TOSTRING %STRING(1)%FN TO STRING(%INTEGER N) ENTRY TOSTRING TWOSEG 400000 SEARCH IMPPRM TOSTRING: MOVE AC,ARG1 IORI AC,1000 ;ADD LENGTH HRLZM AC,-1(P) ;PUT TO TOP OF WORD ON STACK POPJ P, PRGEND TITLE SUBSTRING %STRING(255)%FN SUB STRING(%STRINGNAME S, %INTEGER I,J) ENTRY SUBSTRING TWOSEG 400000 SEARCH IMPPRM SUBSTRING: JUMPLE ARG2,F2ERR ;%IF 1>=I %THEN ->ERROR HLRZ T1,(ARG1) LSH T1,-9 ;GET LENGTH OF S CAMLE ARG3,T1 ;%IF J>LENGTH(S) %C JRST F3ERR ; CAMLE ARG2,T1 ; %OR I>LENGTH(S) %THEN JRST F2ERR ; ->ERROR SUB ARG3,ARG2 ;GET LENGTH OF NEW STRING ADDI ARG3,1 JUMPL ARG3,FMSERR ; %IF I-1>J %THEN ->ERROR JUMPG ARG3,.+3 SETZM -100(P) ;%IF J=I-1 %THEN %RESULT="" POPJ P, MOVE T2,ARG2 ANDI ARG2,3 LSH T2,-2 ;GET WORD BASE IOR T2,IBYTPTR(ARG2) ;GET APPROPRIATE BYTE POINTER, BYTE ALLINGNED MOVE T1,[POINT 9,-100(P),8] ;POINTER TO RESULT DPB ARG3,T1 ;DEPOSIT NEW LENGTH FMSLP: ILDB AC,T2 IDPB AC,T1 SOJG ARG3,FMSLP ;CONTINUE UNTIL ALL TRANSFERRED POPJ P, FMSERR: SETZ AC, ERROR 5,^D8,AC,IMPSTR F2ERR: MOVE ARG3,ARG2 ;GET ARGUMENT F3ERR: ERROR 5,7,ARG3,IMPSTR RELOC 0 IBYTPTR: POINT 9,(ARG1),-1 POINT 9,(ARG1),8 POINT 9,(ARG1),17 POINT 9,(ARG1),26 LIT PRGEND TITLE STRTOSIX %INTEGERFN STRTOSIX(%STRING(255) STR) ENTRY STRTOSIX TWOSEG 400000 SEARCH IMPPRM STRTOSIX: SETZ T5, ;RESULT INITIALLY TO BE PUT IN T5 MOVE T2,[POINT 6,T5] MOVE T3,[POINT 9,(AC),8] LDB T4,T3 ;LENGTH OF STRING CAILE T4,6 MOVEI T4,6 ;MAX LENGTH SIXL3: SOJL T4,SIXL4 ;FINISHED ILDB T1,T3 CAIL T1,40 CAILE T1,137 JRST SIXL1 SUBI T1,40 SIXL2: IDPB T1,T2 JRST SIXL3 SIXL1: CAIGE T1,140 MOVEI T1,100 SUBI T1,100 JRST SIXL2 SIXL4: MOVEM T5,AC ;RETURN RESULT POPJ P, LIT PRGEND TITLE SIXTOSTR %STRING(6)%FN SIXTOSTR(%INTEGER SIXBIT) ; CONVERT A SIXBIT INTEGER TO A STRING ENTRY SIXTOSTR TWOSEG 400000 SEARCH IMPPRM SIXTOSTR: MOVE T1,[POINT 9,-2(P),8] ;POINT TO RESULT MOVEI T4,^D6 DPB T4,T1 ;DEPOSIT LENGTH OF 6 ALWAYS MOVE T3,ARG1 ;GET THE SIXBIT ARGUMENT SIX2LP: LSHC T2,6 ;COMBINED SHIFT INTO BOTTOM OF T2 ANDI T2,77 ;MASK OFF CHARACTER ADDI T2," " ;CONVERT TO ASCII IDPB T2,T1 ;DEPOSIT AS NINE-BIT SOJG T4,SIX2LP ;CONTINUE FOR WHOLE WORD POPJ P, LIT PRGEND TITLE ASCTOSTR %STRING(255)%FN ASCTOSTR(%NAME ADR) SEARCH IMPPRM ENTRY ASCTOSTR ASCTOSTR:HRLI T1,440700 HRR T1,ARG1 ;[POINT 7,@ARG1] MOVE T2,[POINT 9,-100(P),8] ;**[POINT 9,IS,8] SETZ T3, LOOP: ILDB AC,T1 JUMPE AC,END CAIE AC,15 ;DO NOT INSERT IDPB AC,T2 AOJA T3,LOOP END: DPB T3,[POINT 9,-100(P),8] ;**[POINT 9,IS,8] MOVEI AC1,IS POPJ P, IS: BLOCK 64 LIT PRGEND TITLE STRTOASC %ROUTINE STRTOASC(%STRINGNAME S,%NAME ADR) SEARCH IMPPRM ENTRY STRTOASC STRTOASC: SETZM (ARG2) ;ZERO FIRST WORD LDB T1,[POINT 9,@ARG1,8] ;GET LENGTH JUMPE T1,END ;LENGTH ZERO IDIVI T1,5 ;GET NUMBER OF ASCII WORDS TO INITIALISE TO ZERO JUMPE T1,STOA1 ;LENGTH LESS THAN 5 HRR T2,ARG2 HRL T2,ARG2 AOS T2 HRRZ T3,ARG2 ADDI T3,T1 BLT T2,(T3) ;ZERO THE AREA STOA1: HRLI T1,331100 HRR T1,ARG1 ;[POINT 9,@ARG1,8] HRLI T2,440700 HRR T2,ARG2 ;[POINT 7,@ARG2] LDB T3,T1 ;GET LENGTH JUMPE T3,END LOOP: ILDB AC,T1 CAIN AC,12 JRST [MOVEI AC,15 IDPB AC,T2 ;INSERT MOVEI AC,12 JRST .+1] IDPB AC,T2 SOJG T3,LOOP END: POPJ P, LIT PRGEND TITLE BINTOSTR %STRING(36)%FN BINTOSTR(%INTEGER BINNUM) ; CONVERT A BINARY INTEGER TO A STRING ENTRY BINTOSTR TWOSEG 400000 SEARCH IMPPRM BINTOSTR: MOVE T1,[POINT 9,-12(P),8] ;POINT TO RESULT MOVEI T4,^D36 DPB T4,T1 ;DEPOSIT LENGTH OF 36 ALWAYS MOVE T3,ARG1 ;GET THE BINARY ARGUMENT SIX2LP: LSHC T2,1 ;COMBINED SHIFT INTO BOTTOM OF T2 ANDI T2,1 ;MASK OFF CHARACTER ADDI T2,"0" ;CONVERT TO ASCII IDPB T2,T1 ;DEPOSIT AS NINE-BIT SOJG T4,SIX2LP ;CONTINUE FOR WHOLE WORD POPJ P, LIT PRGEND TITLE HEXTOSTR %STRING(9)%FN HEXTOSTR(%INTEGER HEXNUM) ; CONVERTS AN HEX NUMBER INTO A STRING ENTRY HEXTOSTR TWOSEG 400000 SEARCH IMPPRM HEXTOSTR: SKIPE T3,ARG1 ;IS IT A ZERO? JRST HEX2L0 ;NO MOVSI AC,1060 ;YES, STRING "0" MOVEM AC,-3(P) ;RETURN IT POPJ P, HEX2L0: MOVE T1,[POINT 9,-3(P),8] ;POINT TO RESULT MOVEI T4,^D9 ;GET MAX LENGTH HEX2L1: ROTC T2,4 ;SHIFT INTO BOTTOM OF T2 TRNN T2,17 ;SEE IF ANY BITS SET SOJG T4,HEX2L1 ;CONTINUE IF A ZERO DPB T4,T1 ;OTHERWISE DEPOSIT LENGTH SKIPA HEX2LP: ROTC T2,4 ANDI T2,17 ;MASK OFF CHARACTER ADDI T2,"0" ;CONVERT TO ASCII CAILE T2,"9" ;IS IT GREATER THAN 9 ADDI T2,7 ;IF SO MAKE 'A'-'F' IDPB T2,T1 ;DEPOSIT AS NINE-BIT SOJG T4,HEX2LP ;CONTINUE FOR WHOLE WORD POPJ P, LIT PRGEND TITLE OCTTOSTR %STRING(12)%FN OCTTOSTR(%INTEGER OCTNUM) ; CONVERTS AN OCTAL NUMBER INTO A STRING ENTRY OCTTOSTR TWOSEG 400000 SEARCH IMPPRM OCTTOSTR: SKIPE T3,ARG1 ;IS IT A ZERO? JRST OCT2L0 ;NO MOVSI AC,1060 ;YES, STRING "0" MOVEM AC,-4(P) ;RETURN IT POPJ P, OCT2L0: MOVE T1,[POINT 9,-4(P),8] ;POINT TO RESULT MOVEI T4,^D12 ;GET MAX LENGTH OCT2L1: ROTC T2,3 ;SHIFT INTO BOTTOM OF T2 TRNN T2,7 ;SEE IF ANY BITS SET SOJG T4,OCT2L1 ;CONTINUE IF A ZERO DPB T4,T1 ;OTHERWISE DEPOSIT LENGTH SKIPA OCT2LP: ROTC T2,3 ANDI T2,7 ;MASK OFF CHARACTER ADDI T2,"0" ;CONVERT TO ASCII IDPB T2,T1 ;DEPOSIT AS NINE-BIT SOJG T4,OCT2LP ;CONTINUE FOR WHOLE WORD POPJ P, LIT PRGEND TITLE INTTOSTR %STRING(12)%FN INTTOSTR(%INTEGER DECNUM) ; CONVERTS A DECIMAL NUMBER TO A STRING, WITH NO LEADING SPACES ENTRY INTTOSTR TWOSEG 400000 SEARCH IMPPRM INTTOSTR: MOVMM ARG1,T1 ;GET NUMBER MOVEM P,T3 ;SAVE STACK POINTER MOVEI T4,1 ;START COUNT I2SLP0: IDIVI T1,^D10 ADDI T2,"0" ;MAKE ASCII PUSH P,T2 ;SAVE ON STACK SKIPE T1 ;FINISH WHEN 0 AOJA T4,I2SLP0 ;OTHERWISE CONTINUE JUMPGE ARG1,I2SL1 ;IF POSITIVE CONTINUE MOVEI T2,"-" PUSH P,T2 ;ELSE OUTPUT A - SIGN AOS T4 ;NOW FILL THE STRING I2SL1: MOVE T2,[POINT 9,-4(T3),8];POINT TO STRING ON STACK DPB T4,T2 ;PUT IN LENGTH I2SLP1: POP P,T1 ;GET CHAR IDPB T1,T2 ;STORE IT SOJG T4,I2SLP1 ;CONTINUE POPJ P, LIT PRGEND TITLE CALLIS %EXTERNALROUTINE CALLI1(%INTEGER NUM, %INTEERNAME AC) ENTRY CALLI1,CALLI2,CALLI3 TWOSEG 400000 SEARCH IMPPRM ; %EXTERNALROUTINE CALLI 1(%INTEGER NUM, %INTEGERNAME AC) - FOR SIMPLE RETURN CALLIS ; %EXTERNALPREDICATE CALLI 2(%INTEGER NUM,%INTERNAME AC) - FOR ; NON-SKIP ERROR RETURNS AND SKIP NORMAL RETURNS ; %EXTERNALPREDICATE CALLI 3(%INTEGER NUM,%INTEGERNAME AC) - FOR ; UNCOMMON NON-SKIP NORMAL RETURNS AND SKIP ERROR RETURNS CALLI1: CALLI2: MOVE T1,@ARG2 ;GET AC CONTENTS HRLZI T2,<47000+T1*40> ;CREATE LH OF INSTRUCTION HRRI T2,(ARG1) ;AND RH XCT T2 ;DO IT TDZA AC,AC ;CLEAR AC AND SKIP SETO AC, ;OR SET THE AC MOVEM T1,@ARG2 ;RETURN ANY VALUE POPJ P, CALLI3: PUSHJ P,CALLI2 ;SAME AS CALLI2 SETCA AC, ;EXCEPT CONDITION IS REVERSED POPJ P, PRGEND TITLE JOBNUM %EXTERNALINTEGERFN JOBNUM ENTRY JOBNUM TWOSEG 400000 SEARCH IMPPRM JOBNUM: PJOB AC, POPJ P, PRGEND TITLE PPN %EXTERNALINTEGERFN PPN ENTRY PPN TWOSEG 400000 SEARCH IMPPRM PPN: GETPPN AC, JUMP POPJ P, PRGEND TITLE GETNOW %EXTERNALINTEGERFN GETNOW ENTRY GETNOW TWOSEG 400000 SEARCH IMPPRM SEARCH UUOSYM GETNOW: MOVE AC,[%CNDTM] GETTAB AC, ;GET ENTRY FROM TABLE SETZ AC, POPJ P, LIT PRGEND TITLE GETDATE %EXTERNALINTEGERFN GETDATE ENTRY GETDATE TWOSEG 400000 SEARCH IMPPRM GETDATE: DATE AC, POPJ P, PRGEND TITLE CPUTIME %EXTERNALINTEGERFN CPUTIME ENTRY CPUTIME TWOSEG 400000 SEARCH IMPPRM CPUTIME: SETZ AC, ;SPECIFY THIS JOB RUNTIM AC, ;GET RUN TIME IN MILLISECS POPJ P, PRGEND TITLE GETTIME %EXTERNALINTEGERFN GETTIME ENTRY GETTIME TWOSEG 400000 SEARCH IMPPRM GETTIME: MSTIME AC, ;GET TIME SINCE MIDNIGHT IN MILLISECS POPJ P, PRGEND TITLE SLEEP %EXTERNALROUTINE SLEEP(%INTEGER I) ENTRY SLEEP TWOSEG 400000 SEARCH IMPPRM SLEEP: HRRE ARG1,ARG1 ;GET ONLY TIME SKIPG ARG1 ;IS IT > 0 POPJ P, ;NO, RETURN HIBER ARG1, ;YES, HIBERNATE SKIPA ;NOT IMPLEMENTED POPJ P, ;OK HRRZ AC,ARG1 ;GET ONLY RH ADDI AC,^D500 ;ROUND UP IDIVI AC,^D1000 ;GET SECS CALLI AC,31 ;SLEEP POPJ P, PRGEND SUBTTL TELETYPE ROUTINES TITLE ECHO %EXTERNALROUTINE ECHO ENTRY ECHO TWOSEG 400000 SEARCH IMPPRM ECHO: SETOM AC ;FOR THIS LINE GETLCH AC TLZ AC,4 SETLCH AC POPJ P, PRGEND TITLE NOECHO %EXTERNALROUTINE NOECHO ENTRY NOECHO TWOSEG 400000 SEARCH IMPPRM NOECHO: SETOM AC ;FOR THIS LINE GETLCH AC TLO AC,4 SETLCH AC POPJ P, PRGEND TITLE SETSTS %SYSTEMROUTINE SETSTS(%INTEGER CHAN,BITS) ENTRY $SETSTS SEARCH IMPPRM $SETSTS: LSH ARG1,5 ;CHAN IORI ARG1,060000 ;SETSTS HRRZ AC,ARG2 ;GET BITS IN RH HRL AC,ARG1 ;AND SETSTS CHAN, IN LH XCT AC ;DO IT POPJ P, ;RETURN PRGEND TITLE GETSTS %SYSTEMINTEGERFN GETSTS(%INTEGER CHAN) ENTRY INSTATUS,OUTSTATUS ENTRY $GETSTS EXTERN INSCB,OUTSCB SEARCH IMPPRM INSTATUS: SKIPA IOREG,INSCB OUTSTATUS: MOVE IOREG,OUTSCB SETZ AC, SKIPL T2,DEVTYP(IOREG) ;IF NUL: OR TMP: CAIN T2,3 ;OR TTY: POPJ P, ;RETURN 0 HLRZ ARG1,FILOPFN(IOREG) ANDI ARG1,17 $GETSTS: LSH ARG1,5 ;CHAN IORI ARG1,062000 ;GETSTS HRLZ ARG2,ARG1 ;IN LH HRRI ARG2,AC ;ADDR OF %RESULT IN RH XCT ARG2 ;DO IT POPJ P, ;RETURN PRGEND TITLE SHIFTC %INTEGERFN SHIFTC(%INTEGER N) ENTRY SHIFTC TWOSEG 400000 SEARCH IMPPRM SHIFTC: MOVEM ARG1,AC ROT AC,ARG2 POPJ P, PRGEND TITLE FRACPT %LONGREALFN FRACPT(%LONGREAL X) ENTRY FRACPT EXTERN INTPT TWOSEG 400000 SEARCH IMPPRM FRACPT: MOVE AC,LARG1 ;SAVE X FIX T2,AC ;MAKE INTEGER SKIPN T2 ;IF INT PT=0 POPJ P, ;THEN RETURN ORIGINAL NUMBER FLTR T2,T2 ;MAKE FLOATING AGAIN FSBR AC,T2 ;TAKE AWAY FROM NUMBER YOU FIRST THOUGHT OF SKIPGE AC FADR AC,[EXP 1.0] ;ADD 1 IF NEGATIVE TO MAKE POSITIVE POPJ P, ;THEN RETURN PRGEND TITLE INTPT %INTEGERFN INTPT(%LONGREAL R) ENTRY INTPT TWOSEG 400000 SEARCH IMPPRM INTPT: SETZM LARG1+1 ;**TEMP** ZAP LOW PART HLRE T1,LARG1 ;GET THE EXPONENT ASH T1,-9 ;RIGHT 8 BITS JUMPGE LARG1,INT.T ;JUMP IF POS. DFN LARG1,LARG1+1 ;NEGATE TRC T1,-1 ;COMPLEMENT THE EXPONENT INT.T: TLZ LARG1,777000 ;CLEAR THE EXPONENT IFE CPU-KA10,< LSH LARG1+1,8 ;WIPE OUT THE LOW ORDER EXPONENT > ASHC LARG1,-201-^D26(T1) ;CHANGE FRACTION TO INTEGER MOVEM LARG1,AC ;PUT RESULT IN AC SKIPL T1 ;SKIP IF NEG. POPJ P, ;IF POSITIVE, RETURN MOVNS AC ;NEGATE SKIPE LARG1+1 ;WAS NUMBER AN INTEGER? SOS AC ;NO, SO TAKE LOWER INTEGER POPJ P, ;RETURN AC=FIXED NUMBER PRGEND TITLE INT %INTEGERFN INT(%LONGREAL R) ENTRY INT TWOSEG 400000 SEARCH IMPPRM INT: SETZM LARG1+1 ;**TEMP** ZAP LOW END JUMPGE LARG1,INT.1 ;JUMP IF POS. DFSB LARG1,[EXP 0.5,0]; SUBTRACT 0.5 SKIPA INT.1: DFAD LARG1,[EXP 0.5,0]; ADD 0.5 HLRE AC,LARG1 ;GET THE EXPONENT ASH AC,-9 ;RIGHT 8 BITS JUMPGE LARG1,INT.T ;JUMP IF POS. DFN LARG1,LARG1+1 ;NEGATE TRC AC,-1 ;COMPLEMENT THE EXPONENT INT.T: TLZ LARG1,777000 ;CLEAR THE EXPONENT IFE CPU-KA10,< LSH LARG1+1,8 ;WIPE OUT THE LOW ORDER EXPONENT > ASHC LARG1,-201-^D26(AC) ;CHANGE FRACTION TO INTEGER SKIPGE AC ;SKIP IF POS. MOVNS LARG1 ;NEGATE MOVEM LARG1,AC POPJ P, ;RETURN AC=FIXED NUMBER LIT PRGEND TITLE IMOD %INTEGERFN IMOD(%INTEGER N) ENTRY IMOD TWOSEG 400000 SEARCH IMPPRM IMOD: MOVMM ARG1,AC POPJ P, PRGEND TITLE MOD %LONGREALFN MOD(%LONGREAL R) ENTRY MOD TWOSEG 400000 SEARCH IMPPRM MOD: MOVMM ARG1,AC ;SINGLE PREC POPJ P, ; =**TEMP** JUMPL ARG1,.+3 DMOVE AC,ARG1 POPJ P, DMOVN AC,ARG1 POPJ P, PRGEND TITLE FROMUDT %EXTERNALROUTINE FROMUDT(%INTEGER UDT,%INTEGERNAME DATE,TIME) ENTRY FROMUDT TWOSEG 400000 SEARCH IMPPRM SEARCH UUOSYM ;ADDITIONAL DEFNS AC1==AC+1 ;FROMUDT -- SUBROUTINE TO CONVERT FROM INTERNAL DATE/TIME FORMAT ; ; ; RETURN WITH TIME=TIME IN MS., DATE=DATE IN SYSTEM FORMAT (.LT. 0 IF ARG .LT. 0) ;BASED ON IDEAS BY JOHN BARNABY, DAVID ROSENBERG, PETER CONKLIN ;USES T1-4 ;ACTS AS A MEMO FUNCTION AND RETURNS PREVIOUS RESULTS IF GIVEN SAME ARGUMENT FROMUDT:MOVEM ARG1,ARGLST(P) ;SAVE ARGS FOR LATER MOVEM ARG2,ARGLST+1(P) MOVEM ARG3,ARGLST+2(P) JUMPL ARG1,CNTDT6 ;DEFEND AGAINST JUNK INPUT CAMN ARG1,CNTUDT ;IS IT SAME ARGUMENT AS LAST TIME JRST CNTMEM ;YES, GIVE SAME RESULTS HLRZ T1,ARG1 ;GET DATE PORTION (DAYS SINCE 1858) RADIX 10 ;**** NOTE WELL **** ADDI T1,<1857-1500>*365+<1857-1500>/4-<1857-1500>/100+<1857-1500>/400+31+28+31+30+31+30+31+31+30+31+17 ;T1=DAYS SINCE JAN 1, 1501 [311] IDIVI T1,400*365+400/4-400/100+400/400 ;SPLIT INTO QUADRACENTURY [311] LSH T2,2 ;CONVERT TO NUMBER OF QUARTER DAYS [311] IDIVI T2,<100*365+100/4-100/100>*4+400/400 ;SPLIT INTO CENTURY [311] IORI T3,3 ;DISCARD FRACTIONS OF DAY [311] IDIVI T3,4*365+1 ;SEPARATE INTO YEARS [311] LSH T4,-2 ;T4=NO DAYS THIS YEAR [311] LSH T1,2 ;T1=4*NO QUADRACENTURIES [311] ADD T1,T2 ;T1=NO CENTURIES [311] IMULI T1,100 ;T1=100*NO CENTURIES [311] ADDI T1,1501(T3) ;T1 HAS YEAR, T4 HAS DAY IN YEAR [311] MOVE T2,T1 ;COPY YEAR TO SEE IF LEAP YEAR TRNE T2,3 ;IS THE YEAR A MULT OF 4? [311] JRST CNTDT0 ;NO--JUST INDICATE NOT A LEAP YEAR [311] IDIVI T2,100 ;SEE IF YEAR IS MULT OF 100 [311] SKIPN T3 ;IF NOT, THEN LEAP [311] TRNN T2,3 ;IS YEAR MULT OF 400? [311] TDZA T3,T3 ;YES--LEAP YEAR AFTER ALL [311] CNTDT0: MOVEI T3,1 ;SET LEAP YEAR FLAG [311] ;T3 IS 0 IF LEAP YEAR ;UNDER RADIX 10 **** NOTE WELL **** CNTDT1: SUBI T1,1964 ;SET TO SYSTEM ORIGIN IMULI T1,31*12 ;CHANGE TO SYSTEM PSEUDO DAYS JUMPN T3,CNTDT2 ;IF NOT LEAP YEAR, PROCEED CAIGE T4,31+29 ;LEAP YEAR--SEE IF BEYOND FEB 29 JRST CNTDT5 ;NO--JUST INCLUDE IN ANSWER SOS T4 ;YES--BACK OFF ONE DAY CNTDT2: MOVSI T2,-11 ;LOOP FOR 11 MONTHS CNTDT3: CAMGE T4,MONTAB+1(T2) ;SEE IF BEYOND THIS MONTH JRST CNTDT4 ;YES--GO FINISH UP ADDI T1,31 ;NO--COUNT SYSTEM MONTH AOBJN T2,CNTDT3 ;LOOP THROUGH NOVEMBER CNTDT4: SUB T4,MONTAB(T2) ;GET DAYS IN THIS MONTH CNTDT5: ADD T1,T4 ;INCLUDE IN FINAL RESULT CNTDT6: EXCH T1,ARGLST(P) ;SAVE ANSWER, GET TIME TLZ T1,-1 ;CLEAR DATE MUL T1,[24*60*60*1000] ;CONVERT TO MILLI-SEC. ASHC T1,17 ;POSITION RESULT MOVE T2,ARGLST(P) ;RECOVER DATE MOVEM T1,CNTTIM ;REMEMBER TIME MOVEM T2,CNTDAT ;REMEMBER DATE CNTRTN: MOVEM T2,@ARGLST+1(P) ;RETURN VALUES (DATE) MOVEM T1,@ARGLST+2(P) ;AND TIME POPJ P, ;RETURN CNTMEM: MOVE T1,CNTTIM ;GET LAST TIME MOVE T2,CNTDAT ;AND DATE JRST CNTRTN ;AND RETURN THEM ;UNDER RADIX 10 **** NOTE WELL **** MONTAB: EXP 0,31,59,90,120,151,181,212,243,273,304,334,365 RELOC 0 ;MEMORY OF ARGUMENT AND RESULTS CNTUDT: Z CNTDAT: Z CNTTIM: Z LIT PRGEND TITLE TOUDT %EXTERNALINTEGERFNSPEC TOUDT(%INTEGER DATE,TIME) ENTRY TOUDT TWOSEG 400000 SEARCH IMPPRM SEARCH UUOSYM AC1==AC+1 ;TOUDT -- CONVERT ARBITRARY DATE TO SPECIAL FORMAT ; ; WHERE TIME=TIME IN MILLISEC. ;AND DATE=DATE IN SYSTEM FORMAT (Y*12+M)*31+DAY SINCE 1/1/64 ;RETURNS WITH RESULT IN AC (.GT.0; OR -1 IF BEYOND SEPT. 27,2217) ; NOTE THAT IN SPECIAL FORMAT, THE LEFT HALF DIVIDED ; BY 7 GIVES THE DAY OF THE WEEK (0=WED.) ;USES T2, T3, T4 ;ALSO ACTS AS A MEMO FUNCTION BY REMEMBERING LAST ARGUMENTS TOUDT: CAIN ARG1,CNVDAT ;IS DATE SAME CAIE ARG2,CNVTIM ;AND IF SO IS TIME THE SAME SKIPA T2,ARG1 ;NO, JUST GET DATE JRST CNVMEM ;YES, GET MEMORY MOVEM ARG2,ARGLST+1(P) ;SAVE TIME FOR LATER MOVEM ARG1,CNVDAT ;REMEMBER DATE MOVEM ARG2,CNVTIM ;AND TIME RADIX 10 ;**** NOTE WELL ****** IDIVI T2,12*31 ;T2=YEARS-1964 CAILE T2,2217-1964 ;SEE IF BEYOND 2217 JRST GETNW2 ;YES--RETURN -1 IDIVI T3,31 ;T3=MONTHS-JAN, T4=DAYS-1 ADD T4,MONTAB(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 ;OFFSET SINCE LEAP YEAR DOES NOT GET COUNTED 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,<1964-1859>*365+<1964-1859>/4+<31-18>+31(T2) ;T4=DAYS BEFORE JAN 1,1964 +SINCE JAN 1 ; +ALLOWANCE FOR ALL LEAP YEARS SINCE 64 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-100-1(T1) ;T2=YEARS SINCE 2001 JUMPLE T2,GETNW1 ;ALL DONE IF NOT YET 2001 IDIVI T2,100 ;GET CENTURIES SINCE 2001 SUB T4,T2 ;ALLOW FOR LOST LEAP YEARS CAIE T3,99 ;SEE IF THIS IS A LOST L.Y. GETNW1: ADD T4,T5 ;ALLOW FOR LEAP YEAR THIS YEAR CAILE T4,^O377777 ;SEE IF TOO BIG GETNW2: SETOM T4 ;YES--SET -1 MOVE AC,ARGLST+1(P) ;GET MILLISEC TIME MOVEI AC1,0 ;CLEAR OTHER HALF ASHC AC,-17 ;POSITION DIV AC,[24*60*60*1000] ;CONVERT TO 1/2**18 DAYS HRL AC,T4 ;INCLUDE DATE MOVEM AC,CNVUDT ;REMEMBER DATE/TIME GETNWX: POPJ P, ;RETURN CNVMEM: MOVE AC,CNVUDT ;GET REMEMBERED DATE/TIME POPJ P, ;RETURN ;UNDER RADIX 10 **** NOTE WELL **** MONTAB: EXP 0,31,59,90,120,151,181,212,243,273,304,334,365 RELOC 0 ;MEMORY CNVUDT: Z CNVDAT: Z CNVTIM: Z LIT PRGEND TITLE %GO IS A DEFAULT VALUE FOR AN IMP PROGRAM WHICH IS LOADED ENTRY %GO,%PROG TWOSEG 400000 %GO: OUTSTR [ASCIZ/?IMP: No main program loaded /] EXIT LIT %PROG: Z EXP 400000000000 ;MINUS INFINITY .LNKEND 1,%PROG PRGEND TITLE STACKSIZE IS THE DEFAULT SIZE FOR THE DATA STACK ENTRY STACKSIZE SEARCH IMPPRM STACKSIZE: -1 PRGEND TITLE HEAPSIZE IS THE DEFAULT SIZE FOR HEAP ENTRY HEAPSIZE SEARCH IMPPRM HEAPSIZE: -1 PRGEND TITLE HEAP DEFAULT HEAP ENTRY HEAP HEAP=-1 PRGEND TITLE STACK DEFAULT STACK ENTRY STACK STACK=-1 END