;;;-*-Midas-*- TITLE PDTIME SETTER .INSRT DSK:SYSENG;JSF MACROS RDTIM=:702200,, ; KS10 CLOCK INSTRUCTIONS WRTIM=:702600,, ;AC DEFINITIONS FF=0 A=1 AA=2 B=3 C=4 D=5 E=6 G=10 R=13 T=14 TT=15 Q=16 P=17 ;IO CHANNELS DISC==6 ;DISPLAY CHANNEL FOR DISPLAYING TIME AND DATE ;FLAG DEFINITIONS GETTY==RHF FF,1 ;ONE => GE TTY DSTF==RHF FF,2 ;DAYLIGHT SAVINGS TIME IN EFFECT ARGF==RHF FF,4 ;ARGUMENT TYPED ARGCF==RHF FF,10 ;ARGUMENT COMPLETED LYRF==RHF FF,20 ;1 => NORMAL YEAR AFTER FEB 28 MINUSF==RHF FF,200 ;MINUS SIGN TYPED AMF==RHF FF,400 ;"A" TYPED THIS ARG PMF==RHF FF,1000 ;"P" TYPED THIS ARG RAMF==RHF FF,2000 ;FTIME IS AM RPMF==RHF FF,4000 ;FTIME IS PM SYLTMF==RHF FF,10000 ;:JCL SYL IS TIME, NOT DATE ;RANDOM LPDL==40 ;LENGTH OF PDL LCMBUF==40 ;LENGTH OF TYPEIN BUFFER SPD=60.*60.*24. ;NUMBER OF SECONDS IN A DAY (FITS IN A HALF-WORD) PDUPS==60. ;# DECORIOLIS CLOCK UNITS PER SECOND ;MACROS DEFINE CMD CHAR,ROUT,BLURB/ CONCAT EXPUNGE CHR,\-40 DEF CHR,\-40,[ ROUT ] IFSE [BLURB],CONCAT CHB,\-40,==0 IFSN [BLURB],[CONCAT EXPUNGE CHB,\-40 DEF CHB,\-40,[ [ASCIZ \BLURB\] ]] TERMIN IF1,[REPEAT 100,[CONCAT CHR,\.RPCNT,==0 CONCAT CHB,\.RPCNT,==0 ] ] FOO==. LOC 41 JSR UUOH LOC FOO DEFINE UUOIRP A IRP UUO,,[ERR,TYPE] A TERMIN TERMIN FOO==0 UUOIRP FOO==FOO+1 ;COUNT UUOS NUUOS==FOO ;NUMBER OF UUOS MINUUO==<100-NUUOS> ;OP CODE OF MINIMUM UUO FOO==0 UUOIRP [UUO=_33 FOO==FOO+1] ;ACTUAL UUO DEFINITIONS UUOH: 0 ;UUO PROCESSOR PUSH P,A ;SAVE A PUSH P,B ;SAVE B HRRZ B,40 ;GIVE UUO ROUTINE RH OF LOCATION 40 LDB A,[331100,,40] ;GET OP CODE CAIGE A,MINUUO ;IF TOO SMALL, ILUUO: .VALUE ;THEN COMPLAIN PUSHJ P,@UUODTB-MINUUO(A) ;CALL ROUTINE FOR INDIVIDUAL UUO JRST .+2 ;NON-SKIP RETURN POINT AOS UUOH ;ROUTINE SKIPPED, INCREMENT RETURN POINT POP P,B ;RESTORE B POP P,A ;RESTORE A JRST 2,@UUOH ;RETURN UUODTB: UUOIRP A!UUO ;DISPATCH TABLE ATYPE: JUMPE B,CPOPJ ;IGNORE ADDRESS OF 0 HRLI B,440700 ;TURN INTO BYTE POINTER TYPEL: ILDB A,B ;GET CHARACTER JUMPE A,CPOPJ ;IF ZERO THEN THAT'S ALL PUSHJ P,TYO ;NON-ZERO, TYPE IT OUT JRST TYPEL AERR: PUSHJ P,ATYPE ;TYPE OUT THE TEXT STRING, MOVE P,[-LPDL,,PDL] ;RESTORE PDL JRST ERRET ;GO TO ERROR RETURN POINT IF1,[ TYIC==1 TYOC==2 TYIMOD==24 ;IMAGE MODE, OLD MODE TYOMOD==1 ;ASCII OUTPUT ] INITTY: .OPEN TYIC,[TYIMOD,,'TTY] .LOSE 1000 .OPEN TYOC,[TYOMOD,,'TTY] .LOSE 1000 .STATUS TYOC,A TRNN A,77#2 ;SKIP IF NOT GE (OR CHANNEL CLOSED) TMODF OA,GETTY ;GE CONSOLE CLEARF GETTY POPJ P, CRCFT: PUSH P,(A) ;SAVE CHARACTER TO TYPE INSTEAD OF LINE FEED MOVEI A,15 ;CR PUSHJ P,TYO POP P,A ;RETRIEVE SECOND CHARACTER TESTF N,GETTY ;IF CONSOLE IS TTY, MOVEI A,12 ;THEN REALLY WANT LINE FEED FOR SECOND CHARACTER JRST TYO ;TYPE IT OUT CRLF: JSP A,CRCFT 12 CRFF: JSP A,CRCFT 12 ;Don't type 14, it's not going to do anything useful CRRR: JSP A,CRCFT "* SPACE4: PUSHJ P,.+1 ;TYPE FOUR SPACES SPACE2: PUSHJ P,.+1 ;TYPE TWO SPACES SPACE: MOVEI A,40 ;SPACE JRST TYO TAB: MOVEI A,11 ;TYPE A TAB JRST TYO ;GET A TYPED IN CHARACTER, ECHO IT .SCALAR SYSTIM ;SYSTIM RESULT OF .RTIME WHEN CHARACTER INPUT .SCALAR PDDTIM ;PDDTIM DATAI FROM PDCLK ON EACH CHARACTER TYPED IN .SCALAR SYSDUR ;SYSDUR TIME IN THIRTIETHS SINCE SYSTEM BROUGHT UP .VECTOR KSTIME(2) ;KS10 CLOCK READING ON EACH CHARACTER TYPED IN TYI: .IOT TYIC,SYSTIM SKIPE KS10P JRST TYIKS DATAIX: DATAI 500,PDDTIM MOVSI A,600000 ANDCAM A,PDDTIM JRST TYIALL TYIKS: RDTIM KSTIME HRRZS KSTIME TYIALL: .RDTIME A, MOVEM A,SYSDUR .RTIME A, EXCH A,SYSTIM CAIL A,"a ;LOWER CASE? CAILE A,"z CAIA SUBI A,40 ;CONVERT TO UPPER CASE ;TYPE OUT THE CHARACTER IN A TYO: .IOT TYOC,A CPOPJ: POPJ P, ;TYPE OUT THE SIXBIT WORD IN AA SIXTYO: JUMPE AA,CPOPJ ;IF AA CLEAR THEN RETURN MOVEI A,0 ;CLEAR A LSHC A,6 ;SHIFT CHARACTER INTO A ADDI A,40 ;CONVERT TO SIXBIT PUSHJ P,TYO ;TYPE IT OUT JRST SIXTYO ;GO GET REST .SCALAR KL10P .SCALAR KA10P ; One of these will be set. .SCALAR KS10P .SCALAR KSFREQ ;KS-ticks per PD-tick .SCALAR STLCP ;.SETLOCING FROM STLCP SETLOCS PDTIME FROM IPDTIM .SCALAR STLCY ;.SETLOCING FROM STLCY SETLOCS FYEAR FROM YEAR .SCALAR STYTIM ;SETLOCS PDYTIM FROM YTIME BEG: MOVEI FF,0 ;INITIALIZE FLAGS MOVE P,[-LPDL,,PDL] IRPS SYM,,[KA10P KL10P KS10P] MOVE A,[SQUOZE 0,SYM ] .EVAL A, .LOSE MOVEM A,SYM TERMIN MOVE A,[SQUOZE 0,KSFREQ] .EVAL A, MOVEI A,<<1000._12.>+30.>/60. ; Pre-KSFREQ value. MOVEM A,KSFREQ .RDTIME A, MOVEM A,SYSDUR ;INITIALIZE FOR :JCL HACK .IOTLSR P, ;FOR DATAI, RDTIM, ETC. SKIPN KS10P XCT DATAIX ;READ PDCLK PUSHJ P,INITTY ;INITIALIZE TTY PUSHJ P,CRFF ;TYPE CRLF OR CRFF MOVE A,[SQUOZE 0,PDTIME ] .EVAL A, .VALUE ;NOT DEFINED? HRLI A,IPDTIM ;.SETLOC'ED ONLY FROM IPDTIM MOVEM A,STLCP MOVE A,[SQUOZE 0,FYEAR ] .EVAL A, TDZA A,A ;NOT DEFINED THIS SYSTEM HRLI A,YEAR MOVEM A,STLCY MOVE A,[SQUOZE 0,PDYTIM ] ;# HALF-SECONDS SINCE BEGINNING OF YEAR, BACKUP TO DEVICE 500 .EVAL A, TDZA A,A ;OLD SYSTEM HRLI A,YTIME MOVEM A,STYTIM ;don't really call JCLCHK, it has a habit of fucking up the time totally. ; PUSHJ P,JCLCHK ;MAYBE CALLED WITH :PDSET YYMMDD HHMMSS ; JRST GCMD1 ;YES, AND GOT PROCEEDED FROM QUIT MOVE AA,[SIXBIT /PDSET./] PUSHJ P,SIXTYO MOVE AA,[.FNAM2] PUSHJ P,SIXTYO TYPE [ASCIZ/ Please don't use this program unless you know how. You are certain to break something if you happen to hit the wrong key. Type Control-Z to exit, or ? for a reminder of the commands./] GCMD1: PUSHJ P,CRRR ERRET: CLEARF ARGF\ARGCF\MINUS\PMF SETZM VALUE SETZM LZCNT ;CLEAR LEADING ZEROS COUNT GCMD: PUSHJ P,TYI CAIL A,40 CAILE A,140 JRST N6B ;NOT SIXBIT MOVEI T,-40(A) IDIVI T,3 LDB T,DTBP(TT) JUMPE T,ERRET ;IF NOT COMMAND THEN CLEAR STATUS OF ARG, BUT OTHERWISE IGNORE PUSHJ P,(T) JRST GCMD1 ;ROUTINE DIDN'T SKIP, REINITIALIZE ARGUMENTS JRST GCMD ;ROUTINE SKIPPED, DON'T REINITIALIZE JRST ERRET ;ROUTINE SKIPPED TWICE, REINITIALIZE BUT DON'T TYPE CRRR N6B: CAIN A,177 ;IF RUBOUT, ERR HUH ;THEN RESET COMMAND STATUS CAIN A,^Z JRST WIPOUT ;INSERT NON-SIXBIT COMMANDS HERE JRST ERRET ;REINITIALIZE ARGUMENT STATUS, OTHERWISE IGNORE CMD "?,QUEST,LIST COMMANDS QUEST: MOVE B,[441400,,BTB] MOVEI T,40 PUSHJ P,CRFF QUESTL: ILDB AA,B CAIN AA,7777 ;DONE? POPJ P, ;YES JUMPE AA,QUSTL2 ;NO, BUT JUMP IF INACTIVE CHARACTER MOVE A,T ;GET CHARACTER THIS COMMAND PUSHJ P,TYO ;TYPE OUT THE CHARACTER PUSHJ P,SPACE4 ;TYPE 4 SPACES TYPE (AA) ;TYPE THE BLURB PUSHJ P,CRLF ;NEW LINE QUSTL2: AOJA T,QUESTL ;GET THE CURRENT VALUE INTO A AND SKIP, OR DON'T SKIP IF NO VALUE ARGET: TESTF N,MINUSF ;IF MINUS NOT TYPED, SKIPA A,VALUE ;THEN RETURN VALUE MOVN A,VALUE ;RETURN NEGATIVE OF VALUE TESTF E,ARGF POPJ1: AOS (P) ;ARGUMENT EXISTS POPJ P, ;NUMBERS REPEAT 9,CMD "1+.RPCNT,NUM .SCALAR VALUE ;VALUE OF ARGUMENT TYPED IN NUM: TESTF E,ARGCF ERR HUH ;ERROR IF CURRENT VALUE COMPLETED (LEFT OVER FROM PROGRAM THIS SWIPED FROM) SUBI A,"0 ;CONVERT CHARACTER TO DIGIT MOVEI AA,10. ;UPDATE VALUE IN DECIMAL IMULM AA,VALUE ADDM A,VALUE STRGFJ: SETF ARGF JRST POPJ1 ;SKIP-RETURN SO AS NOT TO KILL CURRENT VALUE CMD "0,ZERO .SCALAR LZCNT ;NUMBER OF LEADING ZEROS IN ARGUMENT ZERO: SKIPE VALUE ;IF NON-ZERO DIGITS HAVE BEEN TYPED, JRST NUM ;THEN DIGIT TESTF E,ARGCF ;LEADING ZERO, BUT FIRST CHECK FOR ARGUMENT FINALIZED ERR HUH AOS LZCNT JRST STRGFJ ;SET ARGF AND SKIP-RETURN CMD "-,MINUS MINUS: TESTF E,ARGF ;IF ARGUMENT, ERR HUH ;THEN COMPLAIN SETF MINUSF ;SET FLAG, JRST POPJ1 ;RETURN CMD "Q,WIPOUT,WIPE OUT JOB WIPOUT: .BREAK 16,140000 ;$^X. POPJ P, CMD "X,RETTY,RETURN TTY TO DDT RETTY: .VALUE [0] POPJ P, ;LOSE IF NEXT CHARACTER TYPED IN IS NOT A PERIOD LOSSNP: PUSHJ P,TYI ;GET CHARACTER CAIE A,". ERR HUH ;NOT PERIOD POPJ P, ;NOW FOR ACTUAL TIME HACKING CMD "E,STNDTM STNDTM: PUSHJ P,ARGET ;TAKES OPTIONAL ARGUMENT (THE VALUE OF THE FLAG) MOVEI A,0 ;IF NO ARG THEN 0 DPB A,[FLGBP DSTF,] ;DEPOSIT IN FLAG POPJ P, CMD "D,SETDAT,SET DATE (precede by YYMMDD, for example 760704D) .SCALAR DATE ;SIXBIT DATE TYPED IN (YYMMDD) SETDAT: PUSHJ P,NUMGET MOVEM C,DATE POPJ P, CMD "T,SETTIM,SET TIME (precede by HHMMSS, for example 120000T is noon) .SCALAR FTIME ;STORE TIME (SIXBIT /HHMMSS/) SETTIM: PUSHJ P,NUMGET MOVEM C,FTIME JRST APMCPY ;AM, PM, OR 24 HOUR TIME? NUMGET: PUSHJ P,ARGET TDZA C,C ;NO ARG => CLEAR SIXBIT (USE REAL 0) JRST DECDEP ;ARGUMENT, INTERPRET IT POPJ P, ;NO ARG, RETURN 0 DECDEP: MOVEI C,0 ;INITIALIZE SIXBIT MOVE B,[440600,,C] ;SET UP BYTE POINTER TO SIXBIT PUSHJ P,DECDPR IOR C,[SIXBIT /000000/] POPJ P, DECDPR: IDIVI A,10. JUMPE A,DCDPR3 HRLM AA,(P) PUSHJ P,DECDPR HLRZ AA,(P) DCDPR2: MOVEI A,'0(AA) DCDDEP: TLNN B,770000 ERR [ASCIZ /NUMBER TOO LONG. /] IDPB A,B POPJ P, ;TYPE OUT LEADING ZEROS DCDPR3: SKIPG T,LZCNT ;GET LEADING ZEROS COUNT, SKIP IF THERE ARE SOME JRST DCDPR2 ;NONE, KEEP GOING MOVEI A,'0 ;INITIALIZE A FOR IDPB PUSHJ P,DCDDEP ;DEPOSIT ZERO SOJG T,.-1 ;DO IT THE RIGHT NUMBER OF TIMES, JRST DCDPR2 ;THEN CONTINUE ;NOW FOR THE MAIN COMMAND CMD "!,DOIT,Actually store the time into the system (type "!.") DOIT: PUSHJ P,LOSSNP ;LOSS IF NEXT CHARACTER TYPED IN NOT A . JCLCKD: PUSHJ P,HAKDAT ;GET DATE, SET DSTF AND LYRF PUSHJ P,DCPHD ;DECIPHER DATE (CALCULATE DIY (DAY IN YEAR)) PUSHJ P,CDTIM ;CALCULATE DTIME (MAYBE ALSO UPDATE DIY IS DST) PUSHJ P,CPDTIM ;CALCULATE IPDTIM (DESIRED OFFSET FOR PDTIME) SKIPN KA10P JRST DOIT1 SKIPN PDDTIM ;IF CLOCK OFF, JRST SBKUP ;THEN UPDATE BACKUP INSTEAD DOIT1: MOVE A,STLCP ;GET SETLOC WORD FOR PDTIME DOIT2: .SETLOC A, SKIPE A,STLCY ;NOW DO IT FOR YEAR, IF THAT KIND OF SYSTEM .SETLOC A, SKIPA ;GIVE SETLOC A CHANCE TO HAPPEN BEFORE STARTING CLOCK SKIPA .HANG SKIPE KL10P CONO 500,400007 ;START CLOCK ON KL SKIPN KS10P POPJ P, ;THAT'S ALL UNLESS THIS IS A KS RDTIM A HRLI A,1729. WRTIM A POPJ P, SBKUP: .RDTIME A, ;SEE HOW LONG IT'S BEEN SINCE . TYPED SUB A,SYSDUR ;" " " IDIVI A,15. ;CONVERT TO HALF-SECONDS ADDM A,YTIME ;UPDATE YTIME TO NOW SKIPE A,STYTIM ;GET SETLOC WORD FOR PDYTIM (BACKUP) JRST DOIT2 ;DO THE .SETLOC, THEN SET YEAR POPJ P, ;NOT DEFINED, NOTHING ELSE TO DO CMD "C,CENSET CENSET: PUSHJ P,ARGET ;GET CENTURY (-1) MOVEI A,19. ;NO ARG, RESET TO DEFAULT IMULI A,100. ;CONVERT TO YEAR MOVEM A,CENTURY ;SET CENTURY POPJ P, CENTURY: 1900. ;CENTURY (FOR FIRST TWO DIGITS OF YEAR) CMD "A,AM CMD "P,PM AM: TMODF OA,AMF ;"A" => AM PM: TMODF OA,PMF ;"P" => PM TMODF ZA,PMF ;AM CLEARF AMF ;PM JRST POPJ1 APMCPY: CLEARF RAMF\RPMF ;COPY AMF AND PMF INTO RAMF AND RPMF TESTF E,AMF SETF RAMF ;AM TESTF E,PMF SETF RPMF ;PM POPJ P, .SCALAR YEAR ;YEAR HAS YEAR (E.G. 1969.) .SCALAR TIME ;TIME HAS TIME IN SIXBIT HAKDAT: SKIPN A,DATE .RDATE A, ;NONE TYPED IN, USE THE SYSTEM'S JUMPL A,[ERR [ASCIZ / DATE NOT AVAILABLE. /]] MOVEM A,DATE LDB A,[301200,,DATE] ;GET YEAR (LAST TWO DIGITS) PUSHJ P,6CVB ;CONVERT TO BINARY TRNN A,3 ;NOW FOR THE LEAP YEAR FLAG TMODF ZA,LYRF ;LEAP YEAR SETF LYRF ;NORMAL YEAR MOVE A,DATE TLZ A,777700 ;YEAR NO LONGER NEEDED CAMG A,[SIXBIT / 0229/] ;IF BEFORE MARCH FIRST, CLEARF LYRF ;THEN NO NEED TO COMPENSATE FOR NOT BEING LEAP YEAR CLEARF DSTF ;ASSUME STANDARD TIME FOR THE TIME BEING CAML A,[SIXBIT / 0401/] ;IF BEFORE APRIL 1, CAMLE A,[SIXBIT / 1031/] ;OR AFTER OCTOBER 31, JRST HAKDT2 ;THEN STANDARD TIME CAMLE A,[SIXBIT / 0407/] ;IF BEFORE APRIL 8, CAML A,[SIXBIT / 1025/] ;OR AFTER OCTOBER 24, JRST HAKDT3 ;THEN NOT CLEAR SETF DSTF ;DAYLIGHT SAVINGS TIME HAKDT2: LDB A,[301200,,DATE] ;GET YEAR (LAST TWO DIGITS) PUSHJ P,6CVB ;CONVERT TO BINARY ADD A,CENTURY ;CONVERT TO REAL YEAR MOVEM A,YEAR SKIPN A,FTIME ;GET TYPED IN TIME, BUT IF IT DOESN'T EXIST, MOVE A,SYSTIM ;THEN GET SYSTEM TIME AT LAST CHARACTER TYPED IN MOVEM A,TIME POPJ P, ;THAT'S ALL HAKDT4: CAIN A,177 ;LOOP POINT FOR FINDING OUT FROM TTY WHETHER DAYLIGHT SAVINGS TIME ERR HUH ;CHAR. IS RUBOUT, QUIT TYPE [ASCIZ /? /] HAKDT3: TYPE [ASCIZ /DAYLIGHT SAVINGS TIME? /] .IOT TYIC,A ;GET CHARACTER, BUT DON'T CLOBBER PDDTIM, SYSTIM .IOT TYOC,A ;ECHO THE CHARACTER CAIE A,"y ;IF y, CAIN A,"n ;OR IF n, JRST HAKDT9 ;THEN OK, USE IT CAIE A,"Y ;IF Y, CAIN A,"N ;OR IF N, JRST HAKDT9 ;THEN OK, USE IT JRST HAKDT4 ;NEITHER, COMPLAIN AND LOOP HAKDT9: DPB A,[FLGBP DSTF,] ;"N&1=0, "Y&1=1 JRST HAKDT2 ;TABLE OF NUMBER OF DAYS IN LEAP YEAR GONE BY AT BEGINNING OF MONTH LMNTBL: FOO==0 IRPS L,,[31 29 31 30 31 30 31 31 30 31 30 31] FOO FOO==FOO+L!. TERMIN IFN FOO-366.,PRINTA LMNTBL LOSES. ;DECIPHER DATE (CALCULATE DIY) .SCALAR DIY ;DATE IN YEAR (0 => JAN 1) DCPHD: LDB A,[141200,,DATE] ;GET MONTH PUSHJ P,6CVB ;CONVERT TO BINARY MOVE B,LMNTBL-1(A) ;GET # DAYS IN YEAR SINCE BEGINNING OF MONTH LDB A,[1200,,DATE] ;GET DAY IN MONTH PUSHJ P,6CVB TESTF E,LYRF SUBI A,1 ;NORMAL YEAR AFTER FEB 28 ADDI B,-1(A) HRRZM B,DIY POPJ P, ;CONVERT A 2 DIGIT RIGHT-ADJUSTED SIXBIT NUMBER MASKED TO 10. BITS TO BINARY 6CVB: IDIVI A,100 IMULI A,10. ADDI A,-'0(AA) POPJ P, ;CALCULATE DTIME (# SECS. SINCE BEGINNING OF DAY), MAYBE ALSO SOS DIY .SCALAR DTIME ;# SECONDS SINCE BEGINNING OF DAY CDTIM: SKIPGE TIME ERR [ASCIZ / TIME NOT AVAILABLE. /] LDB A,[301200,,TIME] ;HOUR PUSHJ P,6CVB TESTF N,RAMF\RPMF JRST CDTIM3 ;24 HOUR NOTATION IDIVI A,12. ;AM OR PM SPECIFIED TESTF N,PMF SKIPA A,AA ;AM MOVEI A,12.(AA) ;PM CDTIM3: TESTF N,DSTF JRST CDTIM2 SOJGE A,CDTIM2 ;SKIP FOLLOWING IF NO DATE ERROR MOVEI A,23.*60. SOSA DIY CDTIM2: IMULI A,60. ;CONVERT TO MINUTES MOVE B,A LDB A,[141200,,TIME] ;MINUTE PUSHJ P,6CVB ADD B,A IMULI B,60. ;CONVERT TO SECONDS LDB A,[1200,,TIME] ;SECOND PUSHJ P,6CVB ADD B,A MOVEM B,DTIME POPJ P, RTYIP: 0 ;POINTER INTO RTYIBF IFNDEF RTYIBL,RTYIBL==20. ;LENGTH OF RTYIBF (IN WORDS) RTYIBF: BLOCK RTYIBL+1 ;:JCL BUFFER ;GET CHAR FROM :JCL STRING RTYI: ILDB A,RTYIP JUMPN A,CPOPJ ERR [ASCIZ /BAD :JCL STRING. /] GTSYL: MOVEI C,0 ;CALLED WITH JSP R,; CLEAR OUT NAME MOVE B,[440600,,C] ;SET UP BYTE POINTER TO NAME JRST GTSYL1 ;FALL IN, GET FIRST CHARACTER GTSYL2: SUBI A,40 ;HERE TO USE CHAR, CONVERT IT TO SIXBIT TLNE B,770000 ;SKIP IF NAME FULL IDPB A,B ;DEPOSIT CHARACTER IN NAME GTSYL1: PUSHJ P,RTYI ;GET NEXT CHAR CAIL A,140 SUBI A,40 ;CONVERT LOWER CASE TO UPPER JRST (R) GETSYL: JSP R,GTSYL ;READ NUMBER FOR :JCL FEATURE CAIL A,"0 CAILE A,"9 JRST .+2 ;NOT DIGIT JRST GTSYL2 ;USE DIGIT CAIN A,"A JRST JCLAM ;"A" => AM CAIN A,"P JRST JCLPM ;"P" => PM CAIE A,"M CAIN A,": JRST JCLTIM ;M AND : IDENTIFY THIS NUMBER AS TIME BUT HAVE NO OTHER EFFECT POPJ P, ;SOMETHING ELSE => END OF NUMBER JCLAM: TMODF OA,AMF ;"A" => AM JCLPM: TMODF OA,SYLTMF\PMF ;"P" => PM TMODF ZA,PMF ;AM TMODF ZA,AMF ;PM JCLTIM: SETF SYLTMF ;"M" OR ":" => TIME, NOT DATE JRST GTSYL1 ;HERE FROM BEG, CHECK FOR :JCL STRING, SKIP IF NONE JCLCHK: MOVE A,[RTYIBF,,RTYIBF+1] SETZM RTYIBF BLT A,RTYIBF+RTYIBL ;CLEAR OUT RTYIBF AOS RTYIBF+RTYIBL ;MAKE LAST WORD NON-ZERO MOVE A,[440700,,RTYIBF] ;SET UP INITIAL BYTE POINTER MOVEM A,RTYIP .BREAK 12,[5,,RTYIBF] ;MAYBE GET COMMAND STRING SKIPN RTYIBF JRST POPJ1 ;NO :JCL COMMAND SETZM DATE ;CLEAR DATE SETZM FTIME ;CLEAR TIME PUSHJ P,JCLG ;GOBBLE YYMMDD HHMMSS COMMAND LINE PUSHJ P,APMCPY ;AM, PM, OR 24 HOUR TIME PUSHJ P,JCLCKD ;DO IT JRST WIPOUT ;THAT'S ALL, UNLESS HE PROCEEDS IT ;GOBBLE COMMAND LINE OF THE FORM YYMMDD HHMMSS JCLG2: MOVEM C,FTIME JCLG3: CAIN A,^M POPJ P, ;END OF LINE, STOP RECURSING JCLG: PUSHJ P,GETSYL ;ENTRY TDON C,[SIXBIT /000000/] JRST JCLG3 ;NO SYL YET TMODF ZE,SYLTMF ;SEE IF DECLARED TO BE TIME JRST JCLG2 ;YES PUSH P,C ;NO PUSHJ P,JCLG ;RECURSE POP P,C SKIPE FTIME MOVEM C,DATE SKIPN FTIME MOVEM C,FTIME POPJ P, ;CALCULATE OFFSET (IPDTIM) .SCALAR YTIME ;# HALF-SECONDS SINCE BEGINNING OF YEAR .SCALAR IPDTIM ;CALCULATED OFFSET CPDTIM: MOVE A,DIY IMULI A,SPD ADD A,DTIME LSH A,1 MOVEM A,YTIME MULI A,PDUPS/2 DPB A,[430100,,AA] SKIPE KS10P JRST CKSTIM MOVE B,PDDTIM SUB B,AA MOVEM B,IPDTIM POPJ P, CKSTIM: DMOVE B,KSTIME ; B!C DIV B,KSFREQ SUB B,AA MOVEM B,IPDTIM POPJ P, ;DATA AREA FOR TIME DISPLAY ROUTINE THAT BEGINS ON NEXT PAGE ;NORMAL CHARACTER DISTYO: .VALUE ;SHOULDN'T TRY TO TYPE A CHARACTER ON DISPLAY REPEAT 2,.IOT DISC,A REPEAT 2,PUSHJ P,TYO ;CLEAR SCREEN OR ETC. DISFF: MOVEI B,DISTIM ;SET POINTER FOR MOVEM PUSHJ P,DISCRF .IOT DISC,[14] PUSHJ P,CRLF PUSHJ P,CRFF ;TAB OR CR AFTER TIME DISTAB: MOVEI B,DISDAT ;SET POINTER FOR MOVEM .IOT DISC,[11] .IOT DISC,[11] PUSHJ P,TAB PUSHJ P,TAB ;SLEEP TIME SLPTIM: 7 150. 60. 150. 60. TYDISO: 1,,(SIXBIT /T00/) ;USED FOR .OPEN ON NUMBERED TTY CMD "S,DSTIM,SHOW (DISPLAY) TIME AND DATE ;TAKES OPTIONAL ARGUMENT ;-2 => USE CONSOLE TTY ;-1 => USE DIS (LOSE IF CAN'T .OPEN IT) ;0 - 14. => USE CONSOLE N' (") ;IF NO ARG THEN: ;IF CONSOLE IS GE THEN USE IT ;IF CONSOLE IS A TELETYPE THEN USE DIS IF AVAILABLE ;ELSE USE CONSOLE TTY ;D HAS TYPE OF DEVICE ;0 => DIS ;1 => NUMBERED TTY ;2 => NUMBERED GE ;3 => CONSOLE TTY ;4 => CONSOLE GE DSTIM: PUSHJ P,ARGET ;GET ARGUMENT IF ANY JRST DFLTDV ;NO ARGUMENT => DEFAULT AOJL A,TTYDIS ;JUMP IF CONSOLE SOJL A,DISDIS ;JUMP FOR DISPLAY MOVEI D,1 CAILE A,8 MOVEI D,2 ;NUMBERED GE CONSOLE IDIVI A,10. DPB A,[60400,,TYDISO] ;DEPOSIT FIRST DIGIT DPB AA,[400,,TYDISO] ;DEPOSIT SECOND DIGIT .OPEN DISC,TYDISO DNA: ERR [ASCIZ /DEVICE NOT AVAILABLE. /] ;NOW FOR THE ACTUAL LOOP DSTIML: XCT DISFF(D) ;CLEAR SCREEN OR WHATEVER .RTIME AA, PUSHJ P,SIXDSO ;TYPE OUT TIME XCT DISTAB(D) ;TAB OR CR .RDATE AA, PUSHJ P,SIXDSO ;TYPE OUT THE DATE .LISTEN A, ;SEE IF USER HAS TYPED A CHARACTER JUMPN A,DISX ;JUMP IF YES MOVE A,SLPTIM(D) ;GET .SLEEP TIME FOR RELEVANT DEVICE .SLEEP A, .LISTEN A, ;AGAIN SEE IF A CHARACTER TYPED JUMPE A,DSTIML ;JUMP IF NO DISX: JUMPE D,DISX1 ;JUMP IF USING DISPLAY .CLOSE DISC, ;EXIT FROM LOOP, CLOSE DISPLAY CHANNEL POPJ P, DISX1: .DCLOSE ;USING DISPLAY, RELEASE IT POPJ P, ;CONSOLE SPECIFIED TTYDIS: ILDB D,[FLGBP GETTY,] ADDI D,3 JRST DSTIML ;DISPLAY SPECIFIED DISDIS: .DSTART BLKOPR ;TRY TO START UP DISPLAY JRST DNA ;NOT AVAILABLE DISDS2: MOVEI D,0 ;ENTRY FROM DEFAULT ROUTINE IF DISPLAY SUCCESSFULLY OPENED JRST DSTIML ;FALL INTO LOOP ;DEFAULT (NO ARGUMENT) DFLTDV: MOVEI D,4 ;IN CASE GE CONSOLE .STATUS TYIC,A TRNN A,77#2 JRST DSTIML ;GE CONSOLE TRNE A,400000 ;SKIP IF FOREIGN .DSTART BLKOPR ;TRY TO START DISPLAY SOJA D,DSTIML ;LOST, USE CONSOLE TELETYPE JRST DISDS2 ;.OPEN WON, USE DISPLAY ;DISPLAY THE SIXBIT WORD IN AA SIXDSO: JUMPE D,DIS6 ;JUMP IF USING DISPLAY SIXDS1: JUMPE AA,CPOPJ MOVEI A,0 LSHC A,6 ADDI A,40 XCT DISTYO(D) ;TYPE OUT A CHARACTER JRST SIXDS1 DIS6: XOR AA,[404040,,404040] ;CLOBBER SIXBIT WORD TO 340 FORMAT MOVEM AA,(B) ;STORE IT IN THE RIGHT PLACE POPJ P, ;DISPLAY A CRLF DISCRF: MOVEI A,15 XCT DISTYO(D) MOVEI A,12 XCT DISTYO(D) POPJ P, ;DISPLAY (340) BUFFER AREA DISBUF: 20177 ;RANDOM PARAMETER WORD 221170,,60464 ;SET Y AND X DISTIM: 0 ;TIME 343337,, ;ESCAPE FROM CHARACTER MODE, WASTE A HALF-WORD 20177,,60464 ;PARAMETER WORD AGAIN, SET X AGAIN DISDAT: 0 ;DATE IN 340 FORMAT 373737,,3000 ;ESCAPE, STOP BLKOPR: .-2000,,DISBUF-1 ;BLKO POINTER FOR .DSTART HUH: ASCIZ /? / ;FREQUENT ERROR "MESSAGE" ;COMMAND DISPATCH TABLE DTBP: POINTS 12.,DTB(T) DTB: .BYTE 12. REPEAT 100,[CONCAT CHR,\.RPCNT ] .WALGN .BYTE ;BLURB TABLE BTB: .BYTE 12. REPEAT 100,[CONCAT CHB,\.RPCNT ] -1 ;FOR END OF TABLE DETECTION .WALGN .BYTE PAT: PATCH: BLOCK 40 ;PATCH AREA PATCHE: CONST: CONSTANTS VARIABLES PDL: BLOCK LPDL+1 PRINTA HIGHEST USED = ,\.-1 END BEG