github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-04-14 07:59:47 +00:00
Code Issues Releases Wiki Activity

PDSET source code.

Browse Source
This commit is contained in:
Lars Brinkhoff
2016-11-07 08:08:32 +01:00
parent be6af1cb94
commit e1728f924e
3 changed files with 1155 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

66
doc/sysdoc/pdset.info Executable file
View File

@@ -0,0 +1,66 @@
PDSET was re-written from scratch in 1985, so it now has a nicer
user interface, but does essentially the same work as described in
this file. That is, it hacks PDTIME and the clock, and the backup
PDYTIM, and FYEAR. --- CSTACY
The following information pertains to the old PDSET program circa 1969.
SYS:TS PDSET IS A PROGRAM FOR THE
SETTING OF SYSTEM VARIABLES ASSOCIATED
WITH THE KEEPING OF REAL TIME IN ITS
VERSIONS 547 AND GREATER. IT DOES
THIS ON THE BASIS OF TYPED IN COMMANDS,
EXCEPT THAT IT MAY BE CALLED BY
:PDSET YYMMDD HHMMSS FROM DDT, WHERE
YYMMDD AND HHMMSS ARE THE DATE AND
TIME IT IT STARTED ($G'D BY DDT).
WHEN PDSET IS FIRST STARTED
UP, IT ENTERS IOT USER MODE IN ORDER
TO DATAI FROM A HARDWARE CLOCK, SO DON'T
PLAY WITH ITS BINARY CASUALLY.
WHEN NOT STARTED UP BY :PDSET YYMMDD HHMMSS,
PDSET TAKES TYPED IN COMMANDS IN MUCH
THE SAME MANNER AS TENLOD, WITH WHICH
IT SHARES THE Q, X, AND ? COMMANDS.
AFTER EACH CHARACTER IS TYPED IN AND
BEFORE IT IS ECHOED, PDSET DOES A
DATAI FROM THE HARDWARE CLOCK, AS WELL
AS A .RDTIME. IT IS ON THE BASIS OF
THIS INFORMATION, AS WELL AS THAT TYPED
IN, THAT IT DOES WHAT IT DOES.
MAIN COMMANDS:
D SET DATE. ACCEPTS A SIX
DIGIT (YYMMDD) LEADING ARGUMENT OR,
IF NOT SUPPLIED, THEN SETS A FLAG
TO USE THE SYSTEM DATE (INITIAL MODE).
T SELECT *THE *TIME *AT *WHICH *THE
*SETLOC *COMMAND *WILL *BE *GIVEN*.
(HHMMSS 24 HR-TYPE LEADING ARGUMENT).
! MUST BE FOLLOWED BY A POINT.
THE TIME THE "." IS TYPED IS ASSUMED
TO BE THE TIME SELECTED BY THE
MOST RECENT "T" COMMAND. IF THE
HARDWARE CLOCK IS RUNNING THEN PDSET
.SETLOC'S A LOCATION IN THE SYSTEM
WHICH THE SYSTEM USES AS AN OFFSET
FOR TRANSLATING CLOCK DATAI'S INTO
TIME OF YEAR. IF THE CLOCK IS NOT
RUNNING, IT .SETLOC'S ANOTHER
LOCATION IN THE SYSTEM TO THE TIME
OF YEAR (FOR USE BY THE SYSTEM AS
BACKUP TO THE HARDWARE CLOCK).
EITHER WAY IT ALSO .SETLOC'S THE
LOCATION IN THE SYSTEM CONTAINING THE
YEAR, ALTHOUGH THIS WILL USUALLY
NOT CAUSE SYSTEM JOB PRINTOUT
DUE TO AGREEMENT.
IN SHORT, THIS COMMAND DOES WHATEVER
IT THINKS NECESSARY TO TELL THE
SYSTEM WHAT TIME OF WHAT YEAR IT IS.
--JSF 9/20/69 6:40PM
AMENDED 5/22/72 9:10PM BY JSF
 ‡‡8

876
src/sysen1/pdset.114 Executable file
View File

@@ -0,0 +1,876 @@
;;;-*-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

213
src/syseng/jsf.macros Executable file
View File

@@ -0,0 +1,213 @@
;JSF STANDARD MACROS 6/17/72
IF2,.INEOF ;.INSRT INTO PROG NEAR BEGINNING, PREFERABLY ONLY DURING PASS 1
;RANDOM SYMBOLS
SIGN=400000 ;IT SAVES A LITTLE TYPING
JOV=JFCL 10,
JCRY0=JFCL 4,
JCRY1=JFCL 2,
JFOV=JFCL 1,
;FLOAT=FSC 233 ;FLOAT THE INTEGER IN SELECTED AC
.FORMAT 30,2704_24. ;MAKE A, FORMAT TREAT A LIKE AC
.FORMAT 34,00222704_12. ;CHANGE A,B FORMAT TO TREAT A LIKE AC
.AOP .OPER@ 0,.RDATIM ;GET DATE AND TIME OF ASSEMBLY
ASTIME=.AVAL1 ;TIME (SIXBIT /HHMMSS/) OF ASSEMBLY
ASDATE=.AVAL2 ;DATE (SIXBIT /YYMMDD/) OF ASSEMBLY
;FLAG DEFINITION FORMAT
;FLAG==XHF AC,VALUE
RHF==0
LHF==TLN-TRN
DEFINE SETF FLAG
TRO+FLAG TERMIN
DEFINE CLEARF FLAG
TRZ+FLAG TERMIN
DEFINE TESTF COND,FLAG
TRN!COND+FLAG TERMIN
DEFINE TMODF COND,FLAG
TR!COND+FLAG TERMIN
;FOLLOWING MACRO GENERATES POINTER TO BYTE POINTER TO THE JSF-TYPE FLAG "FLAG"
DEFINE FLGBP FLAG
<.OP FAD <32000,,FLAG>,0 >_3+220*<<FLAG>&LHF>-(3700)+<<FLAG>_<-27>>&17 TERMIN
;SWDEF NAME=EXPR ;SET "NAME" TO "EXPR" IFF "NAME" NOT DEFINED
DEFINE SWDEF ASSGT/
IRPS DUMMY,,[ASSGT]
IFNDEF DUMMY,ASSGT
.ISTOP
TERMIN
TERMIN
;FOLLOWING MACROS TAKE ADVANTAGE
;OF ARGUMENT EVALUATION AT EXPANSION TIME
DEFINE CONCAT A,B
A!B!TERMIN
DEFINE DEF A,B,C,D,E,F,G,H,I,J,K
DEFINE A!B!C!D!E!F!G!H!I!J!K!TERMIN
TERMIN
EQUALS DEF2,DEF ;FOR OLD PROGRAMS
DEFINE PRINTA A,B,C,D,E,F
IF1,[PRINTC Á!B!C!D!E!F
Ý
TERMIN
DEFINE PRINTB A,B,C,D,E,F
PRINTC Á!B!C!D!E!F
Š
TERMIN
;(RIGHT) BYTE POINTER, POS ARG IS # BITS TO RIGHT OF BYTE
DEFINE POINTR POS,SIZ
<POS>_12.+<SIZ>_6,,TERMIN
;(LEFT) BYTE POINTER, 1STBIT ARG IS # BITS TO LEFT OF BYTE
DEFINE POINTL 1STBIT,SIZ
<36.-<SIZ>-<1STBIT>>_12.+<SIZ>_6,,TERMIN
;BYTE POINTER TO BYTE BEFORE FIRST IN WORD
DEFINE POINTZ SIZ
36.-<36./<SIZ>*<SIZ>>_12.+<SIZ>_6,,-1 TERMIN
;(PLURAL) BYTE POINTER ARRAY TO LDB FROM INDEXED
DEFINE POINTS SIZ
REPEAT 36./<SIZ>,<36.-<SIZ>*<.RPCNT+1>>_12.+<SIZ>_6,,TERMIN
;(ILDB) BYTE POINTER ARRAY TO ILDB FROM
DEFINE POINTI SIZ
REPEAT 36./<SIZ>,<36.-<SIZ>*.RPCNT>_12.+<SIZ>_6,,TERMIN
;(BOTH) BYTE POINTER ARRAY TO EITHER LDB FROM OR ILDB FROM (OBSOLESCENT)
DEFINE POINTB SIZ
REPEAT 36./<SIZ>+1,<36.-<SIZ>*.RPCNT>_12.+<SIZ>_6,,TERMIN
;ASSEMBLE INTO A CERTAIN LOCATION
DEFINE TMPLOC LCTN,CRUFT/
.ZZ==.
LOC LCTN
CRUFT
.=.ZZ
TERMIN
;DECREMENT A 7 BIT BYTE POINTER
DEFINE DBP7 AC
ADD AC,[070000,,0]
TLNE AC,400000
SUB AC,[430000,,1]
TERMIN
;DECREMENT 7 BIT BYTE POINTER AND JUMP
DEFINE DBP7J AC,ADR
ADD AC,[70000,,0]
JUMPGE AC,ADR
SUB AC,[430000,,1]
JRST ADR
TERMIN
;ASSEMBLE FILE SPECIFIED BY TYPEIN (OBSOLESCENT)
DEFINE ..INSRT FILENAMES
IF1,[PRINTC FILENAMES PLEASE.
]
.INSRT @:JSF;FILENAMES
TERMIN
;REPEAT AN INSTRUCTION WITH VARIOUS ADDRESSES
DEFINE INSIRP A,B
IRPS %%ADR,,[B]
A,%%ADR
TERMIN
TERMIN
;NON-TS DEFINITIONS
PICON==2200 ;IN RH(CONO PI,), TURN ON CHANNEL(S)
PICOFF==1200 ;TURN OFF CHANNEL(S)
PICIRQ==4200 ;REQUEST INTERRUPT ON CHANNEL(S)
;DEFINE IO DEVICE SYM SUCH THAT DDT WILL TYPE IT OUT
DEFINE IODEV LINE/OLDEND,IODEVC,OIODEV
IODEVC==0
IF1,EQUALS OIODEV,IODEV
DEFINE IODEV ASSGT,OVAL
IFNB [OVAL]ASSGT==OVAL
IFB [OVAL]ASSGT
IRPS %DEV,,[ASSGT]
DEF IOD,\IODEVC,[
%DEV=<BLKI %DEV,>-BLKI
]
.ISTOP
TERMIN
IODEVC==IODEVC+1
TERMIN
EQUALS OLDEND,END
EXPUNGE END
DEFINE END
IF1,EQUALS IODEV,OIODEV
IF2,[REPEAT IODEVC,[
CONCAT IOD,\.RPCNT
]]
EQUALS END,OLDEND
EXPUNGE OLDEND,IODEVC,OIODEV
END!TERMIN
IODEV LINE
TERMIN
IFNDEF SWRQ,.INEOF ;THAT'S ALL IF HE DOESN'TTAKE NOTICE OF TYPEIN
IFE SWRQ,.INEOF ;THAT'S ALSO ALL IF HE DOESN'T WANT TYPEIN
DEFINE INSERT LINE/
IRPS %NAME,,[LINE]
DEFINE %NAME DEFALT/
.INSRT DSK:DEFALT  LINE
TERMIN
.ISTOP
TERMIN
TERMIN
PRINTA SWITCHES?
EQUALS NO,.INEOF ;NO IS VALID ANSWER
%ZQ.$X: .INSRT TTY:
LOC %ZQ.$X
EXPUNGE NO,%ZQ.$X
PRINTA OK.; ;ACKNOWLEDGE NO OR .INEOF (USERS LIKE SIGNS OF LIFE)
DEFINE INSERT DEFALT/GENSYM
IRPS %NAME,,[DEFALT]
IFNDEF %NAME,[
DEFINE %NAME
.INSRT DSK:!TERMIN
]
DEFINE GENSYM
EXPUNG GENSYM
%NAME!!TERMIN
.ISTOP
TERMIN
GENSYM DEFALTîTERMIN
;THAT'S ALL