From e1728f924e1b5321a1c7e4b63724f4aff90930a8 Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Mon, 7 Nov 2016 08:08:32 +0100 Subject: [PATCH] PDSET source code. --- doc/sysdoc/pdset.info | 66 ++++ src/sysen1/pdset.114 | 876 ++++++++++++++++++++++++++++++++++++++++++ src/syseng/jsf.macros | 213 ++++++++++ 3 files changed, 1155 insertions(+) create mode 100755 doc/sysdoc/pdset.info create mode 100755 src/sysen1/pdset.114 create mode 100755 src/syseng/jsf.macros diff --git a/doc/sysdoc/pdset.info b/doc/sysdoc/pdset.info new file mode 100755 index 00000000..547a45c8 --- /dev/null +++ b/doc/sysdoc/pdset.info @@ -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 \ No newline at end of file diff --git a/src/sysen1/pdset.114 b/src/sysen1/pdset.114 new file mode 100755 index 00000000..b20e90d2 --- /dev/null +++ b/src/sysen1/pdset.114 @@ -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,\-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 diff --git a/src/syseng/jsf.macros b/src/syseng/jsf.macros new file mode 100755 index 00000000..0c040ecd --- /dev/null +++ b/src/syseng/jsf.macros @@ -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*<&LHF>-(3700)+<_<-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 +_12.+_6,,TERMIN + + ;(LEFT) BYTE POINTER, 1STBIT ARG IS # BITS TO LEFT OF BYTE + +DEFINE POINTL 1STBIT,SIZ +<36.--<1STBIT>>_12.+_6,,TERMIN + + ;BYTE POINTER TO BYTE BEFORE FIRST IN WORD + +DEFINE POINTZ SIZ +36.-<36./*>_12.+_6,,-1 TERMIN + + ;(PLURAL) BYTE POINTER ARRAY TO LDB FROM INDEXED + +DEFINE POINTS SIZ +REPEAT 36./,<36.-*<.RPCNT+1>>_12.+_6,,TERMIN + + ;(ILDB) BYTE POINTER ARRAY TO ILDB FROM + +DEFINE POINTI SIZ +REPEAT 36./,<36.-*.RPCNT>_12.+_6,,TERMIN + + ;(BOTH) BYTE POINTER ARRAY TO EITHER LDB FROM OR ILDB FROM (OBSOLESCENT) + +DEFINE POINTB SIZ +REPEAT 36./+1,<36.-*.RPCNT>_12.+_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 + ] + .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 +  \ No newline at end of file