mirror of
https://github.com/PDP-10/its.git
synced 2026-01-25 11:47:10 +00:00
877 lines
19 KiB
Plaintext
Executable File
877 lines
19 KiB
Plaintext
Executable File
;;;-*-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,\<CHAR>-40
|
||
DEF CHR,\<CHAR>-40,[
|
||
ROUT
|
||
]
|
||
IFSE [BLURB],CONCAT CHB,\<CHAR>-40,==0
|
||
IFSN [BLURB],[CONCAT EXPUNGE CHB,\<CHAR>-40
|
||
DEF CHB,\<CHAR>-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=<MINUUO+FOO>_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
|