!!Transcription by jsm February, September, October 2002 !!Page 7 ttl !Dartmouth Time-Sharing System 235 Executive!1 stl !Initial Loader loc 34000 !Date of latest reassembly goes here #date: bss 0 oct 1032 !Update August 26, 1965 [RPL] , Dartmouth College Time-Sharing System , 235 Executive , Richard P. Lacey [67] April 1965 - , John S. McGeachie [65] April 1964 - April 65 , Phase IV , For 44 teletype disk allocation of July 13, , 1965. , 16K Loader - will load 16K GAP cards into , upper or lower memory. Accepts single or , multiple origin cards and octal corrections. , Octal corrections may be single or multiple , origin. Scan terminated by single character , field. , Author Charles G. Moore [65] loc 3000 #r: bss 42 !read-in area #rw: bss 41 !analyze area octacc: bss 1 !working storage for octal corrections octadd: bss 1 #wdct: oct 2017777 !mask to leave address and sign bit #R2: dec #rw !card move constants dec -40 #mc: dec 2 !memory clear constants dec -1533 #mc1: dec #last+1 dec -12286 #addr: oct 1760000 !address correction mask #8k: dec 8192 octc: oct 3776000 !octal correction mask #load1: ldz !check switch 19 for memory clear sta #last !clear to contents of switches sta 1 ldx 8k,2 !get upper bit lda #date,2 !and save date sta #x3sv dld #mc mov 1 rcs !Check if clear later part sta #sflag !Set systems flag bod !!Page 8 bru #load !No dld #mc1 mov #last ldx #8k,1 !Restore at earliest lda #x3sv sta #date,1 !opportunity #load: rcb #r !Read first card - fill buffer hcr !but is loaded normally ldz !Make sure we start in lower bank sta #x3sv #r1: dld #r2 !Normal entrance for card read bcn bru *-1 !Wait for reader ready mov #r !and then move from read buffer sta #rw+40 !Set zero to end of card image ldx #zf,1 !Set up for scan ldx #x3sv,3 !Restore X3 lda #rw,1 !RW is working area - get control word bze bru #oct ext #wdct bze bru #t rcb #r hcr sra 13 #ze: sta 0 lda #rw,1 ext #addr !Leave address and sign bit bmi !If upper 8k add index bit #dart2: bru #dart1 !First Dartmouth-style card found sto 3 !Otherwise, GAL convention #ret: inx 1,1 !is return for each word in string lda #rw,1 sta 0,3 !Put it away add #rw-1,1 !totaling for checksum bov ado sta #rw,1 !Save present checksum inx -1,0 !Bump down word counter inx 1,3 !and bump up address counter - put away bxh 1,0 !and check for end of string bru #ret !If not, put away another word sub #rw+1,1 bze !Check checkword bru *+3 lda #rrr !If not, set up for error halt bru * !Recover is backspace A-I start inx 2,1 lda #rw,1 ext #wdct !!Page 9 bnz bru #ze-1 #rrr: bru #r1 !Go get another card #t: lda #rw,1 !Get transfer address bmi #dart3: ldx #8k,3 !If first Dartmouth-style, do not panic sto 3 !Else GAL lda #sflag !Save systems flag sta sload bru 0,3 !exit add #8k #dart1: lda *-1 !Set instructions for Dartmouth style sta #dart2 sta #dart3 !Reset transfer lda octe+1 sta #dart2+1 sta #dart3+1 bru #ze+1 !Get back , Free-form octal corrections - #oct: rcb #r hcr ldx #ze,2 stx #x3sv,3 !Save index register 3 bru octe octb: sra 10 ext octc !Get left half of word, and dump rest nor 16 sla 1 lda octacc bov !If overflow, there is a word bru octd bxl 2,3 bru octe bxl 3,3 bru #r1 !Single character field - get out bxh 7,3 bru octf sta octadd !Or address octe: ldz sta 3 lqa bru octa-1 octd: sld 3 ext 0 bno chs sta octacc octa: inx 1,3 bxh 40,1 !!Page 10 bru #r1 !Card finished lda octc lqa lda #rw,1 bxl 1,2 spb octb,2 inx 1,1 ldx #ze,2 bru octb+1 octf: ldx octadd,3 sta 0,3 inx 1,3 stx octadd,3 bru octf #x3sv: bss 1 !X 3 temporary save #sflag: bss 1 !Systems temporary flag #last: equ * tcd #load1 stl !Disk loader for systems and executive ejt !!Page 11 , Load checks switch 7 - if down, then no , billing is desired, so KBILL and IREC are , inhibited. , - if up, billing is desired. , The SRES sequence performs a series of , checks to insure that , 1] the SPR switch is set to the all position , 2] the disk is clear , and the 6k mod is working , 3] the console switches are reset , 4] the AAU is ready , If any of the above conditions fail to , be true, the console typewriter will type , a message to the operator and continue to , do so until the condition has been corrected. , 5] SRES also checks the batch flag. If on, , it crumps the switch check and sets up an , entry into the batch overlay in the task , list. , 6] It reads in the summary record from the , disk and resets it to zero if the bootstrap was , typed on TTY 1. loc 1000 load: bss 0 ton sxg 0 !Set zero in case switch bad ldx 8k,3 lmo !Set disk flag 2 on sta dkflg2 ldz !and set address for relinquish sta relad,3 rcs !Check billing switch ext $bmsk !billing mask - oct 3767777 sta $bf !and set in flag bnz1 bru *+4 !Billing not set spb $ertyp,2 !Billing flag on dec bon bru sres spb $ertyp,2 !Billing flag off dec boff lda $nob !Inhibit KBILL and IREC sta kbill,3 sta irec,3 sres: sxg 0 !!Page 12 set pbk !and prevent interrupts lda sign sta pmbx0 ton ldz !Now find out what group we are in sta xr01 sta z1 spb *+1,1 lda xr01 bnz bru saok !Ok, neither API not Trap lda z1 !API... bnz set pst !yes, exit set pbk set trpmode set ntpmode ldx zero,2 !and exit bru *+1,2 saok: sxg 5 !continue ldx 8k,3 !Set upper 8k bit on ldx zero,1 !Test SPB switch spb *+1,1 bxh 1,1 !If 1 is higher than 1, then SPB switch is bru *+6 !set to all, else it is at 0 sxg 0 !set 0 ldx 8k,3 !Upper 8k bit on spb $ertyp,2 dec rspb !Reset SPB switch to all bru sres !Go back and test again bar bar,7 !See how AAU is bru *+4 spb $ertyp,2 dec raau !Loafing bru sres !and check again spb $dkstst,2 !Get disk lda loadf !Check for card load bmi !If load flag on, bru loadc !then punt message this time , If batch bootstrap do not bring in the summary lda sbak !See if batch bpl bru *+12 lda sbak+1 !See if have a front sta io1 !minus if a front card was around dld .sres. !Batch - so set up return dst iplst,3 dld bsums1 !Get summary back mov bsums lac !Compute batch running time !!Page 13 sub otim1t,3 add fkbat sta fkbat bru skex !and get out , procede with normal bootstrap sel 0 prf ,0 !Position for efficiency record oct 402 bcs brn,0 bru *-1 sel 0 rrd 1,0 !! original code shows 'fclock' in operand field dec fclock !!Verify value is 0000600 bcs brn,0 !Wait bru *-1 bcs ber,0 bru *-11 lda sign !Reset special mailbox to normal status sta pmbx0 lda fclock !Check starting time bnz !If not zero, then regular bootstrap bru soak2 !so skip initialization dld fclear !If zero, clear summary area mov fclock sta acrun sta acswap sta acdisk !Initialize accumulated time counts sta acbat lac !Get starting time sta fclock sta acstrt spb $time,2 , Pick up starting times for short-run summary dst fstim dst astim2 !Long run summary sel 0 !Rewrite on disk prf ,0 oct 402 bcs brn,0 bru *-1 sel 0 wrf 1,0 dec fclock bcs brn,0 bru *-1 bcs ber,0 bru *-11 soak2:ldx zero,1 !Reset flag lda f4,1 !and transmit summary so far to accumulator sta fkedit,1 !!Page 14 inx 1,1 !Step count bxl fkbat-f3,1 !and test if done bru *-4 !No lda ohzyf,3 sta bzyf , Further checks to make sure system is working ldz !Check for switch 1 down bcs bze bru *+3 spb $ertyp,2 dec res !Reset switches lda exec2+1,3 !Check 6K mod on disk sub 1025 !Left in from bootstrap bnz Bru *+4 !OK spb $ertyp,2 dec sdsd bru load1 !Try again lda $bf !Billing flag bnz bru stime !Not on, crump sboot:spb $twait,2 !Wait for tape bru *-1 !Try again sel 1 !If OK, write wtb boot,0 !Bootstrap message dec 30 !Different length spb $twait,2 !Check again bru sboot !Try again bru stime !Get around buffer stime:spb $time,2 sta d1 !Store it in done statement laq sta d1+1 spb $ertyp,2 dec d lda tmm !Temporary malfunction sta mbx1 lda kermes !Error message sta mbx0 skex: spb $relin,2 !Get rid of the disk ldx zero,2 lda pmbx0 !Wait for d-30 to answer bmi bru *+5 inx 1,2 !See how long he takes ldx zero,1 !Waste time bxl 8190,2 bru *-6 !2/3 of a second !!Page 15 kon !Go on with load oct 2506014 !Priority request bru wait,3 !Get out $relin: bru relin,3 $time: bru time,3 $twait:lda dtime !Get inteval bcs btr,1 !If tape ready bru 2,2 !return OK maq !Save count rcs !Check switches sra 19-7 !and check switch 7 bod bru stime !If down, punt laq !Else keep counting sbo !else count bpl bru $twait+1 !Still OK stx $temp,2 !Save register spb $ertyp,2 !and type message dec $tpnr !Tape not ready ldx $temp,2 !Get register bru 1,2 !and bad return $ertyp:ldx zero, 0 !Initialize coutner lda 1,2 !and get address of message sta temp ldx temp,1 ton !Turn on typewriter bnr !and check if ready bru $type1 inx 1,0 !Count bxl 8190,0 bru *-4 !and keep trying bru 2,2 !Exit if not ready $type1:lda 0,1 !Get word ext sign !and get rid of sign srd 12 !Get most in Q inx 1,1 !and step pointer ldx zero,0 !Reset counter $type:stx temp,0 !Save character pointer bnn !and wait for ready bru *-1 !!Page 16 inx 1,0 !Step counter bxl 100,0 !Stupid typewriter - IBM equipment bru *-4 !Make sure ready 50 times before using ldx temp,0 !Restore character pointer cab peom !and check for end of message bru *+2 !no bru 2,2 !Exit san 6 !else type typ inx 1,0 !Step character counter bxh 3,0 !One word typed... bru $type1 !yes sld 6 !Get next character bru $type !and type it $tpnr:bss 0 !Tape controller not ready. oct 373772 !Tape controller not ready alf tap !Make sure handler 0 has a scratch tape alf e c !and is on remote. Then clear controller alf ont alf rol alf ler alf & no alf t r alf ead oct 701537 oct 754421 alf ke& alf sur alf e h alf and alf ler alf & 0& alf has alf & a& alf scr alf atc alf h t alf ape alf & an alf d i alf s o alf n r alf emo alf te. oct 376330 alf en alf cle alf ar& alf con !!page 17 alf tro alf lle oct 513355 , Messages res: bss 0 !Reset switches oct 374124 alf set alf & sw alf itc alf hes oct 557777 rspb: bss 0 !Set SPB switch to all oct 376225 alf t s alf pb& alf swi alf tch alf & to alf & al oct 435577 boot: bss 0 oct 2606060 oct 557755 !Special pattern alf boo alf tst alf rap alf & no oct 333535 alf & & & alf & & & alf & & & alf --- alf & & & d: bss 0 !End load Date and time. oct 372545 alf d l alf oad alf & & & date: alf & & & alf & & & alf & & & alf & & & alf & & & alf & & t alf ime d1: alf & & & !Time goes in these two locations !!Page 18 alf & & & alf & ho alf urs oct 373755 oct 2606060 bon: bss 0 !Billing flag set to bill oct 372231 alf lli alf ng& alf fla alf g s alf et& alf to& alf bil oct 433355 boff: bss 0 !Flag set for no bill oct 372643 alf ag alf set alf & fo alf r n alf o b alf ill oct 335577 sdsd: bss 0 alf som alf e f alf ool alf & ch alf ang alf ed& alf the alf & 6K alf & mo alf d s alf wit oct 233037 oct 557777 raau: bss 0 !AAU loafing alf aau alf & lo alf afi alf ng. oct 373755 ejt !Page 19 !!Page 19 , The main body of the executive is first put , on the disk. The 16K loader is then , re-entered to read in the executive , overlays, each of which is put on the disk , in turn. The last overlay is followed by two , transfer cards, the second of which transfers , to the SRES routine which types out the , DONE message to signify loading has been , completed. loadc:ldz !Reset load flag sta loadf lda sload !Check system flag bpl !If not on, bru lself !Load executive dld .set. !Set up linkage dst iplst,3 !Set in list set pst !Just in case oct 2506014 !SET PRQ bru wait,3 !and scram set: dld unset !delete entry dst iplst,3 inx sys,2 !and set for system bru perget,3 , write bootstrap on the disk lself:bcs brn,0 !Put loader on the disk first bru *-1 sel 0 prf !Position oct 2476 !Disk 0, Position 5, Record 31 bcs brn,0 bru *-1 sel 0 wrf 1,0 dec load1 !Loader bcs brn,0 bru *-1 bcs ber,0 BRU *-11 lda mask6 !Convert loader to write executive on disk sra 3 !Place a 37 in highorder bits ory load2 ory load3 lda zero sta in !Zero out some critical locations sta mbx0 lda $bldv !Pick up branch and overwrite bootstrap sta ltrans !!Page 20 bru load1 loadov: ldz !Clear overlay areas sta execove,3 dld ovclr mov execov sxg 0 !Set zero for loader bru #load !and reenter it lovwrt: bss 0 sxg 5 ldx 8k,3 ldx pernum+1,2 !Pick up overlay address pointer lda 2,2 bmi !If negative, error, so crump works bru * sta relad,3 !Set for relinquish sta *+5 !Put away in position location bcs brn,0 !Wait for disk ready bru *-1 sel 0 prf ,0 !Position oct 0 bcs brn,0 bru *-1 sel 0 wrd 8,0 !Write dec execov bcs brn,0 !Wait bru *-1 bcs ber,0 !Errors... Bru *-11 !If so, rewrite bru loadov !Continue picking up overlays $dktst:ldx zero,0 !Set counter ldo !and ask for disk sta pmbx0 lda dtime bcs brr,0 !Check if ready bru 1,2 !If so, exit sbo !Decrement bpl !and wait again bru *-4 inx 1,0 !Increment bxl 3,0 bru $dktst+1 !and try again stx $temp,2 !Save entry spb $ertyp,2 !and type a nasty mesage !!Page 21 dec dc ldx $ttemp,2 !Restore entry bru $dktst !and wait again .set.: ldx zero,2 !Set pointer bru set,2 bsums1: dec fkedit dec -8 ovclr: dec execov+1 dec -511 unset: bru iplst+2 dec 0 fclear: dec flapse !Constant to clear out summary area dec f1-f2 .bres.: spb bres,1 !Reset entry to batch dec -1 date1: dec date !Date move constants dec -5 date2: dec sdate dec -6 !plus coded date dtime: oct 40000 !Disk waiting time $bmsk: oct 3767777 !Billing flag mask $nor: bru 1,2 !Tape inhibit $bldv: bru loadov !Bootstrap overwrite pernum: bss 2 !Overlay number and address pointer $bf: bss 1 !Billing flag $temp:bss 1 !Storage stl !Bootstrap ejt !Page 22 !!Page 22 , Disk map of 235 executive , Tracks 0-4 are reserved for the D-30 , 0 5 0-30 Batchsim , 2476 0 5 31 Bootstrap , 2500 0 5 32 Lower memory portion , 2540 0 5 48 Upper memory portion , 2600 0 5 64 more upper memory , 0 6 0-31 Batchsim , 3100 0 6 32 Card lister , 3120 0 6 40 Reproducer , 3140 0 6 48 System loader , 3160 0 6 56 Catalogue files , 3200 0 6 64 Catalogue printout , 3220 0 6 72 Disk dump , 3240 0 6 80 Disk load , 3260 0 6 88 Billing overlay , 3400 0 7 00 Batch front card record , 3500 0 7 32 System loader , 3520 0 7 40 GAP lister , 3540 0 7 48 Efficiency summary of system , 3560 0 7 56 Time-sharing background monit , 3600 0 7 64 Background monitor part two , 3620 0 7 72 Sysout lister , 3640 0 7 80 Tape subroutine , 3660 0 7 88 Batch systems catalogue , 4100 0 8 32 T-S batch system monitor , 4120 0 8 40 T-S batch part three , 4140 0 8 48 T-S batch part two , 4160 0 8 56 T-S batch part four , 4200 0 8 64 Card to tape , Tracks 10 to 31 are for systems , 24100 0 40 32 Batch dump areas , 24500 0 41 32 , 25100 0 42 32 , 25500 0 43 32 , 30000 0 48 00 Batch scratch areas , 30400 0 49 00 , 31000 0 50 00 , 31400 0 51 00 , 32000 0 52 00 Batch loaders !!Page 23 , 40000 1 00 00 Batch programs , to , 51400 1 19 00 loc 6000 !225 Executive bootstrap load1: bcs brn,0 !Wait for disk ready bru *-1 sel 0 !Position prf ,0 oct 2500 bcs brn,0 bru *-1 sel 0 !Read in lower memory part load2: rrf 16,0 !16 records %0 !from beginning of memory bcs brn,0 !Wait bru *-1 bcs ber,0 !Check for errors bru *-11 sel 0 !Position again prf ,0 oct 2540 bcs brn,0 !Wait bru *-1 sel 0 !Read in first K of program load3: oct 1210010 !Read 24 records z01 exec1,1 bcs brn,0 !Wait bru *-1 bcs ber,0 !Check for errors bru *-11 lda sbak bmi bru *+13 !!Whatever possessed someone (me?) to do this? sel 0 !Position for OBA from last dump prf ,0 oct 25660 bcs brn,0 !Wait bru *-1 sel 0 rrf 8,0 !Put it back %execov bcs brn,0 !Wait bru *-1 bcs ber,0 !Check for errors bru *-11 sel 0 !Pick up date for output message prf ,0 oct 400 bcs brn,0 !Wait !!Page 24 bru *-1 sel 0 !Read in date rrf 1,0 %ldate !into date region bcs brn,0 !Wait bru *-1 bcs ber,0 !Error check bru *-11 !If errors, re-read dld date1 mov ldate+3 dld date2 mov ldate+2 ltrans: bru sres loc 6074 !Special flags sbak: dec 0 !Background-in-operation flag dec 0 sload: dec 0 !System load flag loadf: dec -1 !Initialize load flag at -1 ldate: eqo 10000 stl !Lower-lower storage ejt !!Page 25 loc 0 bss 1 !Index registers used by Edit xr01: bss 1 xr02: bss 1 xr03: bss 1 xr10: bss 1 xr11: bss 1 bss 1 bss 1 ech2: bss 1 !Character holders for echar ech3: bss 1 eselec: bss 1 !Binary line number for selective list bss 1 !Starting disk address for selective list edy: bss 1 !Address of CR at end of instruction edt: bss 1 !Address of CR at end previous instruction edz: bss 1 !Line number currently being adjusted bss 5 !Other index registers bss 2 !X-group 5 xr52: bss 2 ty: bss 20 !Typewriter input line build t: bss 16 !Temporary storage for peripheral routines ta: equ t+4 !Space for tape subroutine storage dkflg1: bss 1 !Disk flag 1 for regular tasks dkflg2: bss 1 !For extra tasks iadrs: bss 2 !Disk addresses, second is memory location in: bss 2 !Current system identifier and rep number mstemp: bss 2 !Temporary storage save: bss 2 !A and Q saved by interrupt routine bzyf: bss 1 !Busy flag dcnt: bss 1 !Disk operations counter dival:bss 1 !Disk operations elapsed time interval drcnt:bss 1 !Disk operations error counter dstakf: bss 1 !Gives number of disk requests stacked up .eff: bss 1 !Efficiency flag hdskd:bss 1 !Time counter for disk requests inov: bss 1 !Overlay in use by current system inpnt:bss 1 !Points to disk address of current system .ins: bss 1 !Insert task save int1: bss 1 !Interrupt time for 235 isum: bss 1 !Clock save at interrupt time itim: bss 1 !Real time + 1 minute kanswr: bss 1 !Answer for Datanet-30 kret: bss 1 !Temporary storage for Datanet-30 routines pcnt: bss 2 !Word and character counters used by ptype pct: bss 1 !P counter save perin:bss 1 !Indicates peripheral task currently in mem. preg: bss 1 !P-counter save for kdump ptemp:bss 1 !Storage for word currently being type rawt: bss 1 !Temporary storage !!Page 26 stack:bss 1 !Backlog of typewriter requests swflg:bss 1 !Switch flag for next sector and peripherals temp: bss 1 !Temporary storage typf: bss 1 !Typewriter usage flag , Accumulator for systems operation summary fkedit: bss 1 !0 - Mailbox routine numbers fkstrt: bss 1 !1 fkwtnu: bss 1 !2 fkdump: bss 1 !3 fkread: bss 1 !4 fkwrit: bss 1 !5 fktea:bss 1 !6 fkbat:bss 1 !Batch accumulator f3: equ fkedit-1 cmess:oct 0 !Peripheral communications cmessb: bss 1 !Batch flag eavail: dec eplst !End of list einit:dec iplst !Start of task list ovtsk:dec 0 !Either zero or pointing to routine loc. ty1: dec 0 !Word pointer for typweriter input ty2: dec 8192 !Character pointer for typewriter input .dskc.: spb dskc,1 !Entries .dskd.: spb dskd,1 .dsec.: spb dsec,1 !dskop continuation .dskx.: spb dskx,1 !Disk request entry for dska, part 2 .krst.: bru krst,3 !Trap restore branch .krex.: spb krex,1 !Special interrupt-trap branch .kset.: spb kset,1 !kdump disk write entry .ktri.: bru ktri,3 !Branch to check trapmode .ktrs.: bru ktrs,3 !Trap save check .ktrs]: spb tx2,0 !Trap check .kwrt.: spb kwrt,1 !Entry for source rewriting .syov.: spb syov,1 !Overlay read entry .pms1.: spb pms1,1 !Typewriter entry org 128 z0: dec 0 z1: dec 0 z2: dec 0 z3: oct 20000 !Upper 8K bit bru inter,3 !Go to interrupt routine bss 1 !AAU trapping mode - overflow itrap:bss 1 !AAU trapping mode - underflow bss 1 !AAU trapping mode - divide check bss 2 !AAU trapping mode index group tx2: bss 2 !Registers 2 and 3 !!Page 27 stl !Mailbox area ejt !!Page 28 , Mailbox zero flag is set to indicate , Datanet-30 message. , Return message also goes in mailbox 0 , These messages [to D-30] are: , +1 Error, mbx1 tells what type , 0 Temporary malfunction , 1 No program , 2 Unrecognizable system name , +2 Read done , +3 Write done , +4 Request dump , Messages used only after a dump from the D-30: , +5 Terminal exit , +6 Intermediate output , +7 Call for input , ****************************************** , Special message switching mailbox , has the followind code: , +1 Disk request from 235 , +2 235 finished with disk , +3 Request Datanet-30 to stop counting time , +4 Datanet-30 can start counting time again , +5 Not used at present , +6 Off , +7 On , -0 Acknowledge by D-30 and normal status , +10 Start batch , +11 Stop batch , Special request by a running system... , +12 Transfer ending disk address mbx0: bss 1 !Points to routine to be executed mbx1: bss 1 !Alfameric system name - first three letters bmx2: bss 1 !Starting disk address mbx3: bss 1 !Ending disk address and rel. loc. for LIST bss 2 !User number - or Selective LIST line number bss 2 !Problem name mbx8: bss 2 !Real time for Datanet-30 pmbx0:bss 2 !Special mailbox , Upon receipt of a message from the Datanet-30 , The messages get moved into the saved mailbox , area, which follows: smbx0:bss 1 !Saved message smbx1:bss 1 !Saved system name !!Page 29 smbx2:bss 1 !Saved starting disk address smbx3:bss 1 !Saved ending disk address smbx4:bss 1 !Saved user #, sel. LIST #, Teach address smbx5:bss 1 !Saved ending Teach disk address bss 2 !Saved problem name sdate:bss 6 !Date always kept here - used in billing sclock: bss 4 !Billing time information stl !Constants ejt !!Page 30 , Double-length constants cov1: oct 1777777 !Overflow-causing constant oct 1777777 cun1: oct 2000000 !Underflow causer oct 2000001 edeof:oct 777755 !End of message mark edfill: oct 777777 !Fill character. .drmc.: spb drmc,1 !System disk usage entry z00 -- !filled in by executive kfuge1:bru iplst !Special regular mailbox entry delete constant dec wait-5 !Special for dexit kxo: dec mkx0 !Save index groups 0-4 dec -20 movmbx: dec smbx1 !Mailbox 1, 2, 3, 4, 5, 6, 7 save dec -7 d15: dec 15 dec -1 trapr:dec itrap-1 !Trapping restore constant dec -7 traps:dec mktrp+1 !Trapping mode save constant dec -7 zero: ddc 0 .effy.: spb effy,1 !Efficiency entry dec -1 .disk.: spb disk,1 !Dskop entry dec 0 .iras:bru 2 !Erase entry oct 0 .kbil.: sbp kbil,1 !Billing entry dec -1 .pty.:bnr !Pty pointer spb pty,1 , Constants one: oct 1 mone: dec -1 two: oct 2 mtwo: dec -2 three:oct 3 four: oct 4 five: oct 5 six: oct 6 seven:oct 7 o10: oct 10 ten: dec 10 o20: oct 20 !Disk count stepping constant !!Page 31 cr: oct 37 !Carriage return o40: oct 40 o60: oct 60 !Trailing blank... o100: oct 100 !Position step for disk addresses o140: oct 140 !96 records for disk o200: oct 200 !Buffer flip for dump routine o300: oct 300 !Illegal disk address test o400: oct 400 o440: oct 440 !Fudge constants for scratch algorithm 8K: oct 20000 !Upper memory relocation constant mask1:oct 3777400 !For disk address checking mask3:oct 3777770 !Message protect mask mask4:oct 3760000 !Disk protect mask mask6:oct 3000000 mask7:oct 3777700 !Edit mask mask8:oct 0000077 !Edit mask mask9:oct 3600000 !API mask mask10: oct 3700000 mask11: oct 0077777 !Special P-counter mask mask12: oct 0177777 !Special edit mask bit3: oct 200000 !Stacker full indicator on disk operations bit4: oct 100000 !Error indicator on disk operations dinst:oct 10040 !Disk instruction less high order bits dstakp: dec dstak-4 !Special disk fudge factor kfudge: dec iprior !Special dska fudge factor mblnk:oct 2606060 !End of print line blank ovflo:oct 1000000 !Overflow constant sign: oct -0 stwo: oct -2 peom: oct 55 !End of message for ptype routine tend1:dec k3area-2 !End of program nfl: set nflpoint unf: set uflpoint fix: set fixpoint !Set AAU modes , System table with disk addresses , Standard overlay is 3K, system is on fast , tracks and experimantal sys is on slow sytab:bss 0 alf BAS !Basic oct 5000 !0 10 00 oct 10540 !0 17 48 alf ALG !Algol oct 5400 !0 11 00 oct 6140 !0 12 48 oct 6540 !0 13 48 oct 15400 !0 27 00 alf FOR !Fortran oct 13400 !0 23 00 oct 14000 !0 24 00 !!Page 32 oct 14400 !0 25 00 alf DIP !Dartmouth Interpretive Program oct 7000 !0 14 00 alf TSA !Time-Sharing Assembly processor oct 7400 !0 15 00 oct 15000 !0 26 00 alf XAL !Experimental Algol oct 10000 !0 16 00 oct 6000 !0 12 00 oct 6400 !0 13 00 oct 16000 !0 28 00 alf XBA !Experimental Basic oct 11000 !0 18 00 oct 10400 !0 17 00 alf XFO !Experimantal Fortran oct 11400 !0 19 00 oct 12000 !0 20 00 oct 12400 !0 21 00 alf EDI !Edit system oct 13000 !0 22 00 last: equ *-sytab !Maximum number of entries in table sexit1: bru sysex !Exit branch sexit2: oct 20000 !Exit constant [must have 8K bit set] syloc:dec system !Read-in location mendt:oct 1400 !Move test constant smove1: mov 0 !Move constant wait1:dec wait !Interrupt point test h1: oct 52140 !Time constants [21600 = 3600*6] blzz: alf & 00 h2: oct 550 ;[360 = 60*6] colon:oct 150000 dumpbl: alf & & & k2loc:dec k2area !2K area k3loc:dec k3area !3K area k6loc:dec k6area !6K area k6area: eqo 4000 !6K area start k2area: eqo 6000 !2K area start k3area: eqo 12000 !3K area start kermes: equ one !Error answer kmes2:equ two !Normal answer for reads kmes3:equ three !Normal answer for writes kmesd:equ four !Request dump kmest:equ five !Terminal exit message kmeso:equ six !Intermediate output message kmesi:equ seven !Real-time input call message bit1: equ ovflo !Parity error indicator hdreq:equ one !Disk request message exec1:eqo 34000 !First part of 235 executive exec2:eqo 36000 !Second part 235 executive imer: oct -10 !!Page 33 , Edit constants rog: equ k3loc rog2: equ k2loc tend: equ k3loc edsf: equ o100 edpnt2: dec smbx4 !Points to selective list number $edig:equ mask12 !Edit mask 0177777 edtwo:equ mtwo edmsk1: equ mask7 !oct 3777700 edmsk2: equ mask8 !oct 0000077 edcarr: equ cr !Carriage return upper8: equ 8K table:eqo 4000 !Start of edit linkage table stl !Time-sharing typewriter options ejt !!Page 34 com: bss 0 !List of options available on typewriter oct 623700 !Stop - same as crump bru icrump,3 key: equ *-2 !Key to catalogue oct 3160 !0 6 56 alf OFF !Off tells the D-30 to stop counting time bru ioff,3 summry: equ *-2 !Time-sharing operations efficiency summary oct 3540 !0 7 48 c/p: alf C/P !Lister bru perget,3 oct 3100 !0 6 32 c/c: alf C/C !Reproducer bru perget,3 oct 3120 !0 6 40 sys: alf SYS !System loader bru perget,3 oct 3140 !0 6 48 cat: alf CAT !Catalogue printout bru perget,3 oct 3200 !0 6 64 dum: alf DUM !Disk dump bru perget,3 oct 3220 !0 6 72 loa: alf LOA !Disk loader bru perget,3 oct 3240 !0 6 80 bil: alf BIL !Billing pack program bru perget,3 oct 3260 !0 6 88 dbg: alf DBG !Debugging overlay bru perget,3 oct 3500 !0 7 32 g/p: alf G/P !GAP lister bru perget,3 oct 3520 !0 7 40 s/o: alf S/O !Sysout lister bru perget,3 oct 3620 !0 7 72 !!Page 35 batch:alf BAT !Bacground processor bru perget,3 oct 3560 !0 7 56 c/t: alf C/T !Card to tape bru perget,3 oct 4200 !0 8 64 cru: bss 0 oba: alf OBA !Special batch system overlay bru * !Will never come here oct 4100 !0 8 32 tap: equ *-2 !Tape read/write subroutine oct 3640 !0 7 80 ocat: equ *-2 !Batch Systems catalogue oct 3660 !0 7 88 bat2: equ *-2 !Background part 2 oct 3600 !0 7 64 stl !Error messages ejt !!Page 36 tmm: equ zero !Temporary malfunction message npr: equ one !No program message usn: equ two !Unrecognizable system message datnet: bss 0 !D-30 kept disk oct 372403 oct 3755 dc: bss 0 !Disk controller oct 372431 oct 624237 oct 557777 dp: bss 0 !Parity oct 473755 ilg: bss 0 !Illegal oct 313755 adrs: bss 0 !Adrs xxxxxx oct 372160 adr1: alf & & & alf & & & pcr: oct 375577 mssage: bss 0 !Message oct 443755 full: bss 0 !Full oct 372643 oct 433755 del: bss 0 !Deleted alf & DE alf LET oct 252437 oct 557777 rea: bss 0 !Ready oct 375125 alf ADY oct 333755 bzy: bss 0 !Busy. oct 372264 alf SY. oct 375577 ilr: bss 0 !Illegal task oct 373232 !!Page 37 oct 323755 stl !Efficiency summary and buffer areas ejt !!Page 38 , Efficiency summary of systems operations loc 600 !One 64-word record fclock: bss 1 !Starting time flapse: bss 1 !Elapsed time fstim:bss 2 !Actual time of start fcnt: bss 1 !Half-hour counter bss 5 !Save 5 locations on principle f4: bss 0 bss fkbat-f3 f2: bss 0 , Day accumulators acstrt: bss 1 acrun:bss 1 acswap: bss 1 acdisk: bss 1 acbat:bss 1 !Accumulated batch astim2: bss 2 !Start for accumulated storage ftem: bss 4 !Temporary storage f1: equ flapse loc 1000 io1: bss 84 !Buffer area no. 1 loc 1200 !Second buffer area io2: bss 84 !Buffer area no. 2 , Sysout buffer areas loc 600 sio1: bss 80 !80 words sio2: bss 40 !40 words sio3: bss 40 !40 words sio4: bss 111 !110 words + 1 residue word sio5: bss 111 !110 words + 1 residue word bss 1 !Just to see how far I am , Disk addresses to be used at load time only loc 2000 oba2: equ *-2 !More of batch system overlay oct 4140 !0 8 48 oba3: equ *-2 !More batch oct 4120 !0 8 40 oba4: equ 4160 !Still more oct 4160 !0 8 56 !!Page 39 stl !Save area ejt !!Page 40 , The save area is used to save all , the important registers and index groups 0-4 , when a program is temporarily dumped on the , disk. loc 4000 kclock: bss 1 !Adjusted starting time for systems mkprnt: bss 1 !System output area pointer mksxg:bss 1 !Index group save - TEACH flag ilngth: bss 1 !Length of source program in memory mkdisk: bss 1 !Starting address of 6K area bss 1 !Blank for now mkaq: bss 2 !A and Q registers save mkov: bss 1 !Overflow save mkp: bss 1 !P-counter save mkx0: bss 20 !Index groups 0-4 save mkax: bss 2 !AX register save mkqx: bss 2 !QX register save mode: bss 2 !AAU mode and indicator save mktrp:bss 6 !Trapping mode flag and branch save mktx2:bss 2 !Trapping mode index register 2 save movid:bss 1 !Overlay identifier # morep:bss 1 !Number of current replacement molen:bss 1 !Length of overlay momem:bss 1 !Memory location of overlay movint: bss 1 !Flag to indicate whether read completed clock:bss 1 !Elapsed time counter mdc: bss 1 !Dump code for D-30 mdl: bss 1 !Dump length starts at 96 records mkpr1:eqo 4100 !System output buffer system: eqo 20000 !System read-in area sname:equ system+4 !Alfameric system name stl !Interrupt routine ejt !!Page 41 9/27/02 , When not performing any specific , task, the executive sits in its wait loop, , displaying a distinctive pattern in the , A register. loc 34001 wait: sxg 5 spb time,2 !Get time dst mbx8 !and give to Datanet-30 set pst !If in interrupt mode, exit set trpmode !If in trap program, exit set ntpmode !with no trap set ldx 8K,3 bru *+1,3 bno !Turn off overflow indicator nop lac cab int1 !Check if 1 second elapsed bru *+4 !No oct 2506014 !Yes, interrupt add four !Set timing interval for 2/3 seconds sta int1 cab itim !Check if 1+minute elapsed bru *+2 !If less, do nothing bru wait !If so, pick up time again cab .eff !Check if efficiency save due bru *-10 bru *-11 set pbk !Ten minutes elapsed, save lda cov1 !Make sure no more called until completion sta .eff dld .effy. spb insert,2 !Insert task in list bru wait+3 !and get back ejt !!Page 42 , Inter saves the working registers, and , first looks at the regular mailbox. If this , is positive, it goes through the regular , mailbox and then the peripheral mailbox , task tables in turn. , If the regular mailbox was negative, ireg , isolates the low order end and performs , a table lookup with the result. oct 0 ddc 0 !Make sure itab is even bss -3 inter:dst save !Save A and Q bov !Turn off overflow indicator bru *+1 stx pct,1 !and save P-counter lda mbx0 !Look at regular mailbox bmi !Check if negative bru ireg !If so, go service it , ****** WARNING...iprior must be even ****** iprior: bru *+2 !Priority task entry oct 0 iplst:bru *+2 !0 oct 0 bru *+2 !1 oct 0 bru *+2 !2 oct 0 bru *+2 !3 oct 0 bru *+2 !4 oct 0 bru *+2 !5 oct 0 bru *+2 !6 oct 0 bru *+2 !7 oct 0 !!Page 43 9/27/02 bru ispmbx !Last entry oct 0 eplst:equ * !End of list eplen:equ *-iplst !List length ispmbx:lda pct !Check P-counter bmi !If plus, then TON set bnn !so crump bru irest+1 ldx ty1,1 !Restore register 1 !!Word counter ldx ty2,2 !and 2 !!Character counter sna 19 !Get character ext sign !and get rid of a sign lqa !Keep a copy in Q cab mask8 !Check for line delete bru *+2 bru indel !Delete line inx 1,2 !Increment character counter bxh 3,2 !and check if over word ldx 8K,2 !Yes stx ty2,2 !Save bru *+1,2 !Code for characters as follows bru inr !Rightmost is 0 bru inl !Leftmost is 1 sla 6 !Middle is 2 ory ty,1 !Save middle character in word bru inchar !and check for carriage returns inl: sla 12 !Get character into word sta ty,1 bru inchar inr: ory ty,1 !Rightmost character inx 1,1 !Increment word pointer stx ty1,1 !and save inchar:laq !Get character sub cr !Check for carriage return bze bru ianaly !Yes, analyze command bxl 20,1 !Check status of one bru irest indel:spb messg,2 !DELETED message dec del indelx: ldz !Reset pointers sta ty1 sto ty2 bru irest !and get out !!Page 44 ibusy:sbp messg,2 !Type message dec bzy !BUSY bru indelx !and get out ianaly: sta ty1 !Reset pointers sto ty2 sta z2 inc com,2 lda ty !and analyze command ianalz: cab 0,2 bru *+2 bru 1,2 !Go to task inx 3,2 !Step pointer bxl cru,2 !Check for end of list bru ianalz ild: spb messg,2 !Type message dec ilr !Illegal task bru irest !and crump ioff: lda three !Stop time count bru *+2 icrump:lda four !Ask for time count again spb spmess,2 iredy:spb messg,2 !Type READY message dec rea ldx ovtsk,1 !Check if task used at all bxh 1,1 spb irase,2 !If greater than 1, then used iresp:ldz !Reset various pointers sta ovtsk !Reset pointer sta bzyf !and turn off busy flag sta cmessb !Reset batch flag sta io1 !for batch front card search sta kbfdg,3 !Fix billing sta kbfdg+4,3 irest:lda pct !Restore P-counter sta z1 bov !Make sure overflow is not on accidentally bru *+1 ext mask9 !and get rid of high order bits sla 4 !Restore overflow dld save !Restore A and Q set pst !!Page 45 bru 0,1 !Return irase:dld .ipas !Entered on 2 with pointer to be erased add z1 !in register 1. Construct bru *+2 and ext 8K !make for bank-compatible addresses dst 0,1 !Delete entry bru 1,2 !And return insert:sta .ins !Save entry. Insert sets up tasks for ldx zero,0 !API time ldx eavail,3 !Get next available location pointer ins1: inx 2,3 !Actually is last available bxh eplst,3 !and check for wraparound ldx einit,3 !Yes, re-initialize stx eavail,3 !Save pointer inx 2,0 !Count bxh eplen+2,0 !and check for end of table bru inful !Yes lda 1,3 !Check if entry free bnz !Entries have second word non-zero bru ins1 !Not free, keep searching lda .ins !Yes dst 0,3 !and set entries in list oct 2506014 !Make sure it gets serviced soon !!set prq lda eavail !and set pointer in A ldx 8K,3 ;Reset register 3 bru 1,2 ;and scram inful:ldx 8K,3 !Restore 8K bit ldx eavail,1 !and get entry being looked at spb irase,2 !Crump some task or other sbp messg,2 !and give room to output message dec full !Should never happen bru irest !and of course crump task ireg: sta smbx0 !Save message cab imer !Check for illegal message bru *+3 bru *+2 bru mer !Message error add 8K !Add upper 8K bit sta z2 !Set up for indexed branch to task stx preg,1 !Save P-counter for kdump dld kfuge1 !Get special erase entry dst iprior,3 !and set in regular mailbox task entry lda wait1 !and set P-location for exit sta pct lac !Save time sta isum !!Page 46 dld movmbx !Save mailbox 1, 2, 3, 4, 5, 6, 7. mov mbx1 sta mbx0 !Aknowledge message received cbuga:bru *+1,2 !And branch according to mailbox number bru kedit !0 bru kstart !1 bru kcntnu !2 bru kdump !3 bru kdskrd !4 bru kdskwr !5 bru kteach !6 bru kbrun !7 bru ktrrun !10 mer: spb adrser+1,2 !Message error dec mssage bru erxtmm stl !Edit ttl !Executive routines !!Page 47 , EDIT - message 0 , 1) Read variable-length source program from , teletype standard area into upper [3K] , area of memory. , 2) Edit source program into lower [2K] area , of memory. , 3) Write variable-length source program onto , teletype standard area from lower [2K] , area of memory. , 4) Place 2*length into mbx1, starting disk , address [selective list] into mbx2. , Normal answer = 2 , EDIT reorders a source program according , to the line numbers which precede each , statement. , A linked list is constructed, each entry , in the list corresponding to one statement , and consisting of four words, as follows , 1) location of first word of each statement , 2) length of statement in two's complement , 3) statement number in binary , 4) relative address of link with next , highest line number. , EDIT moves the source program down to , 6000 octal, ordering it according to , the list. kedit:bss 0 spb upread,2 !Read source program into upper area sxg 0 !Set group zero for edit set pst !and exit priority mode bru edita,3 kwrt: spb lwwrit,2 !Write source program from lower are bru kexitr edit1:mpy ten !Convert character bru echar !and get next edita:dld zero !Selective list pickup sta mbx3 !Set relative location to zero lda smbx4 !Check first character for digit ext $edig !Extract all but high order zone bits !!Page 48 bnz dld edeof !If first character not a digit, set to fills ldx edpnt2,1 !Set pointer spb echar1,3 !Get character cab ten !Check if digit bru edit1 !Yes, convert bru *+1 !No, crump laq !Get converted digit sta eselec !and save lda smbx2 !Pick up starting disk address ext one !Mask off extraneous bits sta eselec+1 !and save lda ilngth !Pick up program length sla 6 !Computer number of words to multiple of 64 add rog !!This needs a comment--what is it doing? add mone sta xr01 !Last word of last record - odd location ldx four,2 !Initialize table pointers ldx zero,3 ! and other registers lda mone !Initialize table entries sta table lda edfill !Large number sta table+2 edbob:lda xro1 !Begin search for carriage returns add edtwo !which must be in an odd location sta xr01 bxl k3area,1 !Check for no carriage returns at all bru enpr !No-program exit lda 0,1 !Proceed down through program ext edmsk1 cab edcarr bru edbob bru edkar !Carriage return bru edbob edkar:stx edy,1 !Address of CR at end of statement edbla:lda xr01 !Proceed down through program add edtwo !for next carriage return sta xr01 bxl k3area,1 !Has end of program been reached... bru edblax !Yes lda 0,1 ext edmsk1 !Look for CR at end of next previous cab edcarr !statement bru edbla bru edblax bru edbla edblax:stx edt,1 !Address of CR at end previous statement !!Page 49 inx 1,1 lda 0,1 !Is word after CR an end-of-message cab ededof bru edblay bru *+2 bru edblay lda xr01 add edsf !Increase XR-1 to next multiple of 64 ext edmsk2 ! (to beginning of statement following sta xr01 ! end-of-message) edblay:lda xr01 sta table,2 !Address of first word of statement sub edy add mone !Get two's complement of correct length sta table+1,2 !Number of words in statement lda 0,1 !Get first character of line number ext $edig !and check it bze bru edig !Digit lmo sta table+1,2 bru enless !and set as smaller number edig1:mpy ten !Convert digit !!Duplicate code bru echar !and get next edig: sxg 1 !Set index group 1 dld zero !Initialize register and Q xr10 ldx xr10,1 !Set pointer spb echar1,3 !Get character inx 1,0 !Count bxh 6,0 !Test bru edigx !Crump if done cab ten !Check for digit bru edig1 !Yes, convert bru *+1 !No edigx:sxg 0 !Reset index group laq !and get converted line number sta table+2,2 !Statement number in binary cab table+2,3 !Is new statement higher or equal bru enless !Less bru edout !Equal sta edz !Save line number and start adjusting links stx edy,3 !Next lower group in list lda table+3,3 sta xr01 !Next higher group in list edigy:lda edz cab table+2,1 !Does the new statement fit between these !!Page 50 bru edigz !two groups bru edout stx edy,1 !Next lower in list lda table+3,1 sta xr01 bru edigy edigz:lda xr01 !Link new group to higher sta table+3,2 ldx edy,1 !Group just below new one lda xr02 sta table+3,1 !Link lower group to new one bru enlesx enless:lda xr03 sta table+3,2 !Address link of next higher group in list ldx xr02,3 !Change pointer to lowest statement in list enlesx:inx 4,2 !Next entry group in table edout:bxh 1024,2 !256 statements maximum bru edoutx lda edt cab rog !Has end of program been reached bru edoutx bru *+1 ldx edt,1 !CR at end of next statement to bru edkar ! be listed edoutx:ldx xr03,2 !Initialize, begn rewrite lda rog2 sta edt ldx upper8,3 edgurk:lda table,2 bmi !If last group in list, prepare to exit bru edsout sta xr11 lda table+1,2 cab edtwo bru eslec bru *+2 bru edelet !Delete if length is -1 sxg 1 !Set index group 1 spb echar1,3 !and get character cab ten !Is it a digit bru echar !Get next if so bru *+1 !Reset index group sxg 0 ! As here either delete or exit ext o40 ! get rid of bit cab cr ! and check if done with line number bru eslec ! No, do not delete bru edelet !Delete !!Page 51 , Selective LIST feature eslec:lda table+2,2 !Check line number against list parameter cab eselec bru go !If less than selec number, then get out bru *+1 !Check special case of first nubmer lda edt !Location of line # of current statement ext mask7 !Get rid of all but position mod 64, sta mbx3 !then set relative position in record for D-30 lda edt !Get address of line number again ext edmsk2 !and get rid of relative part sub rog2 !Compute how many records from start we are sra 5 add eselec+1 !Add starting address sta eselec+1 !and save to send over to Datanet-30 lda edfill !Take care of special selec case sta eselec !Crump selective LIST go: dld table,2 !Set up move instruction to sto *+2,3 !sequentially position program in new area lda edt mov -- !Dummy move instruction xaq neg add edt sta edt !Compute next area to be filled cab tend !Check for program toolong bru edelet !OK, continue bru *+1 !No, trim it down lda tend1 !Two words bru edsout+1 !and crump edelet:lda table+3,2 sta sr02 !Go to next higher instruction bru edgurk edsout:lda edt !Edsout computes length of program sta xr01 !Filling begins here bxl k2area+1,1 !Also check for no program bru enpr !If none, crump add edsf !Prepare to fill in last buffer load ext edmsk2 !(to next multiple of 64) neg !Construct end-of-fill test sto eds1,3 neg !Re-negate sub rog2 !Compute length sra 5 !for Datanet-30 !!Page 52 sta mbx1 sra 1 !and for TEACH sta ilngth !Save length in pointer dld edeof !Pick EOM and fill dst 0,1 !Put away laq !Double fills eds0: inx 2,1 !Increment pointer eds1: bxh *,1 !Test bru eds2 !If done, crump dst 0,1 !Fill out bru eds0 eds2: lda eselec+1 !Starting disk address sta mbx2 !Give to Datanet-30 lda .kwrt. !Get entry sta iprior,3 !and set in entry for D-30 tasks set prq !and priority request bru wait !and get out , Character picking routine - places one at a , time in the A-register echar:bxl 2,2 !Check if first character coming up bru ech23 ! characters 2 or 3 echar1:ldx zero,2 !Entry point first time - set counter lda 0,1 !Get word inx 1,1 ! and step pointer sta ech3 !Rightmost character sra 6 sta ech2 !Middle character sra 6 !High order echar2:ext mask7 !Extract high-order bits bru 1,3 !and return ech23:lda ech2,2 !Get next character inx 1,2 !Step pointer for characters bru echar2 !and exit enpr: lda npr !No program bru erex !!Error exit stl !KSTART and KCNTNU ejt !!Page 53 9/28/02 , KSTART - message 1 , 1) Read system, if necessary, into 20000 , 2) Start RUN , Normal answers to Datanet-30... , 4 - Request dump , 5 - Terminal exit , 6 - Intermediate output , 7 - Call for input kstart:bss 0 dld zero dst movid !Initialize replacement and overlay indicators lda kmeso !Set dump code for time dump sta mdc lda o140 ;and set dump length to 96 records sta mdl lda smbx2 ;Save disk address sta mkdisk lac ;Get starting time dst sclock ;Set time and flag sta kclock ;Set clock for systems spb syread,2 ;Read in system... spb relin,2 ;and relinquish disk if necessary rin ;Turn off bad lights set pst ;and interrupt mode bru system+1,3 ;and exit (to system) , KCNTNU - message 2 , 1) Read in 6K swap from teletype 6K area. , 2) Read system, if necessary, into 20000. , 3) Begin run where last interrupted , Normal answers to Datanet-30... !!*************************************************** !!JSM: Comment error: the comments below had not been !!updated to reflect a revised program termination !!protocol; I modified them to match the comments !!associate with 'kstart', above, and deleted a blank !!line to keep the line numbering intact. !!*************************************************** , 4 - Request dump , 5 - Terminal exit , 6 - Intermediate output , 7 - Real-time input call kcntnu:bss 0 lac ;Set time for billing dst sclock lda smbx3 ;Get length sto *+2,3 ;and save for read spb dska,2 ;and read in 6K from teletype 6K area z12 96 ;Read, 96 records !!Page 54 dec k6area ;into 4000 - 6K area z20 smbx2 ;Indirect to address bru erxtmm ;Error return spb syread,2 ;Read in system spb relin,2 ;Relinquish disk spb ksuma,2 ;Get elapsed time for 6K swaps lda kmeso ;Set dump code for time dump sta mdc set fixpoint ;For trap work lda 8K ;Set register for trap group sta tx2+1 lda .krst. ;Set for trap sta itrap-1 sta itrap sta itrap+1 set ntpmode ;Set no-trap mode ldx mktrp,1 ;Get condition of trapping group bru *+1,1 ;and go to branch table bru krtrp ;Trapmode set and in trap program bru krtri ;Not in trap program when interrupt occurred , Trap not set so fall through kcrest:spb khold,2 ;Restore hold indicators lda kx0+1 ;Restore index registers maq mov mkx0 sta mkprnt ;and reset output pointer lac ;Adjust clock to give sub clock ;correct starting time to system sta kclock ;(without swap time) dld trapr ;Restore trap contents mov mktrp+1 lda mode ;and restore AAU mode sta *+1,3 set nflpoint ;Dummy... fld mkqx ;Get QX register lqa ,a ;and restore fld mkax ;Restore AX resgister dld mkaq ;Prepare to restore A and Q dst save ldx mksxg,1 ;and restore old index group oct 2526013 ;*** sxg 0,1 *** lda mkov ;Isolate overflow bits ext mask11 add mkp ;and get P-counter location bru irest+1 ;Then exit to system krtri:spb khold,2 ;Trap mode set, but program not in trap when set trpmode ;exit occurred bru kcrest+1 ;and get out !!Page 55 krtrp:set trpmode ;In trap when interrupt occured fdv zero ;Cause trap bru irest ;and exit so trap can take place krst: rin ;Reset indicators - entry is here from self- lda .krex. ;caused trap sta iprior,3 ;so set for later interrupt set prq ;then interrupt this trap krex: spb irase,2 ;After above interrupt, erase entry that bru kcrest ;called here, and go finish process khold:ldx mode+1,1 ;Get type of hold condition to be restored bru *+1,1 bru 1,2 ;None bru kcov ;Overflow hold on bru kcun ;Underflos hold on fdv zero ;Divide check on - recreate it bru 1,2 ;and exit kcov: fld cov1 ;Overflow hold on fad cov1 ;Restore it bru 1,2 ;and exit kcun fld cun1 ;Underflow indicator on fad cun1 ;Restore it bru 1,2 ;and exit stl ;KDUMP ejt !!Page 56 , KDUMP - message 3 , 1) Checks mdc to see what type of dump is , required. If it is a terminal exit it , goes to koutpt. If not, , 2) Saves all program working registers in a , 64-word block at the beginning of the 6K , area. , 3) Checks dump length and dumps the required , number of words. , 4) Puts running time in mbx1. , 5) Intermediate output flag for D-30 in mbx2. , 6) Dump length in mbx3. , 7) Writes billing record , 8) Gives D-30 type of dump in mbx0 , 6 if intermediate output , 7 if real-time input kdump:bss 0 lda mdc ;Check dump code sub six bmi bru koutpt ;Terminal exit only needs 1K dump , Start regular dump procedure dld save ;Save A and Q registers dst mkaq lda preg ;get P-counter sta mkov ext mask10 ;Get rid of high-order bits cab wait1 ;and check where interrupted... sta mkp ;In program bru *+1 ;In executive dld kx0 ;Save index groups 0-4 mov 0 oga ;Get index group sta mksxg ;and save index group with instruction ldx mkprnt,1 ;Store end-of-message lda edeof ;in output area according sta mkpr1,1 ;to program pointer lac ;Compute total adjusted elapsed time dst sclock+2 ;Give ending time and set flag for kdump sub kclock sta clock ;and save maq ;and put total # of seconds dvd six sta mbx1 ;in mailbox 1 for Datanet-30. spb ksumb,2 ;Get time for program run dld traps ;Save contents of trapping mode locations !!Page 57 mov itrap-1 sta xr52 ;and initialize for later test sta movint ;Set flag to indicate interrupt occurred lda .ktrs. ;Branch to check simultaneous interrupts sta tx2 lda .ktrs] ;spb tx2,0 sta itrap+1 ;and set in trapping mode locations sta itrap sta itrap-1 lda 8K ;Set register 3 to 8K bit sta tx2+1 fst mkax ;Save AX register laq ,a ;and move QX to AX fst mkqx ;and save QX lda nfl ;Save AAU mode of operation - assume normalize bar bup,7 ;Check for un-normalized lda unf bar bfx,7 ;Check for fixed point lda fix sta mode ;and save mode of operation ldz ;Save hold indicators - zero if none bar boo,7 ldo ;Overflow hold on bar buo,7 lda two ;Underflow hold on bar bdc,7 lda three ;Divide check on add 8K ;and set upper bit sta mode+1 sxg 5 ;Set index group for executive use set pst ;and exit priority mode bru *+1,3 ;If there was a simultaneous trap, the program spb *+1,2 ;will transfer to ktrs, else will go here lda xr52 ;Check to see if in middle of trap program bnz bru ktrchk ;Not in trap program, go check if trap set , ktex sets a flag for cntnu as follows... , 0 - Program running trap group when dump , command was given, , or trap occurred simultaneously with API , 1 - Not in trap program, but trpmode set , 2 - Trap mode not set ktex: add 8K ;Set upper 8K bit on for branch table sta mktrp ;Set flag - 8K if dropped through rin ;Reset any indicators we may have turned on lda .kset. ;Set entry for later disk work sta iprior,3 !!Page 57 set prq ;Set priority request bru wait ;and go to wait loop ktrs: lda preg ;Simultaneous occurrence of trap and interrupt sta mktx2-1 ;Set trap register 1 appropriately lda tx2-2 ;Get entrance ext mask10 ;Get rid of high order sta mkp ;Set for return ldz ;Set indicator for cntnu bru ktex ;and exit ktri: ldo ;Trap mode set, but not in trap program bru ktex ;exit ktrchk:lda .ktri. ;Test for trapmode set sta itrap+1 ;If set, a branch to ktri will occur, else set fixpoint ;try and insure fdv will work ok fdv zero ;the program will continue lda two ;Trapmode not set bru ktext ;exit , kset sets up the billing for one-shot usage, , and then writes the 6K area onto the disk kset: spb kbill,2 ;Set up to bill lda mdl ;Get dump length sto *+3,3 ;and put in list sta mbx3 ;also send to D-30 spb dska,2 ;Write on disk z37 96 ;Write, 96 records dec k6area ;from 4000 (6K area) z20 mkdisk ;indirect to disk address bru erxtmm ;Error exit bru kexitd ;Dump exit , kexitd picks up the output area pointer and , sends it to the D-30 as an output flag. It , also puts the dump code in A for kexit kexitd:lda mkprnt ;Get output area pointer sta mbx2 ;Send to D-30 lda mdc ;Dump code bru kexit ;and exit stl ;KOUTPT, KDSKRD, KDSKWRT !!Page 59 ejt , KOUTPT - entered through KDUMP , 1) Dump output area onto first 16 records , of teletype standard area , 2) Write terminal billing record , Normal answer... , 5 - terminal exit koutput:lac ;Set total elapsed time for terminal billing sta sclock+2 sub kclock ;Subtract adjusted starting time sta sclock+3 ;Total elapsed time for billing record spb ksumb,2 ;and get program running time spb kbill,2 ;and set up for billing spb dska,2 ;Now write on disk z37 16 ;Write, 16 records dec k6area ;from 4000 (also output area) z20 mkdisk ;indirect to address bru erxtmm ;Error exit bru kexitd ;Dump exit , KDSKRD - message 4 , 1) Read variable-length source program from , specified address into lower (2K) area. , 2) Place 2*length in mbx1 , Normal answer... , 2 - read completed kdskrd:spb lwread,2 ;Read into lower area lda ilngth ;Get length sla 1 ;and multiply by two sta mbx1 ;and set in mailbox 1 bru kexitr ;Done , KDSKWR - message 5 , Write variable-length source program onto , specified address from lower (2K) area , Normal answer... , 3 - write completed kdskwr:spb lwwrit,2 ;Write from lower bru kexitw ;and terminate !!Page 60 stl ;KTEACH ejt !!Page 61 , KTEACH - message 6 , 1) Read in testing program from address , specified , 2) Read system, if necessary, into 20000 , 3) Start run , Normal answers...same as for START kteach:lda ilngth ;Get end of tested program, and compute sla 6 ;where testing program is to go add k2loc ;Step past 6000 sta ktea2+2,3 ;and set memory address in parameter list lda smbx5 ;Get length of testing program sub smbx4 sra 1 ;Correct to number of 64-word records sto ktea2+1,3 ;and set in parameter list add ilngth ;Get combined length for teach add sign ;Set flag for teach sta mksxg ktea2:spb dska,2 ;and pull in program z12 -- ;read, constructed length (variable) dec 0 ;constructed address (memory) z20 smbx4 ;indirect to disk address bru erxtmm ;Error exit bru kstart ;and pull in system , KTBRUN - message 10 , 1) Run teletype batch , Normal answer ... 0 ktbrun:bru * stl ;Normal and error exits ejt !!Page 62 9/29/02 , Both exists relinquish the disk and send , a completion message to the Datanet-30, as , follows... , 1 - error message, sent through erxtmm , 2 - read completed, sent through kexitr , 3 - write completed, sent through kexitw erxtmm:spb irec,2 ;Dump debugging locations on tape lda tmm ;Temporary malfunction message erex: sta mbx1 lda kermes ;Error message bru kexit ;and send kexitr:lda kmes2 ;Message 2 bru kexit kexitw:lda kmes3 ;Message 3 kexit:sta kanswr ;and save spb relin,2 ;Relinquish disk spb ksuma,2 ;and get routine elapsed time lda mbx0 ;Try not to wipe out D-30 message bpl lda kanswr ;OK, send it cbugb:sta mbx0 ;None, so send answer over cab kermes ;Check if error exit bru iplst ;No bru wait ;Yes, special exit bru iplst ;No, continue normal running , Elapsed time calculating routines ksuma:ldx smbx0,1 ;Get elapsed time for called routine lac sub isum ;Subtract starting time add fkedit,1 ;and step particular counter sta fkedit,1 bru 1,2 ;and return ksumb:lac ;Get elapsed time for program runs sub sclock ;Starting time set by Continue and Start add fkstrt ;Step running time counter sta fkstrt bru 1,2 ;and return !!Page 63 , Users will be billed according to the , amount of central processor time they , use. , The time portion of the billing record , is broken up as follows... , 1) sclock Starting time for a run , 2) sclock+1 Flag, set as follows... , 0 for a first run , non-zero otherwise , 3) sclock+2 Ending time for a run , 4) sclock+3 Flag, set as follows... , Elapsed time if terminal run , Negative number if 6K dump kbill:lda swflg ;Check for stacked-up bills bod bru 1,2 ;Yes, crump this one ldo ;Set flag on sto swflg dld .kbil. ;Set entry to bill this particular clunk bru insert ;and return kbil: bcs btn,1 ;Check if tape ready bru 2,1 ;Crump if not ldz ;Set batch tape error flag sto swflg ;Reset flag spb irase,2 ;Erase entry kbdfg:nop ;Branch to tape op overlay if in sel 1 ;and write billing record wtb smbx1,0 %24 ;Short record nop bru iplst ;and go to API list stl ;UPREAD, LWREAD, LWWRIT ttl ;Utility routines for source input/output !!Page 64 , Upread reads a source program from the , teletype standard area into upper (3k) area , of core memory. upread:lda k3loc ;Get memory address for 3K area bru kreada ;and go read , lwread reads a source program from the , teletype standard area into lower (2K) area , of core memory. lwread:lda k2loc ;Get memory address for 2K area kreada:sta kreadb+2,3 ;Set in parameter list stx kret,2 ;and save return location lda smbx3 ;Ending disk address sub smbx2 ;Subtract starting disk address sra 1 ;and correct to number of 64-word records sta ilngth ;and save in program length indicator sta mksxg ;Make positive for TEACH sto *+2,3 ;and set in parameter list kreadb:spb dska,2 ;Go read z12 -- ;Read, constructed length z00 -- ;Constructed memory address z20 smbx2 ;Points to disk address bru erxtmm ;Error return kreta:ldx kret,2 ;Return point bru 1,2 ;and get out , lwwrit writes a source program from the , lower (2K) area of memory onto the teletype , standard area lwwrit:stx kret,2 ;Save return location lda ilngth ;Get program length sto *+2,3 spb dska,2 ;Write z37 -- ;write, constructed length dec k2area ;from lower area z20 smbx2 ;address in mailbox 2 bru erxtmm ;Error return bru kreta ;Get back stl ;SYREAD !!Page 65 ttl ;System intput/output routines , Each time-sharing compatible system or , system overlay must carry certain information , for the executive at its head. The format , is rigid and must be exactly followed by , overlays, replacements, and systems. , Word No. Function , 0] System exit location - exit branch , supplied by executive when systems are , brought into memory. , 1] Entry point - executive transfers here to , begin running a problem. , 2] Transfer to cleanup routine for systems , that use disk - this is so that when a , user types *STOP* his disk space is , returned to the available space list. , 3] Spare , 4] Alfameric system name - first 3 letters. , 5] Number of replacement of overlay - 0 for , systems. In the case of an *OVERLAY*, , bit 1 is set on if the overlay , destroys the system or replacement that , called it. , 6] Move constant - 0 if no move - tells , executive to move to here... , 7] this many words (in two's complement form) , 8] from here. , syread checks to see if the called system , is in memory. If not, it searches for its , address in a table, then reads in the system , into core memory address 20000. syread:stx kret,2 ;Save entry point dld movid ;Put replacement number in Q lda smbx1 ;System wanted dcb in ;Check to see if in memory bru *+2 ;No bru syovk ;Check if correct overlay in memory ldx zero,2 ;Initialize counter/pointer !!Page 66 sysrch:cab sytab,2 ;Seatch system table bru *+2 bru syfind ;Found inx 1,2 ;Count bxl last,2 ;and check for end of table bru sysrch ;No, try again bru rsnot ;System not in table syfind:lda z2 ;Save table pointer (for overlay calls) lda inpnt add morep ;Step by replacement number sta z2 ;and set to get system disk address lda sytab+1,2 ;Address sta *+4,3 ;Set in parameter list spb dska,2 ;and go read z12 96 ;Read, 96 records dec system ;into 20000 z00 -- ;address, constructed bru erxtmm ;Error return ldx syloc,1 ;Read-in location spb symov,2 ;Move constants down and set up identifiers , If system was read, overlays must be read in lda movid bze bru *+2 ;No overlay bry syova ;Get overlay sta inov ;Set flag to zero bru kreta ;and get out syovk:lda movid ;Get overlay number requested bze ;Check for no overlay sta inov ;If so, then reset overlay indicator cab inov ;Check for correct overlay bru syova ;No, go read in overlay bru kreta ;Yes, get out bru syova ;Else go get overlay rxnot:lda usn ;System cannot be found or read in bru erex stl ;syov ejt !!Page 67 , Overlay read-in routine. Entered from syread , or from ovcall, reads in overlay to , specified location, then returns according to , which routine called it, back to program if , called from ovcall - else back to original , caller- kstart or kcntnu. syov: spb irase,2 ;Erase entry that called spb dskb,2 ;Request disk from Datanet-30 ldz ;Overlay is special, so special measures sta dkflg2 ;must be taken - reset disk flag 2 lda movint ;and check interrupt flag bze ;If zero, then interrupted bru 2,1 ;So ignore the rest of this lda movid ;Overlay identifying number syova:add inpnt ;inpnt points to master system address sta z2 ;Location of overlay address lda sytab+1,2 ;Get it sta syovb+3,3 ;set address in parameter list lda molen ;Length of overlay sto syovb+1,3 ;set in parameter list lda momem ;Memory address of where it goes sta syovb+2,3 ;set in parameter list syovb:spb dska,2 ;Get overlay z12 -- ;read, constructed length z00 -- ;memory address z00 -- ;disk address - constructed bru erxtmm ;No go ldx momem,1 ;Get read-in address lda morep ;and set up replacement number of current sto 5,1 ;System lda movid ;Set overlay number in indicator sta inov spb symov,2 ;and go move constants and set up identifiers lda movint ;Check if dump 6 occurred while reading bze ;in overlay bru kreta ;Yes, go back to caller spb relin,2 ;Let's not relinquish twice bru sret ;No, go back to system symov:lda sexit1 ;Set exit location sta 0,1 ;and set in first word of system/overlay dld 4,1 ;Check if correct system... !!Page 68 cab smbx1 ;brought in bru rsnot ;No bru *+2 bru rsnot ;No dst in ;Yes, set in indicator which gives system and lda 8,1 ;overlay #. Construct system constant move add smove1 sta symov1,3 dld 6,1 ;Where and how may words cab mendt ;Check for no move bru 1,2 ;If no move, exit bru *+1 ;Yes symov1:mov -- ;Move constants where requested bru 1,2 ;and exit stl ;Disk request ttl ;Disk read/write routines !!Page 69 , DSKR is entered on xreg 2 by non-D-30 tasks. , It checks both dkflg1 and dkflg2 for non-zero. , It also steps dreqf on entry, an decrements , it on exit. This is so that the relinquish , routine will not needlessly give back the , disk to the Datanet-30. When both dkflg1 and , dkflg2 have gone zero, it asks the Datanet-30 , for the disk. dskb: lda z2 ;Get return point maq ;and save in entry lda .dskc. ;Set up entry to check spb insert,2 ;for other disk usage. sta z1 ;Save where inserted for returns dskc: lda dkflg1 ;Check disk flags. If either non-zero, then bze ;some task is waiting for or using the disk bru dskc1 lda dstakf ;Wait for special requests to terminate bze ;before granting access to Datanet-30-called bru 2,1 ;tasks. So wait on D-30 if non special. dskc1:lda dkflg2 ;Time-sharing task using the disk or no bnz ;D-30 task waiting. bru 2,1 ;Some other routine using disk, so punt lda pmbx0 ;Wait for message switching to go normal bpl bru 2,1 ;If plus, the message waiting to be answered sta dkflg2 ;All OK, so set disk flag 2 non-zero lac ;Set timing interval to 1 second plus add seven sta hdskd lda .dskd. ;Get entry to wait for D-30 answer sta 0,1 !!I believe this entry overwrites the call to dskc lda hdreq ;Ask for disk sta pmbx0 dskd: bcs brr,0 ;If the disk is ready bru dskg ;then get out lda pmbx0 ;Else check if D-30 bmi bru 2,1 ;has answered, and if so, wait on lac ;Else check timing interval cab hdskd bru 2,1 ;Still OK bru 2,1 ;Ditto add cr ;Reset time check sta hdskd dsko: spb messg,2 ;and type message to clear disk dec dc ;Disk controller !!Page 70 bru 2,1 ;and exit dskg: lda 1,1 ;Disk ready, so get return sta z2 bru irase ;Erase entry and return to caller , DSKA is entered by D-30-called routines. , It sets dkflg1 to +1, then waits for dkflg2 , to be reset. When other tasks have finished , with the disk, it sets dkflg1 negative to , indicate the disk is being used. , Entry is on xreg 2 with the disk parameters , immediately following th calling sequence - , see dskop for an explanation of the parameter , setup. dska: lda z2 ;Get return point sta dkflg1 ;and set disk flag 1 positive to indicate wait maq ;Save return lda .dskx. ;Set entry for continuation dst iprior,3 ;and set in priority entry ldx kfudge,1 ;and get where entry is by fudge factor dskx: lda dskflg2 ;Wait for disk flag 2 to go zero bnz bru 2,1 ;No, exit lda dstakf ;Check special requests stack flag bnz ;and punt it they are not done bru 2,1 ;dskb will continue to give them the disk ldx dkflg1,2 ;Now get flag - is also calling point here lmo ;Set disk 1 negative to indicate sta dkflg1 ;actual use lda .disk. ;Set entry for disk routine sta 0,1 bru dskh ;and go to special entry point stl ;DSKOP ejt !!Page 71 , DSKOP may be entered directly or through dskh , The calling sequence follows the spb on xreg2 , and is given below... , A spb x, 2 , A+1 1) No. of 64-word records in bits 5-19 , 2) Type of instruction in bits 2-4... , 12 indicates a read. , 37 indicates a write. , A+2 Starting memory address - mod 64 , A+3 If negative, indirect pointer to disk , address. If positive, address itself. , A+4 Error return - nature of error in high , order bits. , Bit 4 - illegal address , Bit 3 - not used as yet. , A+5 Normal return. Any non-terminal error , conditions are reflected in bits 0-4 , as follows... , Bit 2 - unused as yet , Bit 1 - recovered parity error , Bit 0 - unrecovered parity error. , Dskop uses 96-record-read and will give , illegal address indication if more than , 92 records are asked for. dksop:stx .disk.+1,2 ;Get return point dld .disk. ;and get entry spb insert,2 sta z1 ;save for returns ldx .disk.+1,2 ;Get entry point again dskh: ldz sta dcnt ;Reset length counter sta drcnt ;Error count lda 1,2 sto dnct ;Length of operation ext mask11 ;Get high order bits for type add dinst ;Construct instruction sta doper+1,3 lda 2,2 ;Memory address sta iadrs+1 lda 3,2 ;Pick up disk address sta z2 bmi ;Indirect if minus lda 0,2 !!Page 72 sta iadrs ext mask1 ;Check if legal sub o300 ;If over 300 with other bits gone then bpl ;illegal bru dker ;yes lda iadrs ;Get address back sta dseek+2,3 ;put away in case legal ado ;Set bit 19 for relinquish sta relad,3 lac add o40 ;Set timing interval sta dival disk: spb dskwt,2 ;Wait for disk lda .dsec. sta 0,1 dseek:sel 0 ;Seek command prf ,0 oct 0 ;Disk address - constructed lda dcnt ;Compute 96-record bit setting sta z0 ;See if over 96 records bxh 97,0 bru dker ;Should not happen srd 4 xaq ;Remainder mod 16 in A sra 15 ;Position remainder bze dad d15 ;15, -1 ory doper+1,3 ;Put away lda iadrs+1 ;Get memory address ext mask10 ;3700000 make sure not to wipe high order bit sta doper+2,3 ldz ;Set bits 2-4 scd 4 ory doper+2,3 doper:sel 0 ;Read/write z00 -- ;Constructed (instruction, length?) z00 -- ;Constructed (memory address?) bru 2,1 dsec: spb dskwt,2 ;Wait bcs ber,0 ;Check for errors bru dcorr ;Try to correct dexit:lda 1,1 ;Get return point add four ;and step for correct return sta z2 bru irase ;and exit back to caller dskwt:bcs brr,0 ;Is disk ready... !!Page 73 bru 1,2 ;yes, exit back to caller lac ;Check interval cab dival bru 2,1 ;Still OK, go back to task list bru 2,1 ;ditto add cr ;Set interval large enough to give sta dival ;message time to get out oct 2516036 ;Check for lockout bit set bru dsko ;No, so type message to clear spb messg,2 ;Yes, type reminder on typewriter dec datnet lda hdreq ;Ask D-30 for disk - shouldn;t have to spb spmess,2 bru 2,1 ;and return , Error correction routine - will try , five times and then consider the frame as , correctly transferred. Any error is noted , by setting bit 1 on in the return address. , If an error persisted the record was rewritten , on the disk and bit 0 is set. dcorr:ldx drcnt,0 ;Error counter inx 1,0 bxh 6,0 ;Tried five times bru dnorec ;No recovery stx drcnt,0 lda bit1 ;Set bit 1 on in return address ory 1,1 ;to signify parity error of some sort bru dseek dnorec:lda sign ;Set bit 0 on in return address ory 1,1 bpe ;Clear out any parity indicator nop ldx iadrs+1,2 ;Get read-in address bru *+2 dnore1:inx 2,2 dld 0,2 ;and find where parity error was dst 0,2 bxl 2,2 ;Do not go too far bru * ;Parity on disk yet none in memory bpc bru dnore1 ;Try again lda z2 ;Get address of error ext mask8 ;77 make a multiple of 64 words sta dcorra,3 ;Put address in write command sub iadrs+1 sra 5 ;Compute new disk address !!Page 74 add dseek+2,3 sta dcorrp,3 sel 0 prf ,0 ;Position to write back bad record dcorrp:oct 0 ;Disk address bcs brn,0 ;Wait till ready bru *-1 sel 0 wrf 1,0 ;Write record back on dcorra: &0 ;Address in memory lda dcorrp,3 ;Get exact disk address spb adrser+1,2 ;and output it dec dp lda .disk. ;Set up task for disk sta 0,1 bru 2,1 ;and get out dker: spb adrser,2 ;Illegal address message decl ilg lda 1,1 ;Get return address add bit4 ;Set bit 4 on add three ;and return to error return bru dexit+2 ;Get out adrser:lda iadrs ;Get address stx rawt,2 ;Save entry point spb convrt,2 ;and convert address sta adr1 ;and set in message laq sta adr1+1 spb messg,2 ;Type message dec adrs ldx rawt,2 ;Get entry again bru messg ;and type kind of address error stl ;Relinquish ejt !!Page 75 , RELIN relinquishes the disk to the Datanet-30. , If no task has used the disk, then the relin- , quish is vacuous; if any task is waiting for , the disk, then the relinquish is punted. relin:set prq ;Request interrupt after completion dld zero ;Check out status of flags cab dstakf ;See if more tasks waiting bru relex ;yes bru *+1 cab dkflg1 ;Against disk flag 1 bru relex ;waiting bru *+2 ;Not used by D-30-called tasks bru relq ;Definitely used cab dkflg2 ;Against regular task flag bru relq ;Used bru relmes ;no, so send message only relq: dst dkflg1 ;Reset flags bcs brn,0 bru *-1 ;It shouldn't happen, but just in case sel 0 ;and relinquish prf ,0 ;Disk had better be ready relad:oct 403 ;Set up by dskop - 403 if for after boot. bcs brn,0 ;Wait here bru *-1 ;for disk sel 0 ;and read after write next sector 0 records oct 1213040 ;with power dropped and API set oct 0 relmes:lda two ;Tell D-30 it has disk sta pmbx0 bru 1,2 ;and return relex:sta dkflg2 ;Reset disk flag 2 bru 1,2 ;and get out stl ;Peripheral overlay read ejt !!Pge 76 , The peripheral overlay calling routine is , entered from the table of typewriter-entered , tasks, to perget. It is also entered to , pgetb, byt other peripheral tasks, to chain , several in sequence. When entry is through , perget, the routine checks to see if any , other peripheral tasks are currently in , memory...if so, it punts and types 'busy', , else it calls in the overlay from the disk , address given in the word after the calling , location. , It also saves the overlay called, so that if , the same peripheral task is called twice in , a row, it does not read it in the second time. perget:lda bzyf ;Check busy flag - if on bnz ;then not zero, bru ibusy ;so punt. pgetb:lda z2 ;Get caller sta bzyf ;and set flag to busy status cab perin ;and check if already in memory... bru *+2 ;No bru execov ;Yes, go execute sta perin ;Else set in indicator lda 2,2 ;and get disk address sta pgetx,3 ;and set in parameter list spb dskb,2 ;Get disk from Datanet-30 spb dskop,2 ;and go read in overlay z12 8 ;Read eight records dec execov ;Memory location pgetx:z00 -- ;Disk address dec -1 ;Should never ever return here..... spb relin,2 ;Relinquish disk to Datanet-30 bru execov ;and go execute stl ;System-called routines ejt !!Page 77 , DRAMB is entered on xreg 2 by background , systems that require disk usage. , DRAMA is entered on xreg 1 by time-sharing , systems that request the disk. , The calling sequence is... , A spb dramb,2 , A+1 Indirect pointer to a parameter list - , see later for an explanation. , A+2 Return point. The return is executed , immediately, and the completion of the , operation is signalled by setting a , flag in the parameter list. , The parameter list is a four-word table, set , up as follows... , P 1) No of 64-word records in bits 5-19, , 2) Type of operation in bits 2-4... , 12 - indicates a read , 37 - indicates a wite , P+1 Starting memory address - mod 64 , P+2 Disk address for read or write, , sign bit set if scratch area is to be , supplied to a system by the executive. , In this case, each system has 48 , 64-word records available, and the low , order end of the parameter word must , specify what particular record is to , be accessed. , Note...the particular address used , will be stored in P+2 by the executive , but most users will want to ignore , this. , P+3 Flag to indicate completion of , operation. Upon completion of , the operation, it will be set odd if , the operation was successful, even , otherwise. In either case, certain , conditions will be indicated in the , high order bits... , Bit 4 - illegal address (error) , Bit 3 - too many requests stacked , up (error) , Bit 2 - not used at present , Bit 1 - parity (recovered, no error) , Bit 0 - parity (unrecovered, but , transfer complete, so no , error indication given) !!Page 78 9/30/02 , A maximum of four , simultaneous calls are allowed. There , must be as many parameter lists as there may , be simultaneous calls, and the user should , not modify the parameter list for a given , call until that disk operation has been , completed. drama:ldx mkp,2 ;Get entry point bru *+2 dramb:inx 1,2 ;Step for return in any event lda 0,2 ;Points to *P* sta .drmc.+1 ;save ldx .drmc+1,1 ;Set in register ldx dstakf,0 ;Get stackup flag bxh 4,0 ;If four stacked up, crump bru dsful inx 1,0 ;Else step by one stx dstakf,0 ;and save ldz ;and zero out return word sta 3,1 ;*P+3* dld .drmc. ;Get list entry bru insert ;and go insert in task list drmc: ldx dstakp,2 ;Points to dstak-4 inx 3,2 ;Step to next entry lda 3,2 ;and get second word - check if entry free bnz ;non-zero in use bru *-3 ;so try again - we know there is at least 1 lda 1,1 ;Get pointer to *P* sta 3,2 ;and set in stack bru irase ;then erase current entry , The following entries go in groups of , four. They are all identical dstak:spb dskb,2 ;Now wait for disk spb drms,2 ;then use z00 -- ;Pointer to *P* goes here spb dskb,2 ;Group 2 spb drms,2 z00 -- spb dskb,2 ;Group 3 !!Page 79 spb drms,2 z00 -- spb dskb,2 ;Group 4 - last entry spb drms,2 z00 -- drms: stx temp,1 ;Save place in task list lda 1,2 ;Points to *P* sta z1 ;set for indirect #1 add stwo ;Points to *P+2* sta drmd+3,3 ;set in parameter list lda 0,1 ;Get instruction type and length sta drmd+1,3 ;and set in parameter list lda 1,1 ;Get memory address sta drmd+2,3 ;set in parameter list ldz ;Reset waiting list sta 1,2 lda 2,1 ;Get disk address bpl ;Check if real address bru drmd ;Yes, skip all this ext mask4 ;Get rid of all high order bits and start to lqa ;computer scratch address add drmd+1,3 ;Add record count to starting scratch address ext mask4 ;Wipe out high order bits sta z0 bxh 49,0 ;See if too many [records] bru dnovl ;Yes, error return xaq ;Get number [of records] back sla 1 ;Position correctly add mkdisk ;add teletype address add o440 ;step 400 to get scratch area sta 2,1 ;and put away drmd: spb dskop,2 ;Read/write on disk z00 -- ;Type and length z00 -- ;Starting memory address z00 -- ;Pointer to disk address in parameter list nop ;Ignore errors - sort of stx temp,1 ;and save place in list drme: lda drmd+3,3 ;Points to *P+2* sta z1 lda z2 ;Get spb to dskop - has error info in high ext mask11 ;order bits. Isolate these bze ;check for no errors ldo ;If none, set completion indicator odd sta 1,1 ;and set in word four of parameter list lda dstakf ;Release stackup flag one notch sbo !!Page 80 sta dstakf ldx temp,2 ;Get place in task list bru relin ;and relinquish disk dnovl:ldx bit4,2 ;Set illegal address bit on bru drme ;and return dsful:lda bit3 ;Special bits for stacker full error sta 3,1 ;and set in *P+3* bru 1,2 ;Return to caller stl ttl ;System exits !!Page 81 , All exits are entered by an spb 20000 (octal) , on index register 1, with an appropriate , constant in the A-register. , The constants and their corresponding , exits are as follows... , 0 - Terminal exit. , 1 - Intermediate output exit. , 2 - Input call exit. , 3 - Overlay call temporary exit. , 4 - Overlay delete call , 5 - Disk operations call !!JSM edited for clarity and correctness 9/30/02 , 6 - Special data transfer to the D-30, , using the special mailbox. , 7 - Special data transfer to the D-30, , using the regular mailbox. , The calling sequence for these is , A spb 20000 (octal) , A+1 data word 1 , A+2 data word 2 , A+3 return , Data words 1 and 2 will be sent to the D-30 , Data word 1 has special transfer code... , 12 - send ending disk address , 8 - Change dump length. Q has the ending dump , address, which must be rounded to the , the next higher multiple of 64. !!End JSM edits , When the sytems request a terminal exit, , intermediate output, or real-time input, the , executive will request a dump from the D-30 , after saving the type of exit. sysex:set pbk ;No interrupts while setting up exits inx 1,1 ;Save return location incremented by one stx mkp,1 !!The comparison below needs to have a symbolically defined !!upper bound based on the length of the branch table cab ten ;Dec 10 to see if legal call bru sysx1 ;Yes [length < 10] bru sret ;No, so return bru sret sysx1:sto sexit2 ;Set up for branch ldx sexit2,1 bru sysx2,1 ;and branch to start of list sysx2:bru term ;0 - Terminal exit bru otex ;1 - Intermediate output exit bru inex ;2 - Input call exit bru ovcall ;3 - Overlay call bru ovdel ;4 - Overlay delete bru drama ;5 - Disk operation bru sptra ;6 - Special transfer bru sret ;7 - Not used yet so just return bru sydlc ;8 - Change dump length !!Page 82 sret: ldx mkp,1 ;Return set pst bru 0,1 !! The code below has two bugs: !! (1) the message from the system can usurp !! executive functions with codes < 10 !! (2) because the message is stored before !! the parameter, there is a potential !! race condition, by which the D-30 !! can pick up the message before the !! parameter has been stored. sptra:ldx mkp,1 ;Get entrance location lda pmbx0 ;Wait for special mailbox bpl ;to go minus bru *-2 ;better not take too long lda 0,1 ;Data word 1 cab ten ;See if legal bru sptrx ;No bru *+1 ;Yes sta pmbx0 lda 1,1 ;Data word 2 sta pmbx0+1 ;in special mailbox+1 lda pmbx0 ;Wait for acknowledgment bpl bru *-2 sptrx:inx 2,1 ;Set for return bru sret+1 ;and enter return waitex:lda mbx0 ;Do not wipe out D-30 message bpl ;If none, go on lda kmesd ;Request dump sta mbx0 ;Answer Datanet-30 set pst ;Hang up waiting for interrupts so as not bru *-1 ; to destroy any index registers term: lda kmest ;Terminal exit sta mdc ;put in dump code bru waitex ;and exit otex: lda kmeso ;Intermediate output message sta mdc ;put in dump code bru waitex ;and exit inex: lda kmesi ;Real-time input call sta mdc ;put in dump code bru waitex ;and exit , Change dump length. Q has ending memory address sydlc:xaq ;Get address in A sub k6loc ;subtract starting address sra 6 ;divide by 64 to get record count cab o140 ;See if legal length [<= 96] bru *+3 ;yes bru *+2 bru sret ;No, so just return sta mdl ;Store in length !!Page 83 bru sret ;and return stl ;Overlay call ejt !!Page 84 , The overlay call is a special system feature. , It is treated as a special system exit. , An overlay call may be used to supplement or , replace part or all of a system. If a system , is replaced by an overlay (this is indicated , in the calling sequence), only the replacing , overlay will be called back in after swaps. , Furthermore, system replacements may have , their own overlays. , If a called-for overlay is already in memory , the information will be placed in the save , area, and the overlay will not be read in. , Two conventions must be rididly adhered to: , 1) All systems, overlays, and replacements , must have the same heading information , in the same format. (See SYREAD) , 2) The numbering system for overlays, , replacements, and systems, must be unique. , That is, if overlays, replacements, and , systems are considered as integral units , of core memory, then each of , these units must have a unique identiying , number in the word after the system name. , The calling sequence is as follows... , A spb 8192, 1 with a 3 in the A-register , A+1 Replacement # of current unit in , memory, unless a new replacement is , being called, in which case this , should have the number of the new , replacement. This is the only case , in which overlay and replacement , numbers may match up in the calling , sequence - see next item. , A+2 Number of overlay being called. If the , overlay destroys [??] the system currently , in memory, then this word should , have the sign bit on. This is so that , if a dump occurs while the overlay is , being brought in, the executive will , not needlessly read in the system , again for a new problem. , A+3 Length of overlay. It will be truncated. , So if length is not an exact multiple , of 64 words, it should be extended at , least as far as the next 64-word multiple !!Page 85 , A+4 Memory address where the overlay , is desired - must be a multiple of , 64 words. , A+5 Return address. ovcall:ldx mkp,1 ;Entry location, stepped by one lda 0,1 ;[A+1] Replacement number sta morep ;and save lda 1,1 ;[A+2] Overlay number bmi ;Check if destroys system sta in ;yes sto movid ;and set in save location lda 2,1 ;[A+3] Get length mod 64 sra 6 sta molen ;and save in length indicator lda 3,1 ;[A+4] Get memory address and extract ext edmsk2 ;low-order end sta momem ;memory location inx 4,1 ;[A+5] Step return address stx mkp,1 ;and save lda movid ;See if overlay called is already in memory sub inov bze bru sret ;yes stx movint,1 ;Set flag for interrupts ldx 8K,1 ;Do not destroy system's index registers lda .syov. ;Set entry to read in overlay sta iprior,1 ;Special treatment sta inov ;Destroy overlay indicator set prq ;Priority request set pst ;and wait for process to finish bru *-1 , Overlay delete call deletes unneeded overlays. , Return is to the first word after the spb. ovdel:ldz ;Reset indicator to show no overlay sta movid bru sret ;and get back stl ;MESSG - type routine ttl ;Odds and ends !!Page 86 messg:ldx stack,0 ;Check stack bxh 4,0 bru 2,2 ;If three stacked up, crump inx 1,0 ;Bump up stack stx stack,0 ;and save lda 1,2 ;Get pointer for message maq lda .pms1. ;Initial entry inx 1,2 ;Step for return ton ;Set for output bru insert pms1: ldx typf,2 ;Check output flag bxh 1,2 ;If non-zero, then on bru 2,1 ;so try again later. lda 1,1 ;Address of message sta pcnt+1 ;and set in save location dld .pty. ;Get entry dst 0,1 ;and replace old stx typf,1 ;Set flag on and save pointer pmore:inx 12,2 ;Set for first character stx pcnt,2 ;and save ldx pcnt+1,2 ;Word pointer lda 0,2 ;Get next word sta ptemp ;and save it inx 1,2 ;Step pointer stx pcnt+1,2 ;and save it bru 0,1 ;Then exit pty: ldx typf,1 ;Get branch word ldx pcnt,2 ;and get word pointer lda ptemp ;Get word sra 0,2 ;and shift for character [12, 6, 0] ext mask7 ;Get rid of high-order bits cab peom ;and check for end-of-message bru *+2 ;if not, OK bru pdend ;else crump san 6 ;Put character into N-register typ ;and output it bxl 1,2 ;Check for new word needed bru pmore ;if so, get it inx -6,2 ;Else set for next character stx pcnt,2 ;and save bru 0,1 ;Exit pdend:lda stack ;Decrement stack counter sbo sta stack bze ;Do not reset unless stack at zero kon stx z2,1 ;Set for 'irase' exit !!Page 87 ldz ;and reset flag sta typf bru irase ;and exit stl ;IREC, SPMESS, EFFY, CONVRT, TIME ejt !!Page 88 , Debugging tape dump. Writes lower memory , from 0 to 'sclock'+3 - see how long tape , takes to come ready by saving counts in dump irec: lac add three ;Wait two counts of clock sta temp irecs:lac ;Now check sub temp bpl ;If time up, exit bru 1,2 bcs rtn,1 ;Else check tape bru irecx sel 1 ;and write lots of stuff wtb 0,0 %sclock+3 bru 1,2 ;and get out , This routine waists for the Datanet-30 to , answer all previous messages and then , exits. spmess:bss 0 lqa ;Save message in Q lda pmbx0 ;and wait for any other messages to be bpl ;acknowledged bru *-2 ;Hope we don't hang too long laq ;Get message sta pmbx0 ;and set in special mailbox spmesx:lda pmbx0 ;and wait for this message to be answered bmi ;If negative, we are OK bru 1,2 ;so get back bru spmesx ;else wait for answer , EFFY is set up by the wait loop every 10 , minutes. It waits for all peripheral , activity to cease, then calls in an overlay , which dumpes the efficiency summary info , onto the disk. effy: lda bzyf ;Wait for peripheral tasks to be completed add stack ;and wait for all typing to stop bnz bru 2,1 spb irase,2 ;Erase entry !!Page 89 ldx zero,2 ;and get summary overlay inx summry,2 bru pgetr , Conversion routine convrt:ext mask6 ;Mask out sign bits srd 15 ;Put most in Q sla 3 ;Begin spacing with zeros sld 3 sla 3 sld 3 sta mstemp ldz sld 3 sla 3 sld 3 sla 3 sld 3 lqa lda mstemp bru 1,2 ;Return , TIME - entered on xreg 2 , uses temp and mstemp time: lac add h2 ;Add 1 minute sta itim ;Save incremented time sub o400 ;Make it reasonable maq dvd h1 ;Get hours dst mstemp maq ;[Move hours to Q] dvd ten ;Convert to decimal bze ;Delete leading zeros lda o60 ;[If zero, get a blank] sla 6 ;[Move char left one char position] sta temp laq ;[Or in the second character] ory temp ;[temp now has the hours] dld mstemp ;[Get fractional hours in Q] lda zero dvd h2 ;Get minutes maq ;[Move minutes to Q] dvd ten sla 6 ;[Tens of minutes in mstemp] dst mstemp ;[minutes < 10 in mstemp+1] !!Page 90 add mstemp+1 ;[Complete minutes in A] add colon maq ;[Leading colon, minutes in Q] lda temp ;[Hours in A] add blzz ;Leading blank bru 1,2 ;Return loc 37000 ;Overlays go here execov:bss 1 ;Normal peripheral entry point bss 1 ;System entry to peripherals bres: bss 1 ;Restart entry to peripherals kbrun:bss 1 ;Permission to run entry for batch processing bss 508 ;Save some space tcd load stl ;Lister ttl ;Peripheral overlays !!Page 91 , Time-sharing lister. Will list a deck of , decimal cards, converting parentheses and , other characters for printer compatibility. , This lister is buffered and requires that the , first card be in the hopper before starting. , The deck must be followed by two blank cards. , Error messages are printed on the console , typewriter. , At any time, depressing switch zero will , cause all activity to halt. , For the 235, as follows... , C/P followed by a carriage return will , produce a single-spaced, untranslated , listing. All other options must follow , the following code... , S Single spacing , D Double spacing , N Not translated , T Translated for printer compatibility , C/P must be followed by two letters if an , alternative option is selected, , as in C/PST followed by a CR. , After an error, depressing switch 2 will , cause the listing to take up where it , left off. org pernum dec 0 dec c/p org execov dld .lst.,3 ;Get entry spb insert,2 ;and insert in list sta ovtsk bcs bpr,6 bru lst1 spb messg,2 dec pnr ;Printer not ready bru lndra lst1: bcr bru L235 spb messg,2 ;Card reader not ready dec crn bru lndra L235: ldz sta lf lmo sta llnt1 !!Page 92 sta llsd1 spb lchar,1 ;Get next character from ty+1 cab cr ;Check if carriage return bru *+2 bru lsn ;Go check all correct bxh 3,2 ;If not CR, and LF gte 3, then error bru lerr1 ldx 8K,2 ;Initialize looping variable lst2: cab ltab,2 bru *+2 bru ltab+1,2 ;Go to indicated task inx 2,2 ;Increment bxl 8,2 ;Test for end bru lst2 lerr1:bru ild ;Illegal task lsn: lda lf ;Check indicator cab two bru lsn1 ;Single spaced and untranslated bru lerr1 ;lf equals 2, second char a CR, error bru lista ;done oct 624537 ;S N CR lsn1: lda *-1,3 ;Easiest way to get N and S sta ty+1 bru L235 lchar:ldx lf,2 ;Character picking up routine - easily bxh 1,2 ;modified to other uses... bru lchar1 ;If greater than zero, then not first time lda ty+1 ;Get second word sta lch3 ;Last character sra 6 sta lch2 ;Middle character sra 6 ;First character lchar2:ext mask7 ;Get rid of higher-order end inx 1,2 ;and increment counter stx lf,2 ;and save bru 1,1 ;Get out lchar1:lda lch2-1 ;Get character bru lchar2 ;and return ltab: alf 00N ;No translation bru ln alf 00S ;Single spacing bru ls alf 00D ;Double spacing bru ld alf 00T ;Translated bru lt !!Page 93 ln: lda ln1,3 sta lnt,3 ;Set up instruction bru llnt lt: lda lt1,3 sta lnt,3 ;Store bru llnt llnt: lda llnt1 ;Get counter ado ;increment bnz bru lerr1 ;Some idiot did it again sta llnt1 bru lchar ls: lda lss,3 ;Get instructions !!*************************************************** !!JSM: ERROR: the instruction below was originally !! sta lpr+1 !!unindexed. It seems incorrect as the effect would !!be to place a printer instruction to slew one line !!--which is also an 'add 0'--into a location high !!in the 6K area, almost at its end. This instruction !!would not cause a halt, and would probably affect !!only some user's running program, and then only if !!the program was large. Furthermore, the error !!would only occur if C/PS were specified; as S is !!the default option, it is unlikely that many people !!at Dartmouth would ever have done so. This error !!is also present in my 235 executive listing, from !!March 1965, so it's been around a long time. !!I've corrected it to include index register 3, !!which (almost) always had the 8K bit set. The !!corrected instruction is shown below. !!*************************************************** sta lpr+1,3 ;[JSM: 9/30/02 Corrected, missing index 3] lda L56,3 ;Number of lines per page lscnt:sta lpage sta lncnt lda llsd1 ;Make sure no idiot tries both single and ado ;double space bnz bru lerr1 sta llsd1 bru lchar ;Go back for some more ld: lda lss,3 ;Get instruction sla 1 ;modify for double space sta lpr+1,3 lda L56,3 ;and count sra 1 bru lscnt ;and get out lst: ldz ;Entry point here bcs ;Check switch zero down bmi bru 2,1 ;If so, out ldx lpoin,2 ;Get exit point bru 1,2 ;and return lista:dld lareas,3 ;Get buffer areas dst lin ;and set in flip-flops sta io1+27 ;[Trash first buffer's syncword location] lac ;and set timing interval add six !!Page 94 sta lctim lda cmessb ;Do not acknowledge if batch on bze spb messg,2 ;Acknowledge receipt dec pcr ;[Works because lda = 00] rcd io1 ;Read in first card hcr lslew:spb lret,2 ;Exit and wait bcs bpn,6 ;Punt if not ready bru 2,1 sel 6 ;Slew to top of page slt 8 spb lret,3 ;then exit and wait again bcs bpn,6 ;punt and wait bru 2,1 sel 6 ;Slew 3 lines slw 3 lda lpage ;Reset page count sta lncnt list: spb lret,2 ;Exit and wait bcs bpn,6 bru 2,1 spb lhop,2 ;Now check hopper condition ldx lin,2 ;Area last read into lda 27,2 ;Check syncowrd add lsync,3 bnz ;If not matched, card read error bru lserr ldx lin+1,1 ;Area to be next read into stx lin,1 ;Flip-flop them stx lin+1,2 sta 27,1 ;Zero out next syncword location dld 0,2 ;Check for quote card dcb lquot,3 bru *+2 ;No bru lqchk ;Yes, check rest lndq: rcd 0,1 ;Read card otherwise hcr lnt: bru lppnt ;[Default single-space no translation] lnt1: dld lmask,3 ;Mask for table lookup lookp:lda 0,2 ;Pick up word to be translated bmi bru lprnt z13 z1 ;Put mask into xreg 1 [dst odd location] !!Page 95 ory z1 ;Put character into low-order end sra 6 ;Make room for new character add 0,1 ;Pick it up z13 z1 ;Second character ory z1 sra 6 add 0,1 z13 z1 ;Third character ory z1 sra 6 add 0,1 sta 0,2 ;Put away word inx 1,2 ;Increment address register bru lookp ;Return to loop lprnt:lda lin+1 sto lpr+1,3 ;Construct address sel 6 lpr: wpl 0 ;Print line sta z1 ;Set address in register lmo ;Set end-of-line flag sta 27,1 add lncnt ;and decrement page counter bze ;If zero, set up to slew bru lslew sta lncnt bru list ;Get back lret: stx lpoin,2 ;Save exit point ldx ovtsk,1 ;Get entry point bru 1,2 ;and get back again lhop: bcn ;Check reader bru lhop1 ;Test hopper not ready lac ;Step timer if OK add seven sta lctim ;and save bru 1,2 ;exit back lhop1:ldx lin,2 ;Get buffer address lda 27,2 ;and check syncword for hopper empty cab lsync+1,3 bru *+2 bru lendr ;End run for list if hopper empty lac ;Time check cab lctim ;If time has run over, then bru 2,1 ;get out if time still good !!Page 96 bru 2,1 spb time,2 ;or unattended. Type message and abort run. dst lab1,3 ;Put away spb messg,2 ;Type message dec lab ;Aborting list, date and time bru iredy ;and crump lserr:spb messg,2 ;Type message dec cre ;Card read error spb lret,2 ;Exit and wait on switch 2 down ldz ;Resume normal operations rcs ;2 is depressed ext mask6 sla 2 bno bru 2,1 ldx lin,2 ;Pick up address of buffer rcd 0,2 ;Read card hcr lac ;Pick up and compute delay time add six sta lctim bru list ;and get back and try again lqchk:lda cmessb ;Check background flag bze bru lndq ;If not on, crump immediately lqchk1:ldx ovtsk,1 ;Get entry point spb irase,2 ;and erase it ldx zero,2 ;Reset 2 inx batch,2 ;and set for batch monitor lmo sta io1 ;Set front card in bru pgetb ;Go get batch monitor lndra:spb lret,2 lda stack bnz bru 2,1 lda cmessb ;Check batch flag bnz bru lqchk1 ;get batch back lendr:spb time,2 ;Pick up time dst el1,3 ;Put it in type message spb messg,2 ;Type message dec dl ;Done listing, time !!Page 97 10/1/02 spb lret,2 ;Slew after list bcs brn,6 bru 2,1 ;wait for printer sel 6 slt 8 ;and slew spb irase,2 ;and erase entry ldz ;Reset some things sta bzyf sta ovtsk sta io1 ;So batch does not get fouled up. bru 2,1 ;Crump right away .lst.:spb lst,1 dec -1 lmask:oct 0 oct 3777700 ;Special geek mask for table lookup lareas:dec io1 ;Area 1 dec io2 ;Area 2 lsync:oct 1171701 ;Negation of syncword oct 3606077 ;Hopper-empty constant louot:oct 777777 ;Double 0-7-8 punches oct 777777 lss: add 0 ;printer instruction to slew 1 line L56: dec 56 ;Number of lines per page ln1: bru lprnt lt1: bru lnt1 pnr: oct 374751 ;Printer not ready. alf INT alf ER alf NOT alf & RE alf ADY oct 333755 crn: bss 0 ;Card reader not ready oct 372321 alf RD alf REA alf DER alf & NO alf T R alf EAD oct 703337 oct 557777 cre: oct 372321 ;Card read error alf RD !!Page 98 alf REA alf D E alf RRO alf R B alf ACK alf SPA alf CE alf 1 C alf ARD alf & AN alf D T alf OGG alf LE alf 2 W alf HEN alf & RE alf ADY oct 333755 ddc 0 bss -2 lab: bss 0 ;Aborting list -- time oct 372122 alf ORT alf ING alf & LI alf ST. alf & & & lab1: alf & & & alf & & & alf & HO alf URS oct 373755 oct 0 ddc 0 bss -3 dl: bss 0 ;Done listing - time oct 372446 alf NE alf LIS alf TIN alf G. el1: alf & & & alf & & & alf & HO alf URS oct 373755 !!Page 99 org t ;Temporary storage lin: bss 2 lncnt:bss 1 lpage:bss 1 lctim:bss 1 lch2: bss 1 ;Character storage - they must be in lch3: bss 1 ;sequential order llnt1:bss 1 llsd1:bss 1 lf: bss 1 ;Character counter lpoin:bss 1 ;Entry pointer loc 37700 ;Lookup table for lister [*must be at 37700*] oct 000000 oct 010000 oct 020000 oct 030000 oct 040000 oct 050000 oct 060000 oct 070000 oct 100000 oct 110000 oct 120000 ; 2-8 oct 160000 ;# 6-8 oct 140000 ;at sign oct 150000 ;- oct 160000 ;= oct 170000 oct 200000 oct 210000 oct 220000 oct 230000 oct 240000 oct 250000 oct 260000 oct 270000 oct 300000 oct 310000 oct 320000 oct 330000 oct 760000 ;] oct 350000 oct 360000 oct 370000 oct 400000 oct 410000 oct 420000 oct 430000 !!Page 100 oct 440000 oct 450000 oct 460000 oct 470000 oct 500000 oct 510000 oct 520000 oct 530000 oct 540000 oct 550000 oct 560000 oct 570000 oct 600000 oct 610000 oct 620000 oct 630000 oct 640000 oct 650000 oct 660000 oct 670000 oct 700000 oct 710000 oct 720000 oct 730000 oct 750000 ;[ oct 750000 ;[ oct 760000 ;] oct 770000 ;End of translation table tcd lovwrt ;List transfer stl ;Reproducer ejt !!Page 101 org pernum dec 2 dec c/c , Card reproducer , Will reproduce any type of card deck. , Buffered, with error checking. , Switch 0 down at any time will cause all , activity to halt. , Card read errors may be corrected by , placing the top card from the out stacker , (the last card read) in the read station , and toggling switch two. org execov dld .rst.,3 ;Get entry spb insert,2 ;and set up in list sta ovtsk sta z1 lda 8K ;Set initialization entry sta rpoin bpr ;Crump if not ready bru *+4 spb messg,2 dec rpnr ;Punch not ready bru rcmpa bcr ;[Test card reader] bru *+4 spb messg,2 dec rcrn ;Reader not ready bru rcmpa lda cmessb ;Check batch flag bze ;If on continue, else spb messg,2 ;acknowledge receipt dec pcr ;[Works because lda = 00] dld zero ;Zero out first syncwords dst io1+82 rcf io1 ;Read first card lac ;Compute first time delay add six sta rinf ;Save incremented time dld rads,3 ;Buffer addresses dst rin bru rep ;and get out rst: ldx ovtsk,1 ;Make like all other overlays ldz ;This is the entry point rcs ;Check switch 0 own bmi !!Page 102 bru 2,1 ;Yes, crump for now ldx rpoin,2 ;Get pointer bru 1,2 ;and get there rret: stx rpoin,2 ;Temporary exit ldx ovtsk,1 bru 2,1 rep: spb rret,2 ;Give things a chance to come ready ldx rin,2 ;area last read into bcn ;If reader not ready, check hopper bru rhop ldx rin+1,1 ;Next area lda 82,2 ;Darned card reader... check if out of phase ext rbit8,3 ;bit 8 bze ;if so, word before will have crap in it lda 83,2 ;Check syncword add rsync,3 bnz ;If not matched, reader error bru rderr sta 82,1 ;and set in word again dld 0,2 ;Check for quote cards dcb rquot,3 bru *+2 ;No bru rqchk ;Yes, check rest of card and flag rnoq: stx rin+1,2 ;Else switch buffer addresses stx rin,1 sta 83,1 ;zero out [overwrite] next area's syncword wcf 0,2 ;Punch previous card rcf 0,1 ;read in next one bru rep ;and start all over rhop: lda 83,2 ;Hopper empty test add rsynch,3 bze ;If matched, task completed bru rcmplt lac ;Check clock cab rinf ;Has time run over... bru 2,1 ;Just punt bru 2,1 spb messg,2 ;Else card reader not ready dec rcrn ;Card reader not ready lac ;Set up new time count add cr ;long wait sta rinf bru 2,1 ;Punt again !!Page 103 rqchk:lda cmessb ;Check back flag bze ;if not on, return bru rnoq dld rquot,3 ;Ekse check out card some more dcb 2,2 bru rnoq ;No bru *+2 bru rnoq ;Neither dcb 4,2 ;Then check last word bru rnoq ;Not Ok unless six 0-7-8 punches in a row bru *+2 bru rnoq rqex: ldx ovtsk,1 ;Get entry's location spb irase,2 ;and erase entry ldx zero,2 ;Reset 2 inx batch,2 ;and set to get batch monitor lmo sta io1 ;Set front card in bru pgetb ;and get monitor rcmpa:spb rret,2 ;[Either reader or punch not ready at start] lda stack bnz bru 2,1 lda cmessb bnz bru rqex rcmplt:spb time,2 ;Get time dst rdat1,3 ;out away spb messg,2 ;Type message dec repc ;Reproduction completed, time ldx ovtsk,1 ;Get task spb irase,2 ;and erase task ldz ;zero out flags sta bzyf sta ovtsk sta io1 ;So batch does not get fouled up bru 2,1 ;and exit rderr:spb messg,2 ;Type message dec rcre ;Card read error spb rret,2 ldz rcs ;Wait for switch 2 down before continuing ext mask6 sla 2 bno ;Wait bru 2,1 ;Not down ldx rin,2 ;Pick up last-used read-in area !!Page 104 rcf 0,2 ;read a card bru rep ;and start up again .rst.:rpr ;If punch ready, go to task, else not spb rst,1 rads: dec io1 ;Buffer addresses dec io2 rouot:oct 1006 oct 1007 rsync:oct 1770001 ;Syncword OK check rsynch:oct 0770001 rbit8:oct 4000 ;Bit 8 for special bad card check rpnr: bss 0 ;Punch not ready oct 374764 alf NCH alf & NO alf T R alf EAD oct 703337 oct 557777 rcrn:bss 0 ;Card Reader not ready oct 372321 alf RD alf REA alf DER alf & NO alf T R alf EAD oct 703337 oct 557777 oct 0 ddc 0 bss -3 repc: bss 0 ;Reproduction completed oct 375125 alf PRO alf DUC alf TIO alf N C alf OMP alf LET alf ED. alf & & & rdat1:alf & & & alf & & & !!Page 105 alf & HO alf URS oct 373755 rcre: bss 0 ;Card read error oct 372321 alf RD alf REA alf D E alf RRO alf R B alf ACK alf SPA alf CE alf 1 C alf ARD alf & AN alf D T alf OGG alf LE alf 2 W alf HEN alf & RE alf ADY oct 333755 org t ;Temporary storage rin: bss 2 ;Buffer areas flip-flop rinf: bss 1 ;Initial flag rpoin:bss 1 ;Entry point tcd lovwrt ;Transfer stl ;Catalogue printout ejt !!Page 106 , The catalogue printout, disk dump and , Billing pack routines are all one package. , The billing and the catalogue routines may , be called separately by *BIL* or *CAT* res- , pectively but the usual sequence is to call , in the dump routine with *DUM*. The dump , then calls in the catalogue and billing , routines. , Memory allocation for the disk dump package , is as follows... , Catalogue temporary storage , 4000 - 4077 , Printer buffer areas , 4100 - 4477 , Catalogue Buffer #1 , 5000 - 6777 , Catalogue buffer #2 , 7100 - 11077 , Disk dump catalogue file area , 11176 - 13177 , Billing routine buffer area , 13300 - 16777 , Billing temporary storage , 17000 - 17777 , Catalogue file key , 20000 - 20577 , Print line build area , 20700 - 20777 , Catalogue routine , 21000 - 21777 , Billing routine , 22000 - 22777 , Disk dump buffer #1 , 23076 - 27077 , Disk dump buffer #2 , 27176 - 33177 , CMESS is used as a flag and has the , following code , Bit 19 - dump in memory , Bit 18 - catalogue in memory , Bit 17 - billing in memory pr: eqo 4100 ;Print line buffers [adrs end key-see CPL] cin1: eqo 5000 ;Catalogue file buffers cin2: eqo 7100 ;Catalogue files !!Page 107 ckey: eqo 20000 catw: eqo 21000 jfile:eqo 11200 jbuf1:eqo 23100 ;Buffer 1 jbuf2:eqo 27200 ;Buffer 2 bin1: eqo 13300 ;Billing buffer area biltmp:eqo 17000 ;Billing temporary storage billw:eqo 22000 ;Billing program lcr1: eqo 23076 lcr2: eqo 27176 ltap: equ jfile ltap1:equ ltap+28 org pernum dec 4 dec cat org execov lda three ;Ask time to stop [wow - wish I could do that] spb spmess,2 lda six ;Ask for OFF spb spmess,2 dld *+4,3 ;Move catalogue down to where it should go mov execov bru cata ;and transfer it dec -1 ;Spare dec catw ;All goes down dec -512 , Catalog format , Each entry in the catalog is 8 words long , and containes information about a single , saved program in the following format... , Word 1 - first three characters of the user , number. , Word 2 - second three characters , Word 3 - first three characters of problem , name. , Word 4 - second three characters , Word 5 - beginning disk address of program , Word 6 - ending disk address of program !!Page 108 , Word 7 - coded date on which program was last , accessed. , Word 8 - presently contains only length , information - 0 if less than a half K, , 1 if greater. , The end of the entries in a given catalog is , signified by a 555555 appearing in word , 2. If more than 127 programs are saved by users , in a particular equivalence class, another , 1024-word block will be added to the catalog. , The presence of another link is indicated , as follows...in word 2 of what would be the , 128th entry will appear 373737. The word , before this will be the disk address of the , added catalog. org catw+10 cata: spb dskb,2 ;Go ask for disk spb dskop,2 ;Read in key to catalogue z12 6 ;6 records, with labels dec ckey ;memory address z20 key+2 ;inidirect to disk address bru * ;Should never ever return here spb messg,2 ;Acknowledge request dec pcr catb: spb dksop,2 ;Go read in date z12 1 ;1 record dec cin1 ;into area 1 oct 400 ;disk address dec -1 ;Should never return here spb relin,2 ;Give up disk lda cmess ;Set flag on to indicate calogue in add two sta cmess spb time,2 ;Get time for heading line dst chead1,3 sxg 5 ;Set executive group set pst ;and exit priority mode bru *+1,3 ldx 8K,3 ;and make sure upper 8K bit is in right place dld cinit,3 ;Get buffer flip-flops dst cin dld zero dst in sta cdass ;Reset save area for address ldx zero,2 lda ovflo dst cpnum,2 ;Set flag in program counters for decmode !!Page 109 inx 2,2 bxl 16,2 bru *-3 lda nblnk ;Negative blank for print line sta p16,3 sta perin ;Knock out indicator ext sign ;and reset sign bit lqa ;Copy in Q dst p*0,3 ;and push over the line sta p1,3 sta p2,3 dst ptl,3 inx 2,3 bxl 40,3 bru *-3 lda mask6 ;Set end of line sta ptl-2,3 ldx 8K,3 ;Reset register lda cin1 ;Pick up dlong - long programs counter spb convrt,2 ;convert it dst chdas2,3 ;Put away in heading line lda cin1+2 ;Pick up coded date spb convrt,2 ;convert it dst chcode,3 ;put away in next heading line dld ctdat,3 ;Move constant for date mov cin1+3 sxg 4 ;and use all sorts of index groups ldx 8K,2 ;Set some registers ldx 8K,3 lda ckey,2 ;Get first catalogue entry inx 1,2 ;and step for next sta cfilea+2,3 ;and set in parameter list sxg 3 set pbk spb dramb,2 ;Get catalogue dec cfilea ;File 1 set pst sxg 5 ;and get into some decent group spb slt8,2 ;Slew to top of page spb slw3,2 ;Slew page three lines lda linit,3 ;Initialize line counter at eight sta cline bcs bpn,6 ;Wait for printer ready bru *-1 sel 6 z26 -- ;[What's this?] z02 chead,1 ;Skip two lines when printing headers bcs bpn,6 ;Wait again bru *-1 sel 6 z26 -- !!Page 110 z02 chdass,1 bcs brn,6 ;Wait bru *-1 sel 6 z26 -- z04 cdate,1 ;Coded date heading line cloop:lda cin+1 ;Get next address sta xr52 ;and set in register sta cmore+1,3 ;and in indirect parameter sxg 4 ;Get next catalogue address lda ckey,2 inx 1,2 sxg 5 bmi ;Check the address bru crump1 ;If negative, stop bze ;If zero bru cflip ;then print last entry and crump sta 2,2 ;set in parameter list sxg 3 set pbk cmore:spb dramb,2 ;Get catalogue z00 -- ;Constructed indirect set pst sxg 5 ldx cin,2 ;Get last used file address lda 3,2 ;and check done word bze ;Wait for disk to finish bru *-2 bev ;If error, stop so we can see what and where dec -1 cflip:lmo ;Set print flag sta pflag dld cin ;Switch buffers xaq dst cin ldx cin+1,2 ;Last entry is now +1 lda 1,2 ;Get memory address sta xr52-1 lda 2,2 ;and get address sta cadrs ;save it for later cscan:lda 1,1 ;Check for 55s in second word cab c55s,3 bru *+2 ;If not, continue bru cloop ;Else try again cab c37s,3 ;See if one of Kip's crazy catalogs bru *+2 bru ccon ;Yep !!Page 111 lda bzyf ;Check for crump bze ;If so, then flag will be zero bru wait ;so get out lda pflag ;Look at print flag bze ;If zero, special case bru pset ;Wipe out disk address bpl ;If non-zero plus, get out bru pnext lda ovflo sta p3,3 cconk:bss 0 lda cadrs spb convrt,2 sta p*0+1,3 ;Move address over xaq sta p0,3 lda zero sta pflag pnext:lda p3,3 ;Increment counter set pbk set decmode ;for decimal mode arithmetic add one set binmode set pst sta p3,3 ;Put away counter dld 2,1 ;Problem number dst p6,3 lda 4,1 ;Starting disk address ext mask1 ;Check for legal address cab o300 bru *+3 bru *+1 spb cerr,2 ;No lda 4,1 ;Get address again cab cdass ;Check against last highest available bru *+3 ;location for saved programs bru *+2 sta cdass spb convrt,2 ;Convert it dst p8,3 lda 5,1 ;Ending disk address sub 4,1 ;Compute length of program bze spb cerr,2 ;Zero-length is illegal bmi ;Check if length all wrong spb cerr,2 ;Yes cab o100 ;Or out of bounds bru *+3 bru *+2 spb cerr,2 ;Yes !!Page 112 dld 0,1 ;User number dst p4,3 ;put away sub c77s,3 ;and see if hole bze bru pnoc ;If so, do not count it set pbk set decmode ;Decimal mode for counting problems lda 7,1 ;Length code ext mask3 ;just low end of interest sla 1 ;Double length table sta xr52 ;In group 5 dld cpnum,2 dad cone,3 ;Increment dst cpnum,2 set binmode set pst pnoc: lda 5,1 ;Pick up ending disk address again spb convrt,2 dst p10,3 lda 6,1 ;Pick up coded date spb convrt,2 dst p12,3 lda 7,1 ;Pick up unused word spb convrt,2 ;convert' dst p14,3 lda cerrf ;Check error flag bmi spb cerr1,2 dld pprnt,3 ;Get number of words in Q lda cpl,3 ;Get currently used buffer address add o200 ;Switch it ext o400 sta cpl,3 ;and restore mov P*0 ;Move into print area bcs bpn,6 ;Wait for printer bru *-1 sel 6 z36 cform,1 ;Format line cpl: z01 pr ;Print line inx 8,1 ;Increment area pointer lda cline ;Check if slew necessary add one sta cline ;put away incremented counter cab c57,3 ;57 lines per page bru cscan ;If less, go scan again lda three ;Else reset counter sta cline ;and slew page spb slt8,2 ;Slew to top bcs bpn,6 ;Wait for printer bru *-1 sel 6 !!Page 113 slw 1 ;Slew one line at top lda ptl1,3 ;and get page set pbk set decmode ;Count [page number] ado set binmode ;get back set pst sta ptl1,3 bcs bpn,6 ;Wait again bru *-1 sel 6 z26 -- z03 ptl,1 ;Title print bru cscan ;go scan pset: lda dumpbl ;Blanks sta p*0+1,3 ;Wipe out disk address sta p0,3 sta p1,3 sta pflag ;Reset flag to positive bru pnext ;Get back , This is used to fudge the right catalog when , a linked one is found. It reads the linked , catalog over the one it just listed and , then lists it. ccon:bss 0 ldx cin+1,2 lda 1,2 ;Fudge right catalog sta cconl+1,3 lda 0,1 sta cconl+2,3 sta cadrs set pbk spb dramb,2 dec cconl set pst lda cconl+3,3 bze bru *-2 ;Wait till done bev bru * ;[Hang on error] lda cconl+1,3 sta xr52-1 bru cconk , Catalog printout finished, determine next , available location and number of programs. !!Page 114 crump1:spb slw3,2 ;Slew three lines lda cdass ;Next available location for saved programs add o100 ;round up sta cdass ;save ext mask1 ;Check legality sub o300 bpl ;Bad bru *+3 ldz ;OK bru *+2 lda o100 add cdass ;Get good address spb convrt,2 ;convert it dst ccom2,3 ;put away bcs bpn,6 bru *-1 sel 6 ;Print it z26 -- z02 ccom1,1 , Now start totalling progams crump2:ldx zero,2 ;Loop counter bcs bpn,6 ;Wait at start bru *-1 dld cpnum,2 ;Number of programs cab ovflo bru *+1 add cig1,3 ;Delete right number of characters add cig2,3 dst ctotp,3 ;Total programs set pbk set decmode dld cpnum,2 dad ctot6,3 ;Keep total programs dst ctot6,3 set binmode set pst lda xr52 ;Get counter sra 1 add cig2,3 ;Do not want zeros sta cend1,3 ;Put in print line sel 6 ;Print it wpl cend1 inx 2,2 bxl 12,2 bru crump2+1 ;Start again spb slw3,2 ;Slew three lines dld ctot+6,3 ;Get rid of high-order zeros on this too cab ovflo bru *+1 !!Page 115 10/3/02 add cig1,3 add cig2,3 dst ctot6,3 bcs bpn,6 bru *-1 sel 6 ;Print total programs z24 -- dec ctot spb slt8,2 lda cmess ;Delete catalogue from roster sub two sta cmess bnz bru wait ;Yes, so crump bru icrump ;and type message cerr: lmo ;Set flag sta cerrf,3 bru 1,2 ;and get out cerr1:dld ****,3 ;Get asterisks dst p12,3 ;and set in last words dst p14,3 ldz ;Reset flag sta cerrf,3 bru 1,2 ;and get out slw3: bcs bpn,6 ;Wait bru *-1 sel 6 slw 3 bru 1,2 slt8: bcs bpn,6 bru *-1 sel 6 slw 8 bru 1,2 , Constants cfilea:z12 16 ;Read, 16 records - file parameter list dec cin1 ;Area 1 z00 -- ;Constructed disk address z00 -- ;Special terminate word !!Page 116 cfileb:z12 16 dec cin2 z00 -- z00 -- cconl:z12 16 z00 -- z00 -- z00 -- c37s: oct 373737 c57: dec 57 ;Number of lines per page c77s: oct 777777 ****: alf *** ;Special indicators alf *** cinit:dec cfilea ;Areas flip flop dec cfileb ctdat:dec chead2 ;Move constant for date dec -5 cone: oct 0 oct 1 pprnt:dec 0 ;Print move constant dec -19 c55s: oct 555555 linit:dec 11 ;Initial value for line counter cerrf:oct 0 ;Flag cig1: oct 35 cig2: oct 603500 , Format line cform:oct 353535 oct 353535 oct 353535 oct 353535 oct 373757 oct 353535 oct 363535 oct 353535 oct 363535 oct 353535 oct 363535 oct 353535 oct 363535 oct 353535 oct 363535 oct 353535 !!Page 117 oct 363535 oct 353535 oct 353535 , General heading line oct 0 ;Make into odd location ddc 0 org *-3 chead:alf DAR ;Dartmouth College Time-Sharing System alf TMO ;Catalogue files as of date alf UTH alf & CO alf LLE alf GE alf TIM alf E-S alf HAR alf ING alf & SY alf STE alf M C alf ATA alf LOG alf UE alf FIL alf ES alf AS alf OF chead2:alf & & & ;Date goes in these five locations alf & & & alf & & & alf & & & alf & & & alf & & T alf IME chead1:alf & & & ;Time goes in these two locations alf & & & alf & HO alf URS oct 2336060 , Second heading line oct 0 ;Make sure chdass is even chdass:oct 353545 ;[Next available location for saved ] alf EXT ;[programs is] alf & AV alf AIL alf ABL !!Page 118 alf E L alf OCA alf TIO alf N F alf OR alf SAV alf ED alf PRO alf GRA alf MS alf IS chdas2:alf & & & ;Dassgn foes in these two locations alf & & & oct 2336060 , Third heading line cdate:oct 353523 ;Coded date-- alf ODE alf D D alf ATE oct 404060 chcode:alf & & & ;Coded date goes in these two locations alf & & & oct 2336060 , Computed next available location ccom1:alf COM alf PUT alf ED alf NEX alf T A alf VAI alf LAB alf LE alf LOC alf ATI alf ON OCT 601660 ;Equal sign oct 353535 ;Ignores ccom2:alf & & & alf & & & oct 2336060 , Terminating lines for catalog printout cend1:alf & & & alf & LE alf NGT alf H P !!Page 119 alf ROG alf RAM alf S = ctotp:alf & & & alf & & & oct -336060 oct 0 ;Make next even ctot: alf & TO alf TAL alf & PR alf OGR alf AMS alf & = ctot6:ddc 0 oct -336060 , Print line build area loc 20700 p*0: bss 2 ;Leading blanks p0: bss 1 p1: bss 1 p2: bss 1 p3: bss 2 p4: bss 2 p6: bss 2 p8: bss 2 p10: bss 2 p12: bss 2 p14: bss 2 p16: bss 1 ptl: bss 40 ;Save 40 places for title ptl1: equ ptl+38 , Temporary storage org k6area cin: bss 2 cpnum:bss 16 ;Counters for programs cdass:bss 1 cadrs:bss 1 pflag:bss 1 cline:bss 1 org k2area ;Special fudging routine excv: equ execov dec excv+10 dec -502 catmov:dld *-2 ;Move catalogue up for loading onto disk !!Page 120 mov cata bru lovwrt ;and go write overlay tcd lovwrt stl ;Disk dump ejt !!Page 121 , Time-sharing disk dump. , The following areas will be dumped... , 1) The first half of disk zero , 2) The catalogue files , 3) All saved programs , Usually only one tape will be required, , and it should be mounted on handler 3. , If a second tape were to be required, the , program will ask for it via the console , typewriter and wait for zero to be toggled. , The second tape must be placed on handler , 7. In this case tape three will have to , be rewound manually. org pernum ;Heading information dec 6 dec dum org execov lda three ;Ask for time count stop sbp spmess,2 lda six ;Ask for OFF spb spmess,2 lda wait1 ;Reset P-counter sta pct lmo ;Reset some indicators sta perin ;Peripheral indicator sta in ;System indicator ldo ;Set cmess sta cmess spb dskb,2 ;Ask for disk spb dskop,2 ;and read in tape routine z12 3 ;300 octal words dec treqst z20 tap+2 ;Indirect to disk address bru * ;Should never happen spb treqst,2 ;Then use it sel 1 ;to rewind tape 3 rwd ,3 oct 0 ;Flag to indicate return spb dskop,2 ;Read in catalogue routine z12 8 ;1K octal dec catw z20 cat+2 ;Indirect to address bru * ;Neither should it return here spb dskop,2 ;Read in key to catalogue z12 6 ;6 records, with labels for dump dec ckey ;Key area z20 ckey+2 ;Indirecto to disk address bru * ;Real trouble if it returns here !!Page 122 spb dskop,2 ;Read in billing routine z12 8 dec billw z20 bil+2 ;Indirect to disk address bru * dld .jlnk.,3 ;Get linkage to dump routine spb insert,2 ;and insert in task list sta jlist ;Save entrance bru catb ;and transfer to catalogue , JLNK is entered after the catalogue routine , is initialized, and it writes labels on , tapes and types them out and does other odd , things. jlnk: lda 1,1 ;Switch entries for rest of time sta 0,1 dld jinit,3 ;Points to jfila, jfileb dst jin spb dramb,2 ;Pick up first 2K from disk zero dec jfila dld lab3 ;Get date mov sdate+1 spb time,2 ;and time dst dlab2,3 lmo ;Set flag word negative sta dlab5 ;to indicate tape #1 spb jexec,2 ;and exit with return saved bcs brw,1 ;Wait for tape to finish rewinding bru 2,1 ;If so [rewinding], exit spb billi,2 ;Initialize billing routine spb treqst,2 ;Write label sel 1 wtb dlab1,3 %30 oct 0 spb jexec,2 ;Do not overload task table lda *-2 bze ;If label not done, crump bru 2,1 spb messg,2 ;and type message dec dlab1 ;label spb messg,2 ;and time dec dumtim , JLOOPA reads in the first half of disk zero , and writes it on the dump tape !!Page 123 jloopa:spb jexec,2 ;Exit ldx jin,2 ;Points to current file spb jchk,0 ;See if any errors spb jtape,1 ;Go write records on tape ldx jin,2 ;Get file addresses again ldx jin+1,1 lda 2,2 ;Disk addresses cab jlast,3 ;and check for end first half disk zero bru *+2 bru jlba ;exit if so add o100 ;Step 2K sta 2,1 ;and set in next file ext mask1 ;Check for illegal cab o300 bru *+5 ;OK bru *+1 ;No, so step position lda 2,1 add o100 sta 2,1 stx jin+1,2 ;Flip flop buffer addresses lda z1 ;Get next one sta jin sta *+2,3 ;and set in calling pointer spb dramb,2 ;Pick up next 2K dec jfilb bru jloopa ;and get next , JLBA picks up catalogue files as indicated , by addresses in the key. jlba: ldx 8K,2 ;Begin saved programs dump stx jkey,2 ;Initialize catalogue pointer jlbb: ldx jkey,2 ;Get file pointer lda ckey,2 ;and entry for file bze ;Check for all done bru jend ;Yes, so terminate dump inx 1,2 ;Step pointer stx jkey,2 ;and save jlcn: sta jfilc+2,3 spb jexec,2 ;Now exit lda jtflg,3 ;and check to make sure last entry written bze ;on tape if one file empty bru 2,1 ;Wait if not spb dramb,2 ;If OK, bring in file jlfdg:dec jfilc ;Fudge factor spb jexec,2 ;and exit !!Page 124 lda jdfilc,3 sta z2 spb jchk,0 ;See if any errors lda jlfdg,3 ;Get fudge constant sta z2 ;and set in register 2 spb jtape,1 ;Write file on tape lda jfilc+1,3 ;Get memory address and initialize running sub jeig ;dec 8 sta jkvar ;pointer sta z2 ;and set in register bru jl1; ;and begin saving programs , JLOOPB picks up saved programs according to , the entries in each individual catalogue , file, and writes them out onto the dump , tape. jloopb:spb jexec,2 ;Exit ldx jin+1,2 ;Get current entry pointer spb jchk,0 ;See if any errors spb jtape,1 ;Write out just-read program jl1: ldx jkvar,2 ;Get running pointer inx 8,2 ;and step stx jkvar,2 ;save lda 1,2 ;Check for end file cab c37s ;check linked catalo bru *+2 bru jl2 ;Get next link cab j55s ;See if end of catalog file bru *+2 ;No bru jlbb ;Get next catalog record cab c77s,3 ;See if hole bru *+2 ;No bru jl1 ;Yes, just skip it lda 4,2 ;Get starting disk address ext mask1 cab o300 ;Check for legal bru *+3 bru jl1 ;No, crump it bru jl1 lda 5,2 ;Get length sub 4,2 sra 1 ;Mod 64 bpl ;Check if bad length, such as bze ;zero bru jl1 ;or negative cab o40 ;or too long bru *+3 bru *+2 !!Page 125 bru jl1 ldx jin+1,1 ;Get pointer to next parameter list sto 0,1 ;and set length in command lda 4,2 ;Get address again sta 2,1 ;and set in parameter list dld jin ;Flip entries xaq dst jin sta *+2,3 ;and in call spb dramb,2 ;Now read a program dec 0 ;Constructed parameter list pointer , These are fudges for buffering. Skip , write out prgram first time through and , make sure last one gets written lda *+4,3 ;Get branch for next time sta *-1,3 sta jloopb-1,3 ;Make sure last program gets written bru jl1 ;and get next program bru jloopb ;Normal entrance jl2: lda 0,2 ;This is a fudge to get extended catalog bru jlch ;and get it , JTAPE is entered on xreg1. Index register 2 , points to the disk parameter list , containing the information about the record , to be written on the tape. , This information becomes part of each tape , record in a special two-word key at the , beginning of each one, as follows. , word 1 - disk address , word 2 - length (mod 64) jtape:stx jtmp,1 ;Save entrance stx jtmpp,2 ;and save other spb jexec,2 ;and exit lda jtflg,3 ;Get completion flag bze ;If zero, not yet done bru 2,1 sra 1 ;Check for end of tape bod bru jswtch ;in which case change tapes jt2: ldx jtmpp,2 ;Get file pointer lda 1,2 ;and get memory address sub two ;decrement for key sta z1 ;and set in register lda jtap+2,3 ;Get operation ext mask11 ;less address add z1 ;and add memory address !!Page 126 sta jtap+2,3 ;Then set in call lda 0,2 ;Get length ext mask10 ;extract high-order end sta 1,1 ;and set in key sla 6 ;and set as # of records add two ;incremented for key sto jtap+3,3 ;in call lda 2,1 ;Set disk address in key sta 0,1 jtap: spb treqst,2 ;Write record on tape sel 1 wtb --,3 ;Constructed %0 jtflg:oct 1 ;Flag word - initialized ldx jtmp,1 ;Get return bru 1,1 ;and return jexec:stx jpoin,2 ;Save caller ldx jlist,1 ;Get entrance point bru 1,2 ;get back jent: ldx jpoin,2 ;Get caller bru 1,2 ;and return jswtch:lda jtap+3,3 ;Check for tape 7 already bmi ;If so, real trouble bru jtroub spb messg,2 ;Else type message to change tapes dec t07 lda sign ;Now switch handlers ory jtap+3,3 !!*************************************************** !!JSM: ERROR: the instruction below was !! ory jend+3,3 !!which is clearly wrong. It is !!part of a sequence contructing a tape operation, !!but as originally written, this instruction would !!place a sign bit into a location whose contents are !! spb jtape,1 !!creating an unintended (and probably illegal) !!instruction. The intent was to indicate whether !!a tape rewind operation should address handler !!3 or 7, as indicated by the comment at location !!'jend' + 9 (circa line 5321), so I created a symbol !!jend0 at that location and changed the original !!instruction as shown below. !!*************************************************** ory jend0+3,3 ;[jsm: *** CLEARLY AN ERROR *** was jend0+3] ory jend1+3,3 spb treqst,2 ;and rewind old tape sel 1 rwd ,3 oct 0 spb jexec,2 ;Exit ldz ;and wait for 2 to be toggled rcs sla 2 bno bru 2,1 ;Exit if not down yet ldz ;Set flag for second label sta dlab5.3 spb treqst,2 ;and write it on second tape which had better !!Page 127 sel 1 ;be rewound wtb dlab1,7 ;Write label out on 7 %30 oct 0 spb jexec,2 ;Exit and wait for label to be done lda *-2 bze bru 2,1 bru jt2 jtroub:spb messg,2 ;Type message and abort run dec psoo , JEND must write out the last program which is , still in memory jend: spb jexec,2 ;Exit first ldx jin+1,2 ;Get current file entry pointer spb jchk,0 ;Check disk spb jtape,1 ;Write on tape spb jexec,2 ;Exit again lda jtflg,3 ;Check done bze bru 2,1 ;Not yet jend0:spb treqb,2 ;Now rewind 3 - or 7 as may be sel 1 ;and write end-of-file on three - or 7 wef ,3 oct 0 jend1:spb treqb,2 sel 1 rwd ,3 oct spb jexec,2 ;Exit and wait lda *-2,3 ;Keep checking bze ;punt if not done bru 2,1 lda cmess ;Decrement flag to indicate completion sbo sta cmess sra 2 ;Check for billing in bev spb tclos,2 ;If not, close out tape routine ldx jlist,1 ;Get entry point spb irase,2 ;and erase lda cmess bze ;Check if billing or catalogue still in bru icrump ;if none, exit and type message bru 2,1 ;Exit !!Page 128 jchk: lda 3,2 ;Check for file read bze bru 2,1 ;If not, punt stx rawt,0 ;Save entrance bev ;Hang if any errors bru * ;not recovered ldx rawt,1 bru 1,1 ;Return , Disk parameter lists jfila:z12 32 ;Read in first half of disk zero dec jbuf1 ;into buffer #1 dec 0 ;constructed dec 0 ;completion indicator jfilb:z12 32 ;Read 2K dec jbuf2 ;Buffer 2 dec 0 ;constructed dec 0 ;completion indicator jfilc:z12 16 ;Special file for catalogues dec jfile dec 0 dec 0 .jlnk.:spb jlnk,1 ;Linkage entry for first time spb jent,1 ;subsequent times entry jinit:dec jfila ;Files flip flop dec jfilb jdfilc:dec jfilc dlab3:dec dlab ;Date move dec -5 jlast:oct 37600 ;Last record on disk zero j55s: oct 555555 jeig: dec 8 ;Start jkvar off right , ********************************************** , Do not go above 37500--tape sub. overlay , ********************************************** org ta ;Leave treqst some room jin: bss 2 jlist:bss 1 jkey: bss 1 !!Page 129 jkvar:bss 1 jtmp: bss 1 jtmpp:bss 1 jpoin:bss 1 tcd lovwrt ;Transfer stl ;Billing master pack ejt !!Page 130 10/4/02 , The billing master packing routine writes an , end-of-file on tape 0, rewinds 0 and 6, , then spaces forward 6 until it senses an , end-of-file. It then packs tape 0 onto 6, , blocking the latter by a factor of ten. , If called by *BILL*, it moves itself down to , 22000, but normally it is read in by the , dump routine and is part of the dump - cat , - billing package. org pernum dec 8 dec bil org execov lda three ;Ask for off spb spmess,2 lda six ;Turn off other teletypes spb mess,2 dld *+4,3 ;Move program down mov execov bru billa dec -1 ;Spare word dec billw dec -512 ;Lots of words...P org billw+10 billa:lda wait1 ;Reset P-counter sta pct spb messg,2 ;and acknowledge dec pcr spb dskb,2 ;Get disk to read in tape routine spb dskop,2 ;and read in tape routine z12 3 dec treqst ;Upper part of overlay z20 tap+2 ;Indirect to its address bru * ;This should never happen spb relin,2 ;Relinquish disk, so we can get it later dld .blii.,3 ;Get entry xaq spb insert,2 ;and insert in table sta bilin ;and save billb:spb treqb,2 ;Normal running routine sel 1 ;Write end-of-file on zero wef ,0 !!Page 131 oct 0 ;Return flag spb treqb,2 ;and rewind 6 sel 1 rwd ,6 bilrw:oct 0 ;Flag for completion lmo ;Reset some indicators sta pering sta in lda cmess ;Set cmess to indicate billing in add four sta cmess spb bexec,2 ;Exit and return lda bilrw,3 ;to check if rewind of 6 done bze bru 2,1 ;No, so exit bcs brw,1 ;Wait for rewind bru 2,1 spb treqb,2 ;Go rewind zero sel 1 rwd ,0 bilw0:oct 0 bilsum:spb bexec,2 ;Reset summary spb irase,2 spb dskb,2 spb dskop,2 ;Read in summary z12 1 dec fclock oct 402 nop ldz ;Reset first word sta fclock spb dskop,2 ;Re-write summary z37 1 dec fclock oct 402 nop dld .blii.,3 ;Restore billing xaq spb insert,2 sta bilin spb relin,2 ;Done with disk blsrch:spb treqb,2 ;Go search for end of master sel 1 rtb bin1,6 ;Read in record %0 ;but not much blsrw:oct o ;Flag word spb bexec,2 ;Exit and wait lda blsrw,3 ;Check flag on read bze !!Page 132 bru 2,1 ;Crump if not done sra 2 ;Check for EOF bev bru blsrch ;None spb treqb,2 ;Now begin copying 0 onto 6 sel 1 bkw ,6 ;Backspace 6 over EOF oct 0 spb bexec,2 ;Exit and wait lda *-2,3 ;Check flag bze bru 2,1 ;exit lda bilw0,3 ;Check flag on that op bze bru 2,1 ;Crump if unattended bcs brw,1 ;else wait for rewind bru 2,1 bill3:spb treqb,2 ;Begin reading and search for BOO messg sel 1 rtb bin1,0 %30 oct 0 spb bexec,2 ;Exit and wait lda bill3+4,3 bze ;Check flag bru 2,1 ;exit if not yet done dld bin1 ;Else check for message dsu boo1,3 bze ;First word zero xaq ;Check second bnz ;Either non-zero, bru bill3 ;keep at it , BILL4 reads in records from the billing , scratch tape, discards all debbuging info, , then packs the good records in 20-record , blocks which get written onto the packed , billing tape, on 6. bill4:lda bin2,3 ;Get address ldx zero,1 ;and initialize counter stx binf,1 ;save bru *+3 ;and skip first part !!Page 133 bill5:lda bin,3 ;Get address add b24,3 ;Step it sta bin,3 ;and save sto *+3,3 ;and set in call bill5r:spb treqb,2 ;Read tape zero sel 1 rtb -- ;Constructed %24 oct 0 ;Flag word spb bexec,2 ;Exit and wait lda *-2,3 bze ;Exit if not done bru 2,1 sra 2 bod ;Check for end-of-file bru bill8 ;Found, so end near lda bin,3 ;Get address sta z2 ;set in register lda 24,2 ;Get residue word bnz ;and check for greater or less bru bill5r ;Crump if not 24 words ldx binf,1 ;Get counter inx 1,1 ;step it stx binf,1 ;and save bxl 20,1 ;Check for 20 bru bill5 ;no, so go back and read some more spb treqst,2 ;This time check for errors sel 1 wtb bin1,6 ;Write many records %480 oct 0 spb bexec,2 ;Exit and wait lda *-2,3 ;Now wait bze bru 2,1 ;and exit if not done bru bill4 ;else restart sequence bill8:spb treqb,2 ;Wrapup operation sel 1 rwd ,0 ;Rewind zero oct 0 ;Flag word lda binf ;Get last-used address counter bze ;Check for none written this time bru bill9 ;EOF came first, so exit maq mpy b24,3 ;Else get number of words left laq ;Pick them up sto *+4,3 ;and put away in call !!Page 134 10/5/02 spb treqst,2 ;and write on billing tape last time sel 1 wtb bin1,6 %0 ;constructed oct 0 bill9:spb treqb,2 ;Pile them up sel 1 wef ,6 ;Write EOF on 6 oct 0 spb treqb,2 ;and some more sel 1 rwd ,6 ;Rewind 6 oct 0 lda cmess sub four ;Delete billing from roster sta cmess bev ;Check if dump still in spb tclos,2 ;Else close out tape ldx bilin,1 ;Get entrance spb irase,2 ;and erase lda cmess ;Get again bze ;Check if any in bru icrump ;and type message if none bru 2,1 ;and exit billi:dld .blii.,3 ;Get first entry bru insert ;and exit blii: stx bilin,1 ;Save entry lda .blin.,3 ;Get usual entry sta 0,1 ;and set in list bru billr ;and initialize operations blin: ldx bpoin,2 ;Get exit point bru 1,2 ;and get going bexec:stx bpoin,2 ;Save exit point ldx bilin,1 ;and get entry point bru 1,2 ;and exit !!Page 135 .blii.:spb blii,1 ;Bill initializer .blin.:spb blin,1 ;Regular billing entry boo1: oct 2606060 ;Special check constant oct 557755 bin2: dec bin1 ;Buffer address b24: dec 24 bin: bss 1 ;Address org biltmp ;Temporary storage binf: bss 1 ;Counter bilin:bss 1 ;Entry point save bpoin:bss 1 ;Exit pointer org k2area ;Fudge routine dec excv+10 dec -502 bilmov:dld *-2 ;Move billing routine up so can write on disk mov billa bru lovwrt ;and transfer tcd bilmov stl ;Catalogue files key ejt !!Page 136 , Cataogue files key. , Contains in addition certain labels for the , dump and load routines. , This overlay is read in by the catalogue , into 20000 org pernum ;Special overlay called by dump and catalogue dec 10 dec key org ckey , Key to the catalog , Disk 1 oct 061400 oct 061440 oct 061500 oct 061540 oct 061600 oct 061640 , Disk 2 oct 121400 oct 121440 oct 121500 oct 121540 oct 121600 oct 121640 , Disk 3 oct 161400 oct 161440 oct 161500 oct 161540 oct 161600 oct 161640 , Disk 4 oct 221400 oct 221440 oct 221500 oct 221540 oct 221600 oct 221640 , Disk 5 oct 261400 oct 261440 oct 261500 oct 261540 oct 261600 oct 261640 , Disk 6 oct 321400 oct 321440 oct 321500 oct 321540 oct 321600 oct 321640 , Disk 7 oct 361400 oct 361440 oct 361500 oct 361540 oct 361600 oct 361640 , Disk 8 oct 421400 oct 421440 oct 421500 oct 421540 oct 421600 oct 421640 , Disk 9 oct 461400 oct 461440 oct 461500 oct 461540 oct 461600 oct 461640 , Disk 10 oct 521400 oct 521440 oct 521500 oct 521540 oct 521600 oct 521640 , Disk 11 oct 561400 oct 561440 oct 561500 oct 561540 oct 561600 oct 561640 , Disk 12 oct 621400 oct 621440 oct 621500 oct 621540 oct 621600 oct 621640 , Disk 13 oct 661400 oct 661440 oct 661500 oct 661540 oct 661600 oct 661640 , Disk 14 oct 721400 oct 721440 oct 721500 oct 721540 oct 721600 oct 721640 , Disk 15 oct 761400 oct 761440 oct 761500 oct 761540 oct 761600 oct 761640 , Extra catalogs on disk 15 oct 761000 oct 761040 oct 761100 oct 761140 oct 761200 oct 761240 oct 760400 oct 760440 oct 760500 oct 760540 oct 760600 oct 760640 oct 0 ;End for dump dec -1 ;End for catalogue printout !!Page 139 , Labels for dump and load ddc 0 ;Insure even bss -2 dlab1:bss 0 ;Dartmouth College Time-Sharing System oct 377777 alf DAR alf TMO ;Disk dump-load tapes. Date alf UTH alf & CO alf LLE alf GE alf TIM alf E-S alf HAR alf ING alf & SY alf STE alf M D alf ISK alf & DU alf MP- alf LOA alf D T alf APE alf S. oct 606037 dlab: alf & & & alf & & & alf & & & alf & & & alf & & & oct 375577 dlab5:oct 0 ;This word indicates which tape is on oct 0 ;Must be odd location ddc 0 bss -3 dumtim:bss 0 alf DIS alf K D ;Disk dump time etc. alf UMP alf . T alf IME dlab2:alf & & & !!Page 140 alf & & & alf & HO alf URS oct 373755 to7: bss 0 ;Place tape 2 on handler 7. Toggle zero oct 374743 ;when ready. alf ACE alf & TA alf PE alf 2 O alf N H alf & 7. alf & & T alf OGG alf LE alf 2 W alf HEN alf & RE alf ADY oct 333755 psoo: bss 0 ;Tapes on wrong density. alf PES alf & ON alf & WR alf ONG alf & DE alf NSI alf TY. oct 375577 , Fudge routine to move overlay up org k2area dec execov dec -512 filmov:dld *-2 mov ckey ;and move bru lovwrt ;Now write on disk tcd filmov stl ;Disk load ejt org pernum dec 12 dec loa , Time-sharing disk load. This routine ex- , pects each record on the tape to have two , code words at the beginning, with the , following information... , Word 1 - disk address , Word 2 - length (mod 64) , Tape one of the load set must be , mounted on handler 3. The tape will be , transferred to the disk until an end-of- , file is sensed, at which point the load , terminates. If an EOF is sensed before the , EOF is reached, the program will ask to have , the second tape from the load set mounted , on handler #7. , The first tape must have the correct , label written on it by the dump routine and , the last word of this must be negative. For , second tape, the label is the same but the , code word is zero. , Memory layout is the same as for the dump , routine. org execov lda three ;Ask for time count stop spb spmess,2 lda six ;Ask for OFF spb spmess,2 lda wait1 ;Reset counter sta pct spb messg,2 ;Acknowledge dec pcr spb dskb,2 ;Ask for disk spb dskop,2 z12 3 ;and read in tape subroutine dec treqst z20 tap+2 ;Indirect to disk address bru * !!Page 142 spb relin,2 ;Relinquish disk spb treqst,2 ;Now rewind 3 sel 1 rwd ,3 lcrwd:oct 0 ;Flag word dld .link.,3 ;Set up linkage spb insert,2 sta lclist ;Save entry point dld ld3,3 ;Date move constant mov sdate+1 lmo ;Reset various indicators sta in sta perin spb time,2 ;Get time dst ld2,3 ;and set in message spb messg,2 ;Type heading line dec ldm spb lexec,2 ;Exit and wait lda lcrwd,3 ;wait for rewind to finish bze bru 2,1 bcs brw,1 bru 2,1 ;Exit if all not OK spb treqst,2 ;Read in label sel 1 rtb ltap,3 %30 oct 0 spb lexec,2 ;Exit and wait lda *-2,3 ;wait for label to come in bze bru 2,1 ;Exit if not ldx zero,2 ;Prepare to compare labels labcom:dld ltap,2 ;Check label out dcb labl,3 bru lderr bru *+2 bru lderr ;No match inx 2,2 ;Step pointers inx 2,3 bxl 20,3 ;Count bru labcom ldx 8K,3 ;Restore register lda ltap1 ;Get code word bpl bru lderr ;all over if plus spb mess,2 ;Type message dec ltap ;type out label spb treqst,2 ;and read tape sel 1 !!Page 143 rtb lcr1,3 ;Read in first record %2050 ;Many words... oct 0 ;Completion indicator spb lexec,2 ;Exit and return lda *-2,3 bze bru 2,1 dld ldar3,3 ;Ready, so get buffer addresses dst lcbuf ldo sta dstkaf ;Inhibit relinquishes lloopa:dld lcbuf ;Get areas xaq ;Switch them dst lcbuf ;and save lda lcread+2,3 ;Get read tape instruction ext mask11 ;get rid of address add lcbuf ;add new address [buffer area] sta lcread+2,3 lcread:spb treqst,2 ;Now read again sel 1 rtb --,3 ;Constructed %2050 lcrdw:oct 0 ;Completion indicator spb lexec,2 lda lcrdw,3 ;Wait for tape bze bru 2,1 ;Exit if not ready srd 2 ;Now check for EOF bod bru lcend ;Crump if so sld 1 ;Else check for EOT bod bru lswtch ;Go switch tapes if so lda lfila+3,3 ;Wait for last disk operation to finish bze bru 2,1 ;not done ldx lcbuf,2 ;Get address lda 0,2 ;and pick up code words sta lfila+2,3 ;and set in parameter list lda 1,2 ;Get number of words sto lfila,3 ;and set in file parameter list inx 2,2 ;Step adress lda z2 ;Get it sta lfila+1,3 ;and set in parameter list spb dramb,2 ;Now use disk dec lfila ;and write out previous record bru lloopa ;Keep going else !!Page 144 lswtch:spb messg,2 ;Type message dec lo7 spb treqst,2 ;Now rewind 3 sel 1 rwd ,3 oct 0 ;Flag spb lexec,2 ;Exit and wait on switch 2 ldz rcs sla 2 ;Check [console switch] 2 bno bru 2,1 ;If not down, exit lda sign ;Switch handlers to 7 ory lcread+3,3 ory lcend+3,3 spb treqst,2 ;Read label from 7 and beware clods who sel 1 ;don't rewind tapes rtb ltap,7 %30 oct 0 spb lexec,2 ;Exit and wait lda *-2,3 ;and check completion word bze bru 2,1 ;and exit if not ready ldx zero,2 ;Set up for label scan lswcom:dld ltap,2 ;Check labels dcb labl,3 bru lderr ;no match bru *-2 bru lderr ;no match inx 2,2 ;Step pointers inx 2,3 bxl 20,3 ;Count bru lswcom ldx 8K,3 ;Restore register lda ltap1 ;Check key word bnz ;had better be zero bru lderr ;no, so error bru lloopa ;Else get back and keep going lderr:spb messg,2 ;Bad error, abort run dec lw lcend:spb treqst,2 ;Rewind 3 - or 7 if that is the case sel 1 rwd ,3 !!Page 145 oct 0 ;Completion indicator spb lexec,2 ;Exit and wait lda *-2,3 ;on the indicator bze bru 2,1 ;Exit if not ready spb tclos,2 ;Just to close up tape stx ovtsk,1 ;Erase task to link ldz sta dstakf ;unfudge spb relin,2 ;Give disk back bru icrump ;and crump lexec:ldx lclist,1 ;Get entry point stx lcpoin,2 ;and save exit bru 1,2 ;now get right back link: ldx lcpoin,2 ;Get entry point bru 1,2 ;and return .link.:spb link,1 ;Entrance linkage dec -1 ld3: dec ld1 ;Date move constant dec -5 ldar3:dec lcr1 ;Buffer areas dec lcr2 lfila:z37 32 ;Disk parameter list dec lcr1+2 ;memory address oct 0 ;Disk address oct 1 ;Flag word [completion indicator] oct 0 ;Make sure is odd ddc 0 bss -3 ldm: oct 377777 ;LDM must be odd $$$$$$$$$$$$$$$$$$$$$$$$$ alf DIS alf K L alf OAD !!Page 146 alf . alf & & & ld1: alf & & & alf & & & alf & & & alf & & & alf & & & alf & & T alf IME ld2: alf & & & alf & & & alf & HO alf URS oct 373755 labl: bss 0 ;LABL must be even $$$$$$$$$$$$$$$$$$$$$$$ oct 377777 alf DAR alf TMO alf UTH alf & CO alf LLE alf GE alf TIM alf E-S alf HAR alf ING alf & SY alf STE alf M D alf ISK alf & DU alf MP- alf LOA alf D T alf APE alf S. oct 606037 lo7: bss 0 ;Put tape 2 on handlr 7. Toggle 0 oct 377777 ;when ready. alf PUT alf & TA alf PE alf TWO alf & ON alf & HA alf NDL alf R 7 alf . T !!Page 147 alf OGG alf LE 2 alf & W alf HEN alf & RE alf ADY oct 333755 lw: alf WRO alf NG alf TAP oct 253337 oct 375577 , ********************************************* , Do not go above 37500--tape sub. overlay , ********************************************* org ta ;Leave tape some room - temporary storage lcbuf:bss 2 ;Buffer flip-flops lclist:bss 1 ;Entry save lcpoin:bss 1 ;Exit save tcd lovwrt stl ;Tape operations routine - called by overlays ejt !!Page 148 , TREQST is a tape operations routine , that may be called from either API or non- , APi routines. Return is immediate, and a flag , will be set in the last word of the calling , sequence to indicate completion. Non-API , systems using it must do a *SET PBK* before , entering and a *SET PST* after control is , returned to them , As many as six requests will be , stacked up at one time, and the operations , will be executed in the order that they are , received. , TREQB is entered when error correcting is to , be left up to the program. , Calling sequence... , A spb TREQST, 2 , A+1 sel x where x is a plug , A+2 zzz yyyy, H op, loc, handler , A+3 NNNN number of words , A+4 --- completion indicator , The flag at *A+4* is set to zero upon , entrance to the tape routine, and is set non- , zero upon completion of an operation. , The codes for operation completion are , as follows... , 1 indicate op successful , 2 indicates end-of-tape sensed , 4 indicates enf-of-file sensed , 20 indicates an error was encountered , 40 indicates the request was not , accepted because there were too many , requests stacked up, so try later , Upon sensing an error, the program , attempts to correct it seven times. If the , calling program specified that it was to do , its own error correcting, then no more action , is taken, otherwise a console typewriter , message is typed out and action is left up , to the operator. org pernum dec 14 dec tap !!Page 149 org execov bss 320 ;Save space for other routines treqst:ldz ;Error correcting to be done internally bru *+2 treqb:lda ovflo ;Error correcting to be done by program sta terf,3 ;Set error flag treqe:spb tinit,1 ;Initialize entrance - else ldx tpoin,1 inx 1,1 ;Step pointer and check bxh 6,1 ;for wraparound ldx 8K,1 ;Re-initialize if end of table lda ttab,1 ;Check next entry bnz ;If non-zero, then table full bru trful ;too many requests stacked up stx tpoin,1 ;Save pointer sta 4,2 ;Reset flag in calling sequence stx temp,2 ;and get caller lda temp add terf,3 ;add error correcting indicator sta ttab,1 ;and set in table inx 4,2 ;Step for return lac ;Set timer add seven sta tlaps,3 ;Set timer dld .tint.,3 ;and get entry bru insert ;and insert in task list tint: ldx txpoin,2 ;Points to entry to be processed lda ttab,2 ;Check if this is the correct entry bmi ;If negative, then error corrector has it bru 2,1 ;So punt for now stx rawt,1 ;Save entrance point sta z2 ;Get pointer to SPB list lda 1,2 ;Get select instruction sta tcw,3 lda 2,2 ;Instruction and memory locations sta tcw+1,3 lda 3,2 ;Get handler and length sta tcw+2,3 spb ttest,1 ;Test for tape ready ldx txpoin,2 ;Get pointer again lda sign ;Set sign in table for error corrector ory ttab,2 lda seven ;if so, initialize error counter sta tcnt texec:ldx rawt,1 ;Get entry lda 1,1 ;Set error corect entry into list sta 0,1 !!Page 150 tcw: bss 1 ;and execute instructions - select bss 1 ;op and loc bss 1 ;handler and length bru 2,1 tchk: stx rawt,1 ;Save entry spt ttest,1 ;and check for ready oct 2554007 ;Yes, check for error [Not 235 inst list] bru tercor ;yes, go correct tccpt:ldx txpoin,1 ;Get execution pointer lda ttab,1 ;and pick up spb location sta z3 ;and live dangerously [z3 normally has 8K] ldz ;free entry sta ttab,1 oct 2554002 ;and then for end-of-tape add two oct 2554001 ;Check for end-of-file add four oct 2554007 ;and then if 19 toggled add o20 ;If so, set bit 15 on bze ;Test for all OK ldo ;If so, set odd sta 4,3 ;and set in spb file [list?] ldx 8K,3 ;Reset register inx 1,1 ;Step pointer for execution to next entry bxh 6,1 ;Check for wraparound ldx 8K,1 ;Yes stx txpoin,1 ;and save execution pointer ldx rawt,1 ;Get return ldx rawt,2 set prq ;[request interrupt] bru irase ;and erase entry , TERCOR attempts to retrieve an error seven , times, after which it transfers to TMANY , with the tape positioned after the error tercor:lda tcnt ;Check error counter bmi bru tmany ;Five [seven?] times sbo sta tcnt ;Save it lda tcw+2,3 ;Get handler and number of words ext mask11 ;and get rid of word count sta tcwx+1,3 ;and store lda tcw+1,3 ;Get instruction srd 16 ;and prepare to convert bod ;If odd, then write command !!Page 151 10/6/02 dld three ;So pick up bkw instruction srd 2 ado ;flip sld 18 ;and restore sta tcwx,3 ;and set in storage oct 2540000 ;Now execute reverse instructions tcwx: oct 0 oct 0 lda .terr.,3 ;Error entry tex1: ldx rawt,1 ;Get entry sta 0,1 ;and set in list bru 2,1 ;and get back terr: stx rawt, ;Save entry spb ttest,1 ;and check if ready bru texec ;Yes, go execute original instructions ttest:lda tcw,3 ;Get select instruction sta z2 ;and set in register lac ;Get clock oct 2554000 ;Test for ready bru ttrdy ;[controller is ready] cab tlaps,3 ;Check against timer bru ttret ;OK bru ttret ;OK add o40 ;No, type message sta tlaps,3 ;Restore and wait spb messg,2 ;Type message dec tcnr ;Tape not ready ttret:ldx rawt,1 ;Get entrance bru 2,1 ttrdy:add seven ;Step [clock] sta tlaps,3 ;Save lda swflg ;Check if billing going on bod ;If odd, then on bru ttret ;so crump bru 1,1 ;and get back , TMANY checks the error flag set on entry. , If bit 1 is on in the table entry corres- , ponding to [this thread], the calling , program will do its own error correcting. tmany:ldx tpoin,1 ;Get execution pointer lda ttab,1 ;and table entry sla 1 ;Check bit 1 bov !!Page 152 bru tccpt ;If on, then accept error and return spb messg,2 ;Else type message to operator dec ttog ;Bad tape error, 2 down to accept then tog 1 lda .twt.,3 ;Switch another entry bru tex1 ;and get out , Switch options after a tape error are , 1 down to rewrite the record after the bad , one. , 2 down to rety , both up to accept the error , then toggle 19 twt: stx rawt,1 ;Error check spb ttest,1 ;Wait for tape ready ldz ;Check switches rcs bev bru ttret ;19 not down so get out sla 1 bov bru texec ;Rewrite - but do not reset error count sla 1 bno bru tccpt ;Accept lda seven ;Else reset error counter and sta tcnt bru tercor ;Try again trful:lda sign ;Too many requests stacked up sta 4,2 ;Reset flag to indicate this bru 5,1 ;and crump tinit:lda 8K ;Initialize pointers and entries sta tpoin ado ;Fudge for first execution sta txpoin lda .trqb.,3 sta kbfdg,3 ;Set in billing lda .ldx.,3 ;Clear for next times sta 0,1 ;and set in entry point bru 0,1 ;and get back to it tclos:lda treqst,3 ;ldz sta kbfdg,3 ;Make billing harmless sta kbfdg+4,3 lda tspb,3 ;and set entrance !!Page 153 sta treqe,3 bru 1,2 ttab: oct 0 ;Table stack - 6 entries oct 0 oct 0 oct 0 oct 0 oct 0 terf:bss 1 ;Error flag indicator .tint.:spb tint,1 ;Initial entry spb tchk,1 ;Error-checking entry .terr.:spb terr,1 ;Error correct .twt.:spb twt,1 ;Toggle wait .trqb.:spb treqb,2 ;Entered when billing on .ldx.:ldx tpoin,1 ;Used to initialize tspb: spb tinit,2 ;used to close out tlaps:bss 1 ;Timing interval tcnr: bss 0 alf TAP ;Tape oct 253755 ttog: bss 0 oct 376347 ;TP 1 DW TO RWR 2 DW TO RTY TOG 19 alf & 1 alf DW alf TO alf RWR alf & 2 alf DW alf TO alf RTY alf & TO alf G 1 oct 113755 org t ;Temporary storage tpoin:bss 1 ;Stacking pointer txpoin:bss 1 ;Execution pointer tcnt: bss 1 ;Tape error count bss 1 ;Spare for re-writing due shortly !!Page 154 org k2area ;Moving patch dec execov dec -192 tapmov:dld *-2 mov treqst bru lovwrt tcd tapmov stl ;Card to tape ejt !!Page 155 , Normal call is C/T in which case decimal , cards will be written on tape four. , If it is desired to use any other options, , a handler number must be given immediately , after the C/T. You can stop there or read in , binary or full modes. These are B and F , respectively. , The program terminates on finding a quote char , or hopper empty. Decimal and full quote cards , have 0-7-8 punches in columns 1-6. Binary , quote cards have 0 in 1 and 2 and 0-7-8 in 3-6. , The program then writes and EOF. , If it is desired to skip to an EOF on the tape, , type S at the end of the options. This will , start writing over the EOF. org pernum dec 16 dec c/t org execov dld ctbup,3 ;Initialize buffer pointers dst ctbp ;in lower memory lda ty+1 ;Get control word from typewriter srd 12 ;Get first character cab cr ;see if done bru *+2 bru ctsca ;Decimal cards all set up sta perin ;Call in new next time sta z2 bhx 7,2 ;See if legal tape -- not 7 bru ctfr1 ;Question marks inx 8191,2 ;Get 8K or almost lda cttab+1,2 ;Get hander information sta ctexe+3,3 ;put in instruction ldx zero,0 ;Counter ctsc: bxh 2,0 ;See if done bru ctsca ;Start cards inx 1,0 ;Step for next time through ldz sld 6 ;Get character cab ctr1,3 ;See if binary bru cter1 ;really illegal bru ctb ;binary cab ctd1,3 ;See if decimal bru cter1 ;illegal !!Page 156 bru ctsc ;decimal all set up cab ctf1,3 ;See if full bru cter1 ;illegal bru ctf ;full cab cr bru cter1 bru ctsca ;Begin - was a carriage return cab cts1,3 ;See if skip bru cter1 ;illegal bru *+2 bru cter1 lda z0 ;See if skip last sbo bze bru cter1 ;No bru ctskip ;So skip cter1:ldz sta bzyf ;Turn off busy flag bru ild ;Question marks ctb: lda crcb1,3 ;Read card in binary sto crins1,3 ;Set up read insructions sto crins2,3 sto crins3,3 lda ctd40,3 ;Decimal 40 sto ctexe+3,3 ;words to write lda cbsyn,3 ;Normal binary synch sta cnsyn,3 ;Fill in syncword check lda cbq1,3 ;Quote card sta crok,3 ;branch for quote card check lda cbsynp,3 ;Get location of syncword sta csync,3 ;and store it in the check area sta csync2,3 bru ctsc ;and see if have an 'S' ctf: lda crcf1,3 ;Read card full sto crins1,3 ;Set up read insructions sto crins2,3 sto crins3,3 lda ctd80,3 ;Decimal 80 sto ctexe+3,3 ;words to write lda cfsyn,3 ;Full sync sta cnsyn,3 ;Fill in synchword check lda cfq1,3 ;Quote card sta crok,3 ;branch for quote card check lda cfsynp,3 ;Get location of full syncword sta csync,3 ;and store it in the check area sta csync2,3 bru ctsc ;and see if have an 'S' !!Page 157 ctsca:bss 0 ;Start everything here dld .ctst.,3 ;Get entrance spb insert,2 ;and put in task list sta ovtsk ;Save pointer sta z1 ctsca1:spb ctext,2 ;[Save exit and return] bcn ;First wait for reader bru 2,1 ldx ctbp+1,1 ;Get first buffer crins1:rcd 0,1 ;First card read instruction hcr , Instructions now set up ctcr: spb cread,2 ;Read a card and check last sync word spb ctext,2 ;Set up exit lda ctexw,3 ;See if tape write completed bze bru 2,1 ;No, so wait some more ctexe:spb treqst,2 ;Tape subroutine sel 1 wtb 0,4 %27 ctexw:oct 1 ;Flag bru ctcr ;and get another card , CREAD reads a card in proper mode, checks , syncword and quote, and then flips buffer , addresses. cread:stx cren,2 ;Save entrance cread1:lac add four ;Increment time for check sta ctime spb ctext,2 ;Set up exit ldx ctbp+1,2 bcn bru crhop ;Check hopper empty condition ldx ctbp,1 ;Get buffer pointer in index register crins2:rcd 0,1 ;Read the card hcr csync:lda 27,2 ;Get last syncword cab cnsyn,3 ;Normal syn bru *+2 ;Error message bru crok ;OK spb messg,2 dec crerm2 ;Card reader error backspace 2 and toggle 1 spb ctext,2 ldz ;Wait for toggle rcs sla 1 bno bru 2,1 ;Not yet !!Page 158 spb ctext,2 ;1 down ldz ;[I think wait for sw 1 up again] rcs sla 1 bov bru 2,1 ldx ctbp+1,2 ;Prime buffer again crins3:rcd 0,2 hcr bru cread1 ;and read again , Card read was OK - change buffers and get out crok: bss 0 ;Check for quote - filled in with a bru bru cdq ;Normal is decimal crok1:dld ctbp xaq dst ctbp sto ctexe+2,3 ;Store address in write instruction ldx cren,2 ;Get entrance bru 1,2 ;and return , Check for hopper empty crhop:lac cab ctime ;See if it should be ready bru 2,1 ;OK bru 2,1 ;OK csync2:lda 27,2 ;Check last syncword sla 1 bov bru ctter ;Terminal [exit] - write EOF and get out spb messg,2 dec cterm3 lac add cr ;Increment wait time sta ctime bru 2,1 ;and get out , Binary quote check cbq: lda 0,2 ;[First quote word] bnz bru crok1 ;OK, go on lda 1,2 sub cbqu1,3 ;Second quote word bnz bru crok1 ;OK lda 2,2 ;Third word sub cbqu1,3 bnz bru crok+1 ;Go on bru ctter ;Quote card - terminal exit cbqu1:oct 2015006 ;Binary quote , Decimal quote cdq: dld 0,2 !!Page 159 dcb cdqu1,3 bru crok1 ;OK - process bru ctter bru crok1 cdqu1:oct 777777 oct 777777 , Full quote cfq: ldx zero,0 cfql: dld 0,2 dcb cfqu1,3 bru crok1 bru *+2 ;First matches bru crok1 bxh 2,0 ;Check for done bru ctter ;Quote found inx 1,0 ;Step inx 2,2 bru cfql ;and try again cfqu1:oct 1006 ;Full quote oct 1006 , Read till end-of-file, backspace, and start ctskip:dld .ctst.,3 ;Put task in list spb insert,2 sta ovtsk ;Save where it is lda ctexe+3,3 ;Get handler sta ctskh+1,3 ext mask11 ;77777 sta ctsk1+1,3 ctskn:spb treqst,2 sel 1 ctskh:rtb io1,4 %27 oct 0 spb ctext,2 lda *-2,3 bze ;If [completion] flag zero, get out bru 2,1 sra 2 ;Check for EOF bev bru ctskn ;not yet spb treqst,2 sel 1 ctsk1:bkw ,4 ;Backspace oct 0 spb ctext,2 lda *-2,3 bze bru 2,1 ;Get out bru ctsca1 ;Start at beginning - almost !!Page 160 ctext:stx ctpoi2,2 ldx ovtsk,1 bru 1,2 , Write end-of-file. If from batch, return to , it. If not, reset flags and exit to task list ctter:lda ctexe+3,3 ;Get handler ext mask11 ;77777 sta ctter1+3,3 ;[EOF write instruction] sta ctter2+3,3 ;[Rewind instruction] ctter1:spb treqst,2 ;Tape op sel 1 wef ,4 oct 0 ;Flag ctter2:spb treqst,2 sel 1 ;Rewind now rwd ,4 oct 0 spb ctext,2 lda *-2,3 bze bru 2,1 bcs brw,1 bru 2,1 ;[Wait for both tape operations to complete] lda cmessb ;See if batch in bze bru iredy ;No ldx zero,2 ;Get batch inx batch,2 lmo sta io1 ;Front in bru pgetb ;Get batch , Normal entrance is here ctst: ldz ;Check for zero down rcs bmi bru 2,1 ;Yes, get out ldx ctpoi2,2 ;Get entrance to routine bru 1,2 ;and go there , Table of syncwords and places cnsyn:oct 2606077 ;Normal decimal sync cbsyn:oct 2001777 ;Binary cfsyn:oct 2007777 ;Full cbsynp:lda 41,2 ;Location of binary syncword after read cfsynp:lda 83,2 ;Location of full sync after read !!Page 161 , Tape handler table cttab:bss 0 z21 27 ;[0] z02 27 ;[1] z04 27 ;[2] z10 27 ;[3] z21 27 ;[4] z22 27 ;[5] z24 27 ;[6] z21 27 ;[7]Make 0 to 4 .ctst.:spb ctst,1 dec -1 ctbup:dec io1 ;Buffer pointers dec io2 , Card reader trouble cterm3:oct 372321 alf RD alf REA alf DER alf & TR alf OUB alf LE. oct 375577 , Card reader error backspace 2 and toggle 1 crerm2:oct 372321 alf RD alf REA alf DER alf & ER alf ROR alf & BA alf CKS alf PAC alf E 2 alf & AN alf D T alf OGG alf LE oct 13755 crcb1:rcb 0 crcf1:rcf 0 ctd40:dec 40 ctd80:dec 80 cbq1: bru cbq !!Page 162 cfq1: bru cfq ctb1: alf 00B ;[These 4 characters must be in alpha order] ctd1: alf 00D ctf1: alf 00F cts1: alf 00S , Lower memory org ta ctbp: bss 2 ctpoi2:bss 1 ;Master return cren: bss 1 ctime:bss 1 loc 6000 ;Put tape subroutine on the end of this ctfix:lda tap+2 ;Disk address of subroutine sta *+5 bcs brn,0 bru *-1 ctfix1:sel 0 prf ,0 oct 0 bcs brn,0 bru *-1 sel 0 rrd 3,0 %treqst bcs brn,0 bru *-1 bcs ber,0 bru ctfix1 bru lovwrt ;Now go and load tcd ctfix stl ;System loader ejt !!Page 163 , The system loader will load a time-sharing- , compatible system from the card reader. , Transfer to the end card on index register , 2 and index group zero, and expect a return , to 1,2. The loader will then write the , system on the disk and read in the next , card. It terminates on a hopper-empty , condition. It also checks for cards , loaded into illegal addresses, namely all , those not in between 1400 and 33777. It , works while time-sharing is running by , asking the D-30 to start a batch run. This , prevents wiping people out. , After an overlay has been loaded, the loader , expects to find the length of the overlay, , raised to the next highest multiple of 64 , words in the A register. org pernum dec 18 dec sys ;SYStem org execov lda o10 spb spmess,2 ;Start batch bru 2,1 ;return to exec lda three ;Ask for clock off spb spmess,2 lda kermes ;Error message sta mbx0 ;will crump batch dld .sin.,3 ;Insert task spb insert,2 sta ovtsk ;and save where spb messg,2 ;Acknowledge message dec pcr lda 8K ;and initialize sta spoin ;task pointer sta io1+41 ;Synchword sta in ;Reset system indicator sta perin ;Knock out overlay-in-memory indicator lac ;and set interval add seven sta slapse lda swdct1,3 ;Word count mask sta swdct lda saddr1,3 ;Address mask sta saddr lda soctct1,3 ;One bits for octal correction module !!Page 164 sta soctc lda sign ;Construct mask sra 5 sta smask ;3760000 lda wait1 ;Upper bound check sta pct ;set return to wait loop sta slim ldz ;Clear memory sta io2+40 sta sx3sv rcs ;to contents of switches bod bru sinx ;[but not if 19 down?] sta sl1 dld sl2,3 mov sl1 sinx: lda .sin1. sto spoin set prq ;Set prq to get started bru slret ;and wait in loop sin1: spb srchk,2 ;Check reader rcb io1 ;Read first card hcr ;and crump the silly thing lda .swn. ;Set pointer sto spoin bru slret ;and get out swn: spb srchk,2 ;Set pointer for main routine lda .sld. sto spoin dld io1 ;and check card dsu .swon1,3 ;Check if first card is system loader bze xaq bnz ;If not, process it bru sld dld io1+2 ;Else check next word dsu .swon2,3 bze xaq bnz ;If unequal, process bru sld rcb io1 ;If matches, crump this card hcr bru slret ;and get out !!Page 165 10/7/02 sin: ldz ;All entries begin her rcs ;Check switch 0 bmi ;If down, crump bru 2,1 ldx spoin,2 bru *+1,2 bru sld ;[Main routine] bru sror ;Checksum error bru sdsk ;Write system on disk bru 2,1 ;Return and do nothing bru 2,1 ;Not used now bru 2,1 ;Not used now bru sin1 ;and initial sequence bru swn ;First card check .sld.:equ zero .sror.:equ one .sdsk.:equ two .styp.:equ three .sin1.:equ six .swn.:equ seven srchk:bcn ;Check reader bru schk ;not ready lac ;Set timer add seven sta slapse bru 1,2 ;and get back schk: lda io1+41 ;Check syncword for hopper empty sub .schk,3 bze ;If empty, completely done bru syend !!*************************************************** !!JSM: ERROR?: The instruction below was originally !! bru 2,1 !!which has the effect of making the coding beginning !!immediately afterwards (starting with 'lac') !!unreachable. The unreachable code checks a !!countdown timer on the card reader and types an error !!message if it remains "not ready" when the countdown !!expires. This behavior is inconsistent with other !!peripheral- (and specifically card reader-) handling !!code, and I think it was an updating error--that is, !!the bru 2,1 was intended for somewhere else. !!I replace the original instruction with a 'nop', !!as shown below. !!*************************************************** nop ;jsm *****ERROR was bru 2,1 lac ;Else check time cab slapse bru slret bru slret ;Crump add cr ;and set it up if over sta slapse spb messg,2 dec scrn ;Card reader not ready bru slret sld: spb srchk,2 ;This is the main routine - check reader dld sr2,3 mov io1 ;Move card image into working area sta z1 ;Initialize word pointer !!Page 166 sta sdiskf ;Blank flag lda io2,1 ;Begins in lower bank... get first word bze ;Octal corrections module bru soct ldx sx3sv,3 ;Keep same bank as before ext swdct ;Mask off all but word count bze ;If none, transfer card bru stran rcb io1 ;and get next card hcr snext:sra 13 ;Get word count right-justified sta z0 ;and set in counter lda io2,1 ;Get word again ext saddr ;and get address bmi ;If negative, Dartmouth-style card sdart2:bru sdart1 ;Change loader to take Dar cards sto z3 ;Else set in register and leave bank lda z3 ;Check if too low ext smask cab mendt bru serad ;Crump bru *+1 ;OK smore:inx 1,1 ;Increment working area pointer lda z3 ;Check where storing for too far up ext smask cab slim bru *+3 ;OK bru serad ;Crump bru serad lda io2,1 ;Get next word sta 0,3 ;and put away add io2-1,1 ;Checksum bov ;If overflow, step by one ado sta io2,1 ;and save across card inx -1,0 ;Decrement counter inx 1,3 ;Step address counter bxh 1,0 ;and check if end of block bru smore ;No, get some more words sub io2+1,1 ;See if checkword OK bnz ;Checksum error bru ser1 inx 2,1 ;Get next origin lda io2,1 ext swdct ;and leave word count bnz ;If words, get them bru snext stx sx3sv,3 !!Page 167 slret:ldx 8K,3 ;Reset register ldx ovtsk,1 ;Get return bru 2,1 ;and get out soct: rcb io1 ;Octal corrections module hcr bru socte ;and begin scanning soctb:sra 10 ;Get left half ext soctc ;and mask off sign and high-order end nor 16 sla 1 ;Check for word lda socacc ;Get accumulated word so far bov ;overflow if word bru soctd bxl 2,3 ;Nothing so far, keep scanning bru socte bxl 3,3 ;Terminate on single character field bru slret bxh 7,3 ;6 or 7 character is instruction bru soctf sta socadd ;Else address socte:dld zero ;Zero out A, Q, and register 3 sta z3 bru socta-1 ;and check card soctd:sld 3 ;Accumlate characters ext 0 bno chs sta socacc ;and save socta:inx 1,3 ;Step character count immediately bxh 40,1 ;and check if end of card bru slret lda soctc lqa ;Put some one bits in Q lda io2,1 ;Get word bxl 1,2 ;Check if end of word spb soctb,2 ;No, get first half inx 1,1 ;Else get next word ldx zero,2 ;and reset flag bru soctb+1 soctf:ldx socadd,3 ;Get address counter sta 0,3 ;and put away word inx 1,3 ;Bump up counter stx socadd,3 ;and save !!Page 168 bru socte ;and get some more sdart1:ldx 8K,3 ;Reset register lda sdart,3 ;Change instructions sta sdart2,3 ;to assume all rest will be Dartmouth-style sta sdart3,3 lda socte+1,3 sta sdart2+1,3 sta sdart3+1,3 bru snext+2,3 ;Get back stran:lda io2,1 ;Transfer card bmi ;If negative, Dartmouth upper memory sdart3:ldx 8K,3 ;If first of kind, transfer correctly sto z3 ;else stay in bank lda z3 ;Save location sta xr03 lmo ;Reset flag for correct exit sta sdiskf sxg 0 ;Set group zero for system set pst ;and prepare to exit API set pbk ;with no interrupts ldx 8K,3 ;Restore register bru *+2,3 bru 0,3 ;Transfer spb *-1,2 ;Save return for systems rcb io1 ;Now get next card - as well as generate hcr ;interrupt on 225 ldx z3,3 ;[API register 3 to current register 3] sta sleng ;Length of overlay sra 6 sto sdksb+1,3 ;Number of records for operation lda sname+1,3 ;See if overlay bnz bru *+3 lda so140,3 ;System to put 96 records back sto sdskb+1,3 lda .sdsk. ;Return is to here sto spoin ;and set pointer set pst set prq ;Set prq bru wait ser1: ldx 8K,3 ;Set up register lda .sror. !!Page 169 sto spoin ;and set pointer spb messg,2 dec schksm ;Checksum error - backspace two cards sror: ldz ;toggle 2 when ready. rcs ;Check 2 sla 2 bno ;Not down, crump bru slret spb srchk,2 rcb io1 ;OK hcr lda .sld. sto spoin ;and set it to load bru slret serad:stx sx3sv,3 ;Address out of bounds ldx 8K,3 ;Restore register spb messg,2 ;and type message dec silad bru slret ;and get next card sdsk: ldx zero,2 ;Set register for search lda sname,3 ;Get name sdsk1:cab sytab,2 ;Search address table bru *+2 bru sfnd ;Found inx 1,2 ;and step pointer bxl last,2 ;Check end of table bru sdsk1 ;OK sta ssno1,3 spb messg,2 dec ssno ;System not available bru icrump sfnd: lda .styp. ;Set up to do nothing while writing on disk sto spoin ;and set in pointer lda sname+1,3 ;Get replacement or overlay number sto sylo2,3 ;set in overlay message sto *+1,3 ;and set for step to get address inx 0,2 ;Step pointer by identifying number lda sytab+1,2 ;Get correct disk address sta sdksb+3,3 ;Set in parameter list lda sname,3 ;Get system name again ldx 8K,2 ;and initialize for search sfnd1:cab snames,2 ;Check against list of system names bru *+2 ;Not found !!Page 170 bru *+3 ;Found OK inx 3,2 ;Keep searching bru sfnd1 ;and try again sta syl1,3 ;Get names and set in typewriter message lda snams+1,2 ;Second word sta syl1+1,3 lda snams+2,3 ;Third word sta syl1+2,3 spb messg,2 ;Output system name dec syl ;System lda sname+1,3 ;Get identifying number and see if overlay bze ;If zero, then system bru sfnd2 ;so punt spb messg,2 ;Else type overlay number dec sylo lda sleng ;See if overlay fits in space sra 5 ;Position for disk command sub two ;translate to zero add sdskb+3,3 ;Disk address ext mask1 ;3777400 sub o300 bpl bru sler sfnd2:spb dskb,2 ;Ask for disk sdksb:spb dskop,2 ;and write system on disk z37 96 ;write, 96 records dec system ;from system location z00 -- ;constructed disk address bru sterm ;Error - crump works spb relin,2 ;Relinquish disk sdskb2:lda .sld. sto spoin ldz ;Reset lower bank sta sx3sv bru sld ;Process sler: spb messg,2 dec stlo ;Overlay too long bru sdskb2 ;Continue sterm:spb messg,2 ;Type no-load message and crump as disk error dec snol ;No load bru icrump ;and punt syend:lda sdiskf ;Check for silly clods who leave off bmi ;extra blank !!Page 171 10/9/02 bru icrump ;OK spb messg,2 ;Else type message dec sblank ldx ovtsk,1 spb irase,2 ;and delete entry lda four ;Ask for count spb spmess,2 bru iresp ;and reset pointers snams:alf BAS ;BASIC oct 313277 oct 777777 alf ALG ;ALGOL oct 464377 oct 777777 alf XBA ;XBASIC alf SIC oct 777777 alf XAL ;XALGOL alf GOL oct 777777 alf FOR ;FORTRAN alf TRA oct 457777 alf XFO ;XFORTRAN alf RTR oct 214577 alf DIP ;Dartmouth Interpretive Program alf & & & alf & & & alf TSA ;Time-Sharing Assembly Processor alf P alf & & & alf EDI ;EDIT system alf T alf & & & .sin.:spb sin,1 ;Entry dec -1 sl2: dec sl3 dec -13566 sr2: dec io2 dec -40 .swon1:ldo ;First four words of system loader card sta pmbx0 .swon2:bcs brn,0 bru 2 !!Page 172 saddr1:oct 1760000 ;Leave address swdct1:oct 2017777 ;Leave word count soctc1:oct 3776000 ;Upper end mask so140:oct 140 ;96 records sdart:add 8K ;Instruction change for Dartmouth cards .schk:oct 3001777 ;Hopper empty check sl1: eqo 1400 sl3: eqo sl1+1 syl: bss 0 ;System oct 373737 syl1: alf & & & alf & & & alf & & & oct 375577 sylo: bss 0 ;Overlay # alf OVE alf RLA oct 707777 oct 601360 sylo2:alf & & & oct 375577 scrn: bss 0 ;Card reader not ready oct 372321 alf RD alf REA alf DER alf & NO alf T R alf EAD oct 703337 oct 557777 schksm:bss 0 ;Checksum error, backspace two cards and oct 372330 ;toggle 2 when ready alf ECK alf SUM alf & ER alf ROR alf , B alf ACK alf SPA alf CE alf 2 C alf ARD alf S A !! Page 173 alf ND alf TOG alf GLE alf & 2 alf WHE alf N R alf EAD oct 703337 oct 557777 silad:bss 0 ;Address out of bounds oct 372124 alf DRE alf SS alf OUT alf & OF alf & BO alf UND oct 623337 oct 557777 ssno: bss 0 ;System not available oct 376270 alf STE alf M N alf OT alf AVA alf ILA alf BLE oct 777760 ssno1:alf & & & oct 333755 snol: bss 0 ;No load. oct 374546 alf & LO alf AD. oct 375577 sblank:bss 0 ;*** Missing blank *** oct 373754 alf *** alf & MI alf SSI alf NG alf BLA alf NK alf *** oct 543755 stlo: bss 0 ;Overlay too long !!Page 174 oct 374665 alf ERL alf AY alf TOO alf & LO alf NG oct 375577 org t ;Temporary storage spoin:bss 1 ;Routine pointer slapse:bss 1 ;Elapsed time counter for card reader sx3sv:bss 1 ;Register 3 save swdct:bss 1 ;Word count mask saddr:bss 1 ;Address mask soctc:bss 1 ;High-order mask soctacc:bss 1 ;Word accumulator soctadd:bss 1 ;Address slim: bss 1 ;Upper limit smask:bss 1 ;Mask for all high-order bits above 16K sdiskf:bss 1 ;Disk flag for missing blanks sleng:bss 1 ;Overlay length tcd lovwrt ;end stl ;Debugging package - DBGOUT, DBGOCT, DBGCOM ejt !!Page 175 , These debugging routines are called from , the console typewriter. , The commands are... , *DBGOUT* to dump on the printer with HSMP , *DBGOCT* to use the octal insert routine , *DBGCOM* to get a communications dump , CHAR is a character pickup routine that , takes characters from ty and places them one , at a time in the A register. , OUT takes parameters inputted from the , console typewriter and will dump from the , specified locations onto the high speed , printer. , The format is as follows , OUT xxxxx,xxxxxx$ where $ stands for , a carriage return. Embedded blanks and , other non-numeric characters are ignored. The , dump will be from the location before the , comma to the location after. OUT, will , dump from 0, but the other parameter must , be there. , OCTAL takes the input before a colon and sets , it in the location counter. A comma causes , the previous input to be stored in the , address of the counter, and increments it by , one. [The format is...] , OCTAAAAA,XXXXXXX,YYYYYYY, etc. , OCTAL without an address will save the pre- , viously used one - zero if not initialized , WARNING...8, 9 are treated as zero , DUMP is a modified version of GE's high- , speed printer memory dump. The dump , is entered with from and to adresses in , A and Q. It uses two separate buffer areas , for printing from. org pernum dec 20 dec dbg !!Page 176 org execov spb bgtoff ;Ask time stop lda sloc1,3 ;Get accumulated counter so far sta sloc lda com3,3 ;Set up test registers sta com1 lda col3,3 sta col1 dld dumpmb,3 ;Setup some more constants for HSMP dst dmpmsk lda ty+1 ;Check if OUT or OCTAL cab comnic,3 ;Communications debugging bru sdel ;No, error bru combug ;Debug communications system cab oct,3 ;OCTAL bru sdel ;No bru octal cab out,3 ;HSMP dump bru sdel ;No bru HSMP cab bgtim,3 ;Check for clock-set bru sdel ;No bru bgtime bru sdel ;Not found at all, error char: bxl 2,2 ;2 must be initialized at plus two bru char23 ldx zero,2 char2:inx 1,1 ;and increment one lda ty,1 ;Get word sta ch3 ;and break up sra 6 sta ch2 sra 6 char1:ext mask7 ;Get rid of all but character bru 1,3 ;Exit char23:lda ch2,2 ;Get next character inx 1,2 ;and increment pointer bru char1 hsmp: dld zero sta temp ;and temporary storage dst z0 sta z2 sta rawt spb char2,3 ;and get character cab com1 ;Check for comma bru *+2 ;No bru ocom ;Yes !!Page 177 cab cr ;and check for carriage return bru *+2 bru ocr ;Yes common:cab seven ;Check if less than 7. bru *+3 ;OK bru *+2 bru char ;Ignore and get another bxh 7,0 ;Check if more than 7 bru sdel inx 1,0 ;Increment counter srd 3 add temp ;Save character and build word sld 3 bov ;If overflow, sign bit set add sign sta temp ;Save word bru char ;and get out ocom: lmo ;Reset flag sta rawt lda temp ;Get word sta dumpbg ocomon:ldz ;Reset counters and storage sta temp sta z0 bru char ocr: lda rawt ;If no comma yet, crump bpl bru sdel lda temp ;Get to location lqa lda dumpbg ;and from in A ldx 8k,3 spb dump,1 bru oct3 ;Get out octal:dld zero ;Initialize registers sta temp dst z0 sta z2 spc char2,3 ;Get character cab col1 ;Check for colon bru *+2 bru scolon ;Found cab com1 ;Check for comma bru *+2 bru scomma ;Found !!Page 178 cab cr ;and carriage return bru common bru scr bru common scolon:lda temp ;Get location sta sloc ;Set in counter bru ocomon ;and reset storage scomma:stx rawt,2 ;Save register stx dtmp,3 ;Save register 3 spb scom1,2 ldx rawt,2 ldx dtmp,3 ;Restore 3 bru char ;and get another character scom1:ldx sloc,3 ;Get location lda temp ;and store word there sta 0,3 inx 1,3 ;Bump up address counter stx sloc,3 ;and save ldz ;Reset sta temp sta z0 bru 1,2 scr: spb scom1,2 ;Act as if comma ldx 8K,3 lda sloc ;Restore location counter sta sloc1,3 oct3: bru icrump ;and get out sdel: ldx 8K,3 ;Restore register spb messg,2 ;Illegal task dec del bru oct3 ;and crump , COMBUG is used to debug communications by , patching out certain selected locations in , the main body of the executive. In place , of the original instructions, which it saves, , it places branches to printout routines, , which dump the lower-lower storage area, , and the inserted tasks in iplst. combug:bss 0 lda cbuga,3 ;The routine is terminated by stop. sta cbugas,3 !!Page 179 lda cbugb,3 ;Exit patch sta cbugbs,3 lda icrump,3 ;Crump location sta cbugcs,3 lda .coma.,3 ;and set in mailbox receipt routine sta cbuga,3 lda .comb.,3 ;Get exit patch sta cbugb,3 lda .comc.,3 ;and patch out crump sta icrump,3 sta perin ;Destroy system-in indicator spb messg,2 ;Type ready dec rea spb bgton,2 ;and ask for ON bru 2,1 ;and get back coma: stx dtmp,2 ;Entry from mailbox spb bgtoff,2 ;Ask for OFF bcs bpn,6 ;and slew to top of page so we can bru *-1 ;see what we're doing sel 6 slt 8 dld obug1,3 ;Get first set of locaitons spb dump,1 ;and dump dld obug2,3 ;Dump save area spb dump,1 dld obug3,3 ;iprior-iplst spb dump,1 bcs bpn,6 ;and slew extra four lines in between bru *-1 sel 6 slw 4 spb bgton,2 ;Ask for ON again ldx dtmp,2 ;and return bru cbuga+1,2 ;and branch to list comb: sta dtmp ;Exit-debugging dump spb bgtoff,2 ;Ask for OFF dld obug3,3 ;Third set spb dump,1 dld obug2,3 ;Second set spb dump,1 ;and dump dld obug1,3 ;First set spb dump,1 ;and dump spb bgton,2 ;Ask for ON lda dtmp ;Get answer again sta mbx0 ;and set in mailbox !!Page 180 bru cbugb+1 ;and get back comc: lda cbugas,3 ;Restore debugging entries sta cbuga,3 lda cbugps,3 ;Restore second patch sta cbugb,3 lda cbugcs,3 ;Icrump restore sta icrump,2 bru icrump ;and get back bgtoff:lda three ;Ask for time count stop bru spmess bgton:lda four ;Ask for time count resumption bru spmess , BGTIME converts a time entered in hours and , minutes to octal 6ths of a second for the , real-time clock. The call is DBGTIM , followed by the hours, then a colon, then the , minutes. [A final $ is required for the time , to take effect.] bgtime:dld zero ;Initialize some areas dst z0 sta z2 sta temp ;and temporary storage sta rawt spb char2,3 ;and then get characters cab col1 ;Check for colon bru *+2 ;No bru bgcol ;Yes, go process cab cr ;Check for carriage return bru *+2 ;No bru bgcr ;Else go process cab ten ;Check for digits bru bgcon ;Yes, convert them bru char ;Else continue scan bru char bgcon:bxh 2,0 ;Check if over two characters bru sdel ;If so, crump mpy ten ;Else convert to binary inx 1,0 ;and step counter bru char ;and get next character !!Page 181 bgcol:ldz ;Colon mpy h1 ;Get hours in sixths of a second bnz ;Check for too many bru sdel ;If so, crump laq ;Else get them sta dumpx ;and save them lda rawt ;Check if second time or fudge carriate ret bod bru bgdon ;Two colons will also do lda two ;Colons will reset if more than one sta rawt dld zero ;Re-initialize sta z0 ;and reset counter bru char ;and get some more characters bgcr: lda rawt ;Check if colon previously bnz ;Yes, OK bru *+4 ldo ;Else pretend colon sta rawt bru bgcol ;and go process hours ldz ;Get minutes in sixths of a second mpy h2 laq add dumpx ;add hours bgdon:ldx 8K,3 bmi ;Check if too large by far bru sdel cab bgmax,3 ;and check if over 24 hours bru *+3 ;No, OK bru *+2 ;Still OK bru sdel ;Dummy... sta dumpx ;Save for later spb bgton,2 ;ask for time count dld .bgst.,3 ;Get entry for table spb inset,2 sta ovtsk ;and make crumpable spb messg,2 ;Type message dec rea bru irest ;and get back bgst: lda pct ;Check for TON bpl bru 2,1 ;If so, get out sna 19 ;Else get character sub bgkey,3 ;[Check if $] bnz ;If not, keep trying bru 2,1 !!Page 182 lda dumpx ;Else get time lca ;and set in C register add four ;Set various timers according to new clock sta int1 add three sta dival sta hdskd add h2 bmi ;Check too large bru *+4 cab bgmax,3 ;Check for too close to midnight bru *+3 ;OK bru *+1 ;[too] close lda bgmax,3 ;Too close sta itim add k3loc bmi bru *+4 ;Too large cab bgmax,3 ;Check for close to midnight bru *+3 ;OK bru *+1 ;[too] close lda bgmax,3 sta .eff spb time,2 ;and type out new time dst bgnew1,3 spb messg,2 ;and type message dec bgnew spb irase,2 ;and erase task ldz ;Zero out flags sta ovtsk sta bzyf ;and busy flag bru irest ;and crump dump: stx dumpx1,1 ;Save return ext seven ;From A to Q sta dumpbg ;Save starting address bcs bpn,6 ;Wait for printer ready bru *-1 sel 6 slw 4 ;Slew page 4 lines laq ;Get ending address ext seven ;Mask out low order end sta dumped dld dumpbk,3 ;Get buffer addresses dst dumpio ;and set in flip flops sto dump1x+1,3 ;as well as a couple of other places !! Page 183 sto dump04,3 sta z3 ldx 8K,2 ;Set register lda dumpbl ;Get blanks sta 0,3 sta 40,3 ;Buffer areas differ by 40 inx 1,3 ;Increment area inx 1,2 ;Count bxl 35,2 ;and test bru *-5 ;No add sign ;Make last entries negative blanks sta 0,3 sta 40,3 ldx 8K,2 ;Initialize registers ldx dumpbg,3 bru dumpad dumpov:stx dumpx,3 lda dumpx sub dumped ;Test for end dump bpl ;If finished dumping, get out bru dumpex lda 0,3 ;Repetitive sub 8,3 ; edit by lines bnz ;Not alike bru dumpit inx 1,3 ;Test next bru dumpov dumpwb:lda 0,3 ;Get word srd 18 ;Position for build ext dmpmsk ;oct 3777774 - mask out high-order bits add dmpbbz ; with leading blanks dump1x:ext sign ;Insure plus sta 0,2 ; in image [modified instruction] inx 1,2 ;Count bru 1,1 ;Return dumpbd:sla 3 ;Build sld 3 ; 3 sla 3 ; characters sld 3 ; in dumpa1:sla 3 ; A reg. sld 3 ; from Q reg. bru dump1x ;and go store dumpit:inx 8,3 ;Catch up on index dumpad:stx dumpx,3 ;pointer lda dumpx ext seven sta dumpbg ldx dumpbg,3 !!Page 184 stx dumpx,3 srd 12 ;Position add dmpbbz ; and blank fill spb dumpa1,1 ;convert spb dumpbd,1 ;and store dumpwd:spb dumpwb,1 ;Set sign and bit 1 spb dumpbd,1 ;Build 7 spb dumpbd,1 ; characters per word inx 1,3 ;Count for next word bxl 26,2 ;Test end of image bru dumpwd ; no. inx 1,2 ;Leave a blank space before BCD dump ldx dumpx,3 ;Build BCD portion of line dump03:lda 0,3 inx 1,3 ;Step block counter spb dump1x,1 ;Go store bxl 35,2 ;Test for end-of-line bru dump03 bcs bpn,6 ;Wait for printer bru *-1 sel 6 oct 2600000 dump04:add 0,1 ;[Constructed ...] ldx 8K,3 dld dumpio ;Get addresses and switch xaq dst dumpio sto dump04,3 sto dump1x+1,3 ldx dumpbg,3 ldx 8K,2 bru dumpov ;Get back dumpex:ldx dumpx1,3 ;Get return location ldx 8K,3 ;and restore x3 bru 1,1 ;and return dumpbk:dec dumpa ;Dump buffer areas dec dumpb obug1:dec t+16 ;Dump quite a bit dec sclock obug2:dec kclosk dec mkpr1-1 ;Dump save area obug3:dec iprior dec eplst-1 dumpmb:oct 3777774 ;Mask alf & & 0 ;and leading blanks .bgst.:spb bgst,1 ;Entry to set time in register dec -1 bgnew:oct 374525 ;New time is... !!Page 185 alf W T alf IME alf & IS bgnew1:alf & & & alf & & & alf & HO alf URS oct 333755 dumpa:bss 40 dumpb:bss 40 sloc1:dec 0 ;Location counter out: alf OUT oct: alf OCT comnic:alf COM .coma.:bru coma .comb.:bru comb .comc.:bru comc com3: oct 73 ;Comma col3: oct 15 ;Colon bgmax:oct 1764370 ;Nearly 24 hours [518392 D = 23:59:58:4] bgkey:oct -53 ;Dollar sign bgtim:alf TIM ;Time check constant cbugas:bss 1 cbugbs:bss 1 cbugbc:bss 1 org t ;Temporary storage dumpio:bss 2 ;Flip-flop for print areas dumpbg:bss 1 ;Block currently being typed (must be even) dumped:bss 1 ;End of print block (must be in order) dmpmsk:bss 1 ;oct 3777774 - these must be in order and dmpbbz:bss 1 ;the above must be even dumpx:bss 1 ;Index register 3 temporary save dumpx1:bss 1 ;Dump entry save sloc: bss 1 ;Location counter for octal insert ch2: bss 1 ;Character storage - they must be in order ch2: bss 1 com1: bss 1 col1: bss 1 dtmp: bss 1 tcd lovwrt stl ;Lister for GAP tapes ejt !!Page 186 10/10/02 , This routine will list a GAP assembly tape , [from handler] 3 provided it is written in , binary print-line images. , It will also punch the corresponding binary , deck. , 1) EJT cards will cause a slew but will , not be printed , 2) NAM cards will change the title as , in regular GAP assemblies , 3) REM cards will be printed with the op , code delted and the remarks field , shifted over two words. org pernum dec 22 dec G/P org execov lda 8K ;Initialize to rewind tape 3 sta gpoin dld .gst.,3 ;and set up branch in list spb insert,2 sta ovtsk ;Save where sta z1 ;and save exit register ginit:dld gareas,3 ;Initialize buffer areas dst gin dst io1 ;Reset start load area ldz ;Set page flag for first time sta gejtf lda dumpbl ;Clear out title line lqa dst gtl,3 inx 2,3 bxl 40,3 bru *-3 lda mask6 ;oct 3000000 sta gtl-1,3 ;and set page count to zero ldx 8K,3 ;and restore register , This is the common entrance point gst: bcs btn,1 ;Check on tape bru 2,1 bcs bpn,6 ;and printer bru 2,1 bcs bef,1 ;Ignore end-of-files bru gread0 ;Get select instruction lda swflg ;Check if billing on !!Page 187 bod ;is on if odd bru 2,1 rcs ;or switch 0 down bmi bru 2,1 ldx gpoin,2 ;Get routine pointer bru *+1,2 bru grwd ;[0] Rewind bru gprm ;[1] Prime buffers bru gslt ;[2] Slew to top of page bru gslw ;[3] bru gp0 ;[4] Pass 0 bru gp1 ;[5] Pass 1 bru gp2 ;[6] Pass 2 bru gjt ;[7] Eject bru gpun ;[8] Punch card bru gcon ;[9] and search for next assembly .gprm.:equ one .gslt.:equ two .gslw.:equ three .gp0.:equ four .gp1.:equ five .gp2.:equ six .gjt.:equ seven .gpun.:dec 8 ;These must be indexed grwd: sel 1 ;Rewind tape 3 rwd ,3 lda cmessb ;Check batch flag bze ;if not on, continue spb mesg,2 ;Acknowledge dec pcr spb gslt8,2 ;and slew to top of page lda .gprm. sto gpoin bru 2,1 gprm: bcs brw,1 ;Wait for rewind bru 2,1 bpn ;and punch bru 2,1 sel 1 rtb io1,3 %40 dld io1 ;Scan for GAP Pass 0 message dcb ggap,3 bru 2,1 ;Exit if not !!Page 188 bru *+2 ;yes bru 2,1 ;no, so exit lda .gp0. ;Set for pass 0 sto gpoin spb gslew,2 ;Slew two lines spb gslew,2 ;Slew total of 6 lines first time spb gslew,2 bru 2,1 gslt8:lda gpoin ;Save pointer sta gpsav stx gpsav+1,2 lda .gslt. sto gpoin bcs bpn,6 ;Wait for printer bru gex ;and crump if not ready gslt: sel 6 ;Slew to top slt 8 ldx gpsav+1,2 ;Restore registers lda gpsav sta gpoin ldz sta gline bru 2,1 ;and return gslew:lda gpoin ;Save pointers sta gpsav stx gpsav+1,2 lda .gslw. ;and set for slew two lines sto gpoin bcs bpn,6 ;Wait for printer bru gex gslw: sel 6 slw 2 ldx gpsav+1,2 ;Restore registers lda gpsav sta gpoin bru 2,1 ;and return gp): dld gin ;Pass 0 - get buffer addresses sta z2 sto gprnt1,3 xaq dst gin sto gread,3 lda mblnk ;Preset end of line !!Page 189 sta 24,2 lda 0,2 ;and check for end of pass 0 sub gend1,3 bnz bru gprnt ;no dld 2,2 ;Check rest of field dcb gpass,3 bru gprnt ;no bru *+2 ;yup bru gprnt lda d54,3 sta gline ;and set line so it will slew next time lda .gp1. ;and set for Pass 1 sto gpoin bru gprnt gp1: dld gin ;Get last used address sta z2 ;and put in register xaq ;flip dst gin ;re-save sto gread,3 lda sign ;Set negative bit beforehand ory 23,2 ;Do not print sequence numbers lda 0,2 ;Check for end pass 1 sub gend1,3 bze spb gp1chk,1 ;Check it out lda 2,2 ext gzone,3 ;Check for zone bits bze bru *+4 gp1b: lda z2 ;Get read-in address sto gprnt1,3 bru gprnt ;and print - no unpacking lda gin+1 ;Get address add d30 ;and increment for expanded symbol table sto gprnt1,3 ;and set up for instruction sta z1 ;and register 1 add d36,3 neg ;Construct end-of-line sto gpck2,3 ;End of line test gpack:dld 0,2 ;Get symbol dst 0,1 ;and put away in expanded line dld gibn,3 ;Get special blanks sta 2,1 ;put away first part lda 2,2 ;Get address of symbol sta 3,1 ;put away msh lda 3,2 ;Get lsh dst 4,1 ;and put away with trailing blank !!Page 190 inx 6,1 inx 4,2 gpck2:bxl *,1 ;Test end-of-line bxl gpack bru gprnt ;and print the stupid line gp1chk:dld 2,2 ;Check rest of field dcb gpass,3 bru 1,1 ;No bru *+2 bru 1,1 lda d54,3 ;Yes, pre-set for slew sta gline lda .gp2. ;Set for pass 2 sto gpoin dld gin ;Modify addresses to leave for punch sto gidnt1,3 sto temp dad go100,3 dst gin sto gread,3 ldx zero,1 ;Set up for identifying card punch dld gident,3 gidnt1:dst 0,1 ;Set in spare buffer inx 2,1 ;Count bxl 26,1 ;and check for buffer filled bru gidnt1 ;Still more ldx temp,1 ;Get address wcd 0,1 ;and punch card bru gp1b ;and get back gp2: ldx gin,2 ;Get area last read into lda 40,2 ;and check residue word bze bru gpunch bpl ;If greater than 40 words, ignore bru gread0 lda sign ory 33,2 ;Set minus sign in word dld gin sto gprnt1,3 ;and print instruction xaq ;Flip dst gin ;and save sto gread,3 ;and set in tape instruction lda 0,2 ;Get first word and check for ENDGAPPASSES sub gend1,3 bze spb gp2chk,1 ;Check out rest of field lda 10,2 ;Now get op code - damn fool odd word !!Page 191 srd 18 lda 9,2 ext gmask,3 ;This is the odd word sld 6 ;Now get the whole op code cab gejt1,3 ;and check for EJT bru gprnt ;no bru gejt cab gnam1,3 ;[Check for NAM] bru gprnt bru gnam cab grem1,3 ;REM bru gprnt bru grem gprnt:sel 6 ;Print the line z26 -- gprnt1:add -- lda gline ;and now check for end of page ado sta gline sub d54,3 bpl bru gejt ;Yes, eject and print title if called for gread0:sel 1 ;Tape read gread:rtb io1,3 %40 gex: ldx ovtsk,1 ;Get entry point bru 2,1 ;and get out gejt: lda gline ;Check if just slewed to top of line bze ;If so, bru gread0 ;ignore ejt card spb glst8,2 ;Else slew to top of page spb gslew,2 ;and slew two lines lda gpoin ;Then check for pass 2 ext 8K sub .gp2. bnz bru gejt2 ;no lda .gjt. ;Set for heading line sto gpoin bcs bpn,6 ;Check out printer bru gex ;and wait if not gjt: sel 6 ;Print heading line z26 -- z03 gtl,1 lda gtl+39,3 ;Page number !!Page 192 set decmode ;and step add gejtf ;with flag set binmode sta gtl+39,3 ;and restore ldo ;and set flag for subsequent times sta gejtf lda .gp2. ;and restore pointer sto gpoin bru gread0 gejt2:spb gslew,2 ;Slew two lines at top bru gread0 gnam: lda gin+1 ;Last area read into add d17,3 ;and get remarks field - we hope add smove1 ;and construct move instruction sta *+2,3 dld gnam2,3 mov -- grem: dld grem2,3 ;Get constant lda gin+1 ;Then buffer address add d11,3 ;and step to remarks field add smove1 ;Construct move sta *+2,3 sub two ;and move remarks field over two left mov -- ;on page lda dumpbl ;Blank out end of line lqa dst 30,2 ;blank end-of-field sta 9,2 sta 10,2 ;This should get rid of damned remark bru gprnt gpunch:lda .gpun.,3 ;Punch binary card sto gpoin gpun: bpn ;Check out punch bru gex dld gpmov,3 ;Get Q portion for move lda gin ;Area last read into add smove1 ;and construct instruction sta *+3,3 sub o100 ;and set down to multiple of 128 sta z2 mov -- wcb 0,2 lda .gp2. ;Return to pass 2 sto gpoin bru gread0 !!Page 193 gp2chk:lda 1,2 ;Check rest of field if end sub gend1+1,3 bnz bru 1,1 dld 2,2 dcb gend2,3 ;Check for PASSES bru 1,1 ;no bru *+2 bru 1,1 spb gslt8,2 ;Slew page spb gslt8,2 ;Again dld gin ;Set addresses back as originally dsu go100,3 dst gin ldx ovtsk,1 ;Get entry point lda .gcon.,3 ;and set up for continuation sta 0,1 lac ;and set timer in case tape runs away add six sta gpsav gcon: bpn ;Wait for punch so as not to wipe out last bru gex ;transfer card lda swflg ;Check billing flag bod ;if odd, then billing on bru 2,1 ;billing on... rcs ;and then check switch 0 bmi bru 2,1 ;If down, crump bcs btn,1 ;Else check tape bru gtchk ;if not ready, go check lda gline ;and search six entries from tape ado sta gline sub ten bpl bru gendp ;The P is for permanent lac ;Step timer if OK add six sta gpsav dld gin ;Get addresses sto gread,3 ;and do it backwards xaq sta z2 dst gin dld 0,2 dcb ggap,3 ;Check for GAP 0 bru gread0 !!Page 194 bru *+2 bru gread0 lda .gst.,3 ;Get original entry sta 0,1 ;and set up lda .gprm. ;Set for buffer printing sto gpoin ldx zero,2 ;Set up for end identifier dld gident,3 dst io2,2 inx 2,2 ;Count bxl 26,2 ;and check bru *-3 wcd io2 sel 1 ;Now read tape backwards rbb io1,3 %0 bru ginit ;and set for new listing gtchk:lac ;Check if time up sub gpsav bmi ;No, then keep on bru 2,1 lda .gst.,3 ;Get original entry and prepare to hang sta 0,1 ;tape completely as it is running awat gendp:sel 1 rwd ,3 ldx zero,2 ;Set up for end identifier dld gident,3 ;Set up for last card dst io2,2 inx 2,2 ;Count bxl 26,2 ;and check bru *-3 wcd io2 spb gslt8,2 lda cmessb ;Check batch flag bze bru iredy ;normal crump if off ldx ovtsk,1 ;Else recall monitor spb irase,2 ldz ;Reset pointer sta ovtsk sta z2 inx batch,2 ;Get monitor lmo sta io1 ;Set front card in bru pgetb !!Page 195 gtl: bss 40 ;Title line gnam2:dec gtl ;Move constant dec -15 .gst.:spb gst,1 .gcon.:spb gcon,1 gareas:dec io1 dec io2 gend1:alf END alf GAP gend2:alf PAS alf SES gpass:alf & PA alf SS gibn:oct 603535 ;Fudge blanks alf & & & ggap: alf GAP ;Starting checker alf & 0 gpmov:dec 0 dec -40 ;Forty words to a binary card go100:oct 100 ;Buffer-areas-adjust constant oct 100 gident:alf ABC alf DEF grem2:oct 0 dec -21 gejt1:alf EJT gnam1:alf NAM grem1:alf REM d11: dec 11 d17: dec 17 d30: dec 30 d36: dec 36 d54: dec 54 gmask:oct 3770000 gzone:oct 3171717 org t ;Temporary storage gin: bss 2 gpoin:bss 1 gpsav:bss 2 gline:bss 1 gejtf:bss 1 ;Page count flag tcd lovwrt ;End stl ;Sysout lister ejt !!Page 196 , SYSOUT lister , The sysoute lister will process tapes written , by batch or any tapes in the same format. , It can be called directly from the batch , ovrlay or from the console typewriter. , If it is called from BAT it checks to see , which tape was written on last, and waits , until the proper tape is on handler seven. , If called by the typewriter it assumes the , tape is already on seven. , It automatically flip-flops between handlers , 6 and 7. , The tape format is two control words followed , by the data. Each has either the word count , or zero in word two (almost). All numbers , are octal. , Start output file 0 in both words , Print 1 in the low-order end of , word one, the high order , high order bits of control , word one. Word two has the , length in the low-order , end and the high-order , is the same as the high , order part of controller , word two. , Set format 2 in word one. This record , contains the horizontal , format information to be , used in all subsequent , print with format records. , Word count in two. , Punch decimal 7 in word one, count in two , Punch binary 10 in one, count in two , Punch full 11 in one, count in two , End of output file 20 in one, 0 in two , An EOF indicates the end , Buffers used , sio1 600 80 words - punch , sio2 720 40 words - print , sio3 770 40 words - format line , sio4 1040 110 words - tape read-in , sio5 1217 110 words - tape read-in !!Page 197 , Flags and things , slbufp Buffer flip-flop upper , sllen Words left in each buffer lower , sllen2 Words used in first buffer lower , slcon Control words upper , slbuff Buffer to use upper , The tape subroutine was put on the end at , load time. org pernum dec 24 dec S/O org execov dld .sle2.,3 spb insert,2 ;Put in task list sta ovtsk ;Save place in list spb messg,2 ;Acknowledge receipt dec pcr ; with carriage return spb treqb,2 ;Now rewind 7 sel 1 rwd ,7 oct 0 ;[Completion] flag spb slext,2 ;Set up exit lda *-2,3 bze bru 2,1 ;Not ready bcs brw,1 ;Now see if done rewinding bru 2,1 ;No bcs bpn,6 bru 2,1 sel 6 ;Start with a slew slt 8 , Prime both buffers - sio4 and sio5 spb slrnr,2 ;Read spb slrnc,2 ;Wait and compute length spb slrnr,2 ;Get next one sllst2:lda slbufp,3 ;Find beginning of output sta z2 ;Get buffer address dld 0,2 ;See if start dcb zero bru *+2 ;Nope bru sllst3 ;OK spb slrnc,2 ;Wait for last read spb slrnr,2 ;Get next record bru sllst2 ;and check again sllst3:sta sllen2 ;Initialize !!Page 198 bru slgp ;and start , Subroutine to get next record. Entered on 2. , Will check the buffer flip-flop read into the , first and exchange them. slrnr:stx slt1,2 ;Save entrance dld slbufp,3 ;Buffer pointers sto slrnr1,3 ;Set for read xaq dst slbufp,3 ;and exchange spb treqb,2 ;Tape routine sel 1 slrnr1:rtb sio5,7 %110 slrnrf:oct 0 ;flag dld sllen ;Length xaq ;switch also dst sllen ldx slt1,2 ;Get return back bru 1,2 , Will compute length of record just read by , SLRNR and store in length list. Maximum , record length is 110 words. , Exits with length in A slrnc:stx slt1,2 ;Save entrance spb slfxt,2 ;Set up exit lda slrnrf,3 ;Check flag bze bru 2,1 ;Not ready , If EOF found, then end of sysout tape sra 2 ;Check flag for EOF bod bru slend ;Finished lda slrnr1,3 ext mask10 ;3700000 sta z1 ;Address read into lda 110,1 ;Get residue word bpl ;Make sure record is not too long bze bru slrnc1 ;OK ldz ;Bad bru *+2 slrnc1:add sd110,3 ;Now have length sta sllen+1 ;and save ldx slt1,2 ;Get return bru 1,2 ;and get back , Pull out the parameter words and make an !!Page 199 , initial check on them. slgp: bss 0 lda slrf,3 ;See if another buffer needed bpl bru slgp1 ;No lda sllen ;yes, so fudge length back sta sllen+1 dld slbufp,3 ;Flip buffers back xaq dst slbufp,3 spb slrnr,2 ;get buffer sta slbf,3 ;Reset read flag - return is positive slgp1:lda sllen ;and change length pointers bnz bru slgp2 sta sllen2, spb slrnc,2 ;Check last read done spb slrnr,2 ;and get more bze bru *-3 ;I can go in circles too. slgp2:sub two sta sllen lda sllen2 ;Words used sta z2 add two sta sllen2 lda slbufp,3 ;Buffer pointer sto slgp3,3 ;set up loads ado sto *+1,3 lda *,2 ;Modified to come from right buffer sta slcon+1,3 ;Save control words slgp3:lda *,2 sta slcon,3 ext mask7 ;Just save low order - 3777700 sta z2 bxl 3,2 ;Make first check on control words bru slo2 ;Set up buffer 2 - print bxl 10,2 bru slo1 ;Set up buffer 1 - punch bxl 17,2 bru slcon1 ;Control record bru slill ;Illegal control word slo1: lda sdio1,3 ;dec sio1 sta slbuff ;Buffer to move to ldz sta slmin ;Set for punch bru slmov ;yes, move in !!Page 200 slo2: lda sdio2,3 ;dec sio2 sta slbuff ;Buffer to move to lda so611,3 sta slmin ;Set up for print , Ready, so move , If enough words remain in input buffer, move , directly to output buffer. If not, fudge like , mad. slmov:lda slcon+1,3 ;Second control word ext slms1,3 ;3777600 sta slt2 ;Save for a while cab sllen ;Words left bru slmov1 ;OK bru slmov1 ;Still OK bru slmv ;Partial move and re-read slmov1:neg ;Set up move command xaq lda slbufp,3 ;Get buffer address add sllen2 ;get from address sto slmg2,3 ;Set up move instruction lda slbuff ;Address to move to dst slmc1+2,3 ;and constant lda sllen ;Words left sub slt2 ;get new total sta sllen ;and save lda sllen2 ;Get new total of words used add slt2 sta sllen2 spb slext,2 ;Get out ldx slmin,2 ;Either printer or punch oct 2556007 ;Either printer or punch bru 2,1 slmg: dld slmc1,3 ;Get to address and length slmg1:mov 1 ;Filled in dlc slmc1+2,3 ;Second move slmg2:mov 1 ;Filled in sta slmc1+1,3 ;Reset move constant bru slexe ;and execute , Not enough words left in present buffer slmv: sub sllen ;Get left-over words sta slt2 ;Temp location lda sllen ;Get words to move neg xaq lda slbufp,3 ;Buffer address add sllen2 ;make from address sto slmg1,3 ;Set up move instruction lda slbuff ;Move to !!Page 201 dst slmc1,3 ;move constant , Compute next move-to address add sllen sta slbuff spb slpnc,2 ;Get length info on last read sta sllen ;Length left in A after calculation dld slbufp,3 ;Flip buffers manually xaq dst slbufp,3 lmo sta slrf,3 ;Set read flag for slgp ldz sta sllen2 ;Reset words used lda slt2 ;Get number of left over words bru slmov1 ;and enter middle of move routine , Will pick up instructions and execute them slexe:lda slcon,3 ;Get first control word ext mask7 ;get code 3777700 add 8K sta z2 ;Have upper memory branch bru *+1,2 bru slsta ;Start file bru slpri ;Print bru slfor ;Format line bru slgp ;Illegal next control word bru slgp bru slgp bru slgp bru slpud ;Punch decimal bru slpub ;Binary bru slpuf ;Full , Print routine slpri:lda slcon,3 sta slprie+1,3 ;Get control words lda slcon+1,3 sta slprie+2,3 lda slforf ;Format address, if any sto slprie+1,3 ;put in instruction lda sdio2,3 ;Buffer address sto slprie+2,3 slprie:sel 6 oct 0 ;Filled in earlier oct 0 bru slgp ;and start again , Set up format line slfor:dld slform,3 ;Format move constant mov sio2 ;to format line lda sdio3,3 !!Page 202 sta slforf ;Put in format address bru slgp ;and continue slpud:wcd sio1 ;Punch decimal bru slgp slpub:wcb sio1 ;Binary bru slgp slpuf:wcf sio1 ;Full bru slgp , Illegal control code so compute where to find , next useful record slill:lda slcon+1,3 ;Get length ext slms1,3 ;3777600 cab sllen bru slill2 ;Can stay in same record bru slill2 sub sllen ;Get words left over sta slt2 spb slrnc,2 ;Wait spb slrnr,2 ;Get next one lda sllen ;Get new length sub slt2 sta sllen lda slt2 sta sllen2 ;Words used bru slgp ;Start again slill2:bss 0 ;Stay in same buffer lqa add sllen2 ;Get new words used sta sllen2 xaq ;Get A back sub sllen neg ;Now have words left again sta sllen bru slgp ;and continue , Start output file - 27-word image of name card slsta:lda slbufp,3 ;Buffer address add two sto *+2,3 ;Set up move dld slsta1,3 ;Get card image to punch area mov -- ;Filled in lda sign ory sio1+26 spb slext,2 ;Prepare to exit bcs bpr,6 ;Test both printer bpn ;and punch bru 2,1 ;Get out sel 6 wpl sio1 ;Name line !!Page 203 ldz sta sllen bru slpud ;Punch card and continue slsta1:dec sio1 dec -27 , Examine control records - these are by them- , selves. slcon1:bxl 16,2 ;Check to see if legal bru slill ;Yes , End of output file spb sslt8,2 ;Slew to top of page spb slext,2 bpn bru 2,1 ldx zero,2 dld sliden,3 ;Pretty last card dst sio1,2 inx 2,2 bxl 26,2 bru *-3 wcd sio1 bru sllst2 ;and look for zeros slend:spb treqb,2 ;Tape routine sel rwd ,7 ;Rewind 7 oct 1 ;Set to done spb tclos,2 ;Close out tape routine spb sslt8,2 ;Slew to top of page bru iredy ;and all done sliden:alf ABC alf DEF , Normal entrance is here sle2: ldz rcs bmi ;punt if zero is down bru 2,1 ldx slpoi2,2 ;Set up re-entrance bru 1,2 ;and go there , Slew to top of page sslt8:stx slt1,2 ;Save entrance spb slext,2 !!Page 204 bcs bpn,6 bru 2,1 sel 6 slt 8 ldx slt1,2 ;Get back bru 1,2 , Enter on 2 - sets up exits slext:stx slpoi2,2 ldx ovtsk,1 bru 1,2 ;and get back slrf: dec 0 ;Read flag - minus if read necessary aftr move .sle2.:spb sle2,1 slms1:oct 3777600 sd110:dec 110 slbufp:dec sio4 ;Flip-flop buffer addresses dec sio5 sdio1:dec sio1 sdio2:dec sio2 sdio3:dec sio3 slform:dec sio3 ;Format-move constant dec -40 slmc1:dec 1 ;Move constants dec 0 ddc 0 slcon:ddc 0 ;Control word storage so611:oct 611 ;used to change punch to printer org ta ;Storage for lister after tape subroutines sllen:bss 2 ;Words left sllen2:bss 1 ;Words used slt1:bss 1 ;Temp storage slt2:bss 1 ;Temp storage slforf:bss 1 ;Format line address or zero slpoi2:bss 1 slbuff:bss 1 ;Buffer to use slmin:bss 1 ;Used to index bpn loc 6000 slfix:bss 0 ;Get tape subroutine on end lda tap+2 ;Disk address of subroutine sta *+5 bcs brn,0 bru *-1 !!Page 205 slfir:sel 0 prf ,0 oct 0 bcs brn,0 bru *-1 sel 0 rrd ,3 %treqst bcs brw,0 bru *-1 bcs ber,0 ;Check errors bru slfir bru lovwrt ;now go and load tcd slfix stl ;Time-Sharing Operations Summary ejt !!Page 206 , This efficiency summary of time-sharing , computes the following information , and writes it on the disk every ten , minutes... , 1) Percentage of running time over total , on-time. , 2) Percentage of swap time over on-time. , 3) Percentage idle time over total on-time. , 4) Percentage disk times other than swap over , total on-time. , The operation summary is called every ten , minutes through the wait loop. It keeps a , summary for half-hour periods, then re-initia- , lizes itself for the next half-hour period. org pernum dex 26 dec summry org execov dld .eff1.,3 ;New entry spb insert,2 sta z1 ;and save return bru 2,1 ;and get out eff1:bss 0 spb irase,2 ;Delete entry otherwise spb dskb,2 ;Pick up previous summary spb dskop,2 z12 1 dec fclock oct 402 nop ;[Ignore error return?] spb relin2, ;and get rid of disk ldx zero,1 ;Else move summary into area lda fkedit,1 sta f4,1 inx 1,1 ;Step pointer bxl fkbat-f3,1 ;Test for end bru *-4 lda fclock bze bru fsumr ;Need to reset everything lac ;Check time sub fclock ;Get elapsed time sta flapse ;and check for bmi bru fsumr ;If past midnight, restart everything !!Page 207 10/11/02 lda fcnt ;Check for over half hour ado ;step sta fcnt ;and store bru fcrest ;Now compute fsumr:ldz ;Re-initialize sta fclock dld fmid,3 ;Midnight mov fclock sta acrun ;Zero accumulated counters sta acswap sta acdisk sta acbat sta flapse ;and zero out elapsed time sta z1 lac ;Reset counters and pointers sta fclock sta acstrt ;accumulated start spb time,2 dst fstim dst astim+2 lda F4,1 sta fkedit,1 inx 1,1 ;Step bxl fkbat-f3,1 ;Test for end bru *-4 fcrest:bss 0 spb time,2 ;Get time for output line dst ssump+2,3 ;set in line lda fkstrt sta ftem ;Temporary location spb pcent,2 ;Compute percentage running time sta ssr,3 ;Run time lda fkdump ;Swap times add fkntnu ;Dump 6 and continue sta ftem+1 spb pcent,2 ;Compute percentage of swap times sta sss,3 ;Swap time lda fkread ;Read-ins add fkwrit add fkedit ;Edits as well add fktea ;and teach, for want of a better place sta ftem+2 spb pcent,2 ;Compute percentage miscellaneous sta ssm,3 ;Misc. time lda fkbat ;Get batch time sta ftem+3 spb pcent,2 ;Compute percentage batch sta ssb,3 ;Batch time !!Page 208 lda flapse ;Get elapsed time sub ftem ;and try to ensure 100 percent sub ftem+1 sub ftem+2 sub ftem+3 bmi ldz ;Make it look nice spb pcent,2 ;Get percentage idle time sta ssi,3 ;Idle time dld .effe.,3 ;Efficiency intermediate entrance spb insert,2 sta ovtsk ;Save location sta z1 ;In case printer not working dld fstim ;Get starting time dst ssump+10,3 ;Set in print line fcre2:bcs bpn,6 ;[Allow printouts to be omitted] bru fcre21 ;Just punt if not ready sel 6 wpl ssump ;Summary printout spb eexit,2 bcs bpn,6 bru 2,1 ;Wait again sel 6 slw 2 ;Slew two lines spb eexit,2 bcs bpn,6 bru 2,1 sel 6 wpl ssump+6 ;Get short summary spb eexit,2 bcs bpn,6 bru 2,1 fcre21:lac ;Get accumulated times sub acstrt sta flapse lda ftem add acrun spb pcent,2 sta ssr,3 lda ftem+1 add acswap spb pcent,2 sta sss,3 lda ftem+2 add acdisk spb pcent,2 sta ssm,3 lda ftem+3 !!Page 209 add acbat spb pcent,2 sta ssb,3 lda flapse sub acrun sub acswap sub acdisk sub acbat sub ftem sub ftem+1 sub ftem+2 sub ftem+3 bmi ldz ;Make pretty spb pcent,2 sta ssi,3 fcre3:bcs bpn,6 ;[Allow printouts to be omitted] bru fcre31 ;punt if not ready sel 6 ;Know printer is ready slw 2 ;Slew 2 lines dld astim2 ;Set time for long run summary dst ssump+10,3 spb eexti,2 bcs bpn,6 bru 2,1 sel 6 wpl ssump+6 ;Write long run summary spb eexit,2 bcs bpn,6 bru 2,1 sel 6 slw 4 ;Slew four lines spb irase,2 ;Get rid of task , See if necessary to reset summary lda fcnt ;Check half-hours sub three bmi bru fcre4 ;OK, so punt , Time to restart so add to accumulated things lda ftem add acrun sta acrun lda ftem+1 add acswap sta acswap la ftem+2 add acdisk sta acdisk !!Page 210 lda ftem+3 add acbat sta acbat ldz ;Restart sta fclock dld fmid,3 mov fclock sta z1 lac sta fclock ;Starting time spb time,2 dst fstim lda f4,1 sta fkedit,1 inx 1,1 bxl fkbat-f3,1 ;Check for end bru *-4 fcre4:spb dskb,2 ;and get disk spb dskop,2 ;and write out summary z37 1 ;Write, 1 record dec fclock ;From summary area oct 402 ;Disk address nop ;Should never return here, but punt if it does spb relin2, ;Relinquish disk lac ;and set interval for next time add finc,3 bmi ;Check for too large bru *+4 cab fmid1,3 ;Check for midnight bru *+3 ;OK bru *+1 lda fmid1,3 ;Too close sta .eff ldz ;Reset busy flag sta bzyf bru 2,1 ;and get out pcent:maq ;Compute percentage mpy fcent,3 ;Get one extra digit dvd flapse ;and get percentage twice as large ado ;Round upwards srd 20 ;Get in Q less one bit dvd ten ;Convert to decimal cab finc2,3 ;Check for funny case bru pcent1 ;OK bru *+1 ;Yes lda finc3,3 ;Get 100 percent bru 1,2 ;and get out pcent1:bze ;Check for leading zero lda o60 ;replace by zero if so !!Page 211 sla 6 ;Shift to middle add blzz ;and get rid of high-order zero sta mstemp+1 ;First character laq ;Remainder is second add mstemp+1 ;and total up bru 1,2 effe:ldx epoi2,2 ;Get correct re-entrance bru 1,2 ;and go there eexit:stx epoi2,2 ;Temporary exit ldx ovtsk,1 bru 1,2 ;and just go back , Print lines for printer summary ssump:alf TIM alf E alf & & & alf & & & oct -606060 oct 0 alf SUM alf MAR alf Y F alf ROM alf & & & alf & & & alf & & & alf RUN ssr: alf & & & alf &% alf SWA oct 473535 sss: alf & & & alf &% alf BAT oct 233035 ssb: alf & & & alf &% alf MIS oct 233535 ssm: alf & & & alf &% alf IDL oct 253535 ssi: alf & & & oct -746060 .eff1.:spb eff1,1 !!Page 212 .effe.:spb effe,1 dec -1 fmid: dec flapse dec f1-f2 finc: oct 7020 ;10 + fraction finc2:dec 10 finc3:alf 100 fcent:dec 200 ;Percentage constant fmid2:oct 1764375 ;[23:59:59 3/6] dec f2 ;Just to reference them [?] dec f3 org t epoi2:bss 1 loc 6000 , Check for printer fpc: ldx 8K,3 ldz rcs sra 1 ;See if switch 18 down bev bru lovwrt ;No, so load bru *+2 ;If so, no printer nop lda *-1 ;Get NOP sta fcre2,3 ;and place in test instructions sta fcre3,3 spb $ertyp,2 ;and type message dec *+2 bru lovwrt ;and load oct 3777777 ;No printer alf NO alf PRI alf NTE alf R. oct 375577 tcd fpc stl ;Card scan ttl ;Background monitor overlays !!Page 213 , The batch overlay processes cards for , background operation, reading and scanning , cards on an API bases, looking for either , asterisk-blank-blank type cards, or SCC card , Action on control cards may be of , several types. , 1) If the card type is not in the catalog, , it is completely ignored, and the next card , is considered. , 2) If the card can be processed completely , within this overlay, that is done, and the , overlay then considers the next card. , 3) If the card can be processed, or calls , another overlay (a LIST perhaps) then that , overlay is called with provision for return , to the BATCH overlay on completion of that , task. , 4) If the card calls for the execution of a , major program, then the OBA2, or OBA3 overlay , is called in, and control transferred to , them. , Batch mode terminates on a hopper empty , conditio, or a STOP from the console , typewriter. org pernum ;Loading information for exec dec 28 dec batch ;Name of overlay org execov ;Is standard overlay location. spb messg,2 ;Acknowledge call with a carriage return dec bcr sta io1+27 ;Set sync word off to a start dld .bent.,3 ;Insert task into API list spb insert,2 sta ovtsk ;and save return location sta z1 lda bper3,3 sta bper ;and put period character into lower array ldo sta cmessb ;Set CMESSB right lda io1 , BFFLG is a 3-way flag. It is minus if a front sta bfflg,3 ;card has been found, 0 if needs one, and , positive if it needs a back card. bpr ;To keep my many friends, check the punch for bru *+3 ;for them !!Page 214 spb messg,2 ;Type them a message dec bpnr ;Punch not ready bru bcd ;and go to normal read bcr: oct 375577 ;Carriage-return message - given on entrance bper3:oct 33 ;Period - used in card-scan terminate check. bcom: eqo 37700 , Normal entrance is here bent: bss 0 ldz rcs bmi ;Check console switches bru 2,1 ;and if negative, crump lda typf ;Don't even bother if message being typed bnz bru 2,1 ldx bpoin2,2 ;Set up return bru 1,2 ;and execute it bc1: oct 546060 ;[*-blank-blank] bc2: oct 54243 ;[(* ) - (SCC) (maybe the opposite)] bcd: spb bcard,1 ;Card processing loop - get a card lda io1 ;Pick up first character sub bc1,3 ;check for asterisk bze bru *+4 sub bc2,3 bnz ;Check for SCC bru bcd ;Non-control, so crump dld zero dst t ;Set scan array 0 dst t+2 , ---Card scan routine--- , Scans a card in IO1, skipping first 6 , columns, and putting all non-blank characters , into T through T+3. It terminates on , reaching column 42, or finding a period, , or filling the fourth word of the array. , Unused characters in array become 0 ldx zero,1 sta io1+1,1 ;Set word pointer to 0 inx 12,3 ;Will use xr3 maximum of 12 characters baw1: bss 0 inx 1,1 ;Bump up word pointer bxh 12,1 ;Crump bru bex0.1 ;See if have front card lda io1+1,1 cab dumpbl ;See if all blanks bru *+2 !!Page 215 10/11/02 bru baw1 srd 12 ;Position spb baway,2 ;and put it away sld 6 spb baway,2 sld 6 spb baway,2 bru baw1 ;and go get next word baway:bss 0 ;Character put-away routine stx io1,1 ;Save calling register ldx io1+1,1 ;and get pointer to list cab o60 ;Check for blank character bru *+2 bru bblnk cab bper ;See if terminal period bru *+2 bru bex0.1 sla 0,3 ;Shift ory t,1 ;and put away inx -6,3 bblnk:bxl 1000,3 bru bawa1 inx 18,3 inx 1,1 bxh 4,1 bru bex0.1 bawa1:stx io1+1,1 ldz ldx io1,1 bru 1,2 ;and return bex0.1:bss 0 ldx 8K,3 lda bfflg,3 ;Check front card status bmi bru bex1 ;yes bze bru bex0.2 ;See if front dld t ;See if back dcb bbcard,3 bru bcd ;no bru bcback ;yes bru bcd bex0.2:dld t dcb bfcard,3 bru bcd ;Try again bru bcfrnt ;Found it bru bcd !!Page 216 bfcard:alf FRO alf NT0 bbcard:alf BAC alf K00 bex1: bss 0 ;Card scan done - do card catalog scan lda ocat+2 sta btlst+2,3 sta t+7 ;and set for disk routine bex2:bss 0 ;Enter here for each record lda btlst+2,3 ;Get disk address add two ;bump it sta btlst+2,3 spb dramb,2 ;Read in a 64-word type record dec btlst spb bexit,1 lda btlst+3,3 ;Check for operation competed bze bru 2,1 ;exit ldx 8K,2 bru baw3 ;and search this record btlst:bss 0 ;Parameter list for catalog read z12 1 ;1 record at a time oct 37700 oct 0 ;Disk address specified oct 0 ;Flag location .... , Table search to see if card type now in , matches some entry in the catalog. , All entries consist of a 4-word alphabetic , part, plus a 4-word paramater part specifying , information about the type - including , a branch location to process it. baw3: bss 0 dld bcom,2 bze bru bcdc ;Check for RUN or SYM dcb t ;Check first two words bru *+2 ;no match bru bfm ;at least first two match baw6: inx 8,2 ;Bump up catalog pointer bxh 64,2 ;Check this record searched bru bex2 ;yes - so go get next bru baw3 ;n0 - go try another entry bfm: dld bcom+2,2 ;Check second two words bmi bru baw7 ;If minus just check first two dcb t+2 bru baw6 ;No match bru *+2 bru baw6 ;No match, check again. baw7: inx bcom+4,2 lda 0,2 sta z1 bru *,1 bru bcback bru bint2 bru bint bru bctype bru bcrwnd bru bcslew bru bext bss 4 bcdc: bss 0 lda t ;Check for first word RUN or SYM cab bsym,3 bru *+2 bru bcsym1 ;Call SYM-locator cab brun,3 bru bcd bru bcsym1 ;SYM locator will also position for a RUN bru bcd bcsym1:lda .bsym1,3 ;Branch to bsym1 bru bcbat2 ;call BAT2 bcfrnt:spb bcard,1 ;Get next card first lda .bfrnt,3 ;then linkage bru bcbat2 bcback:lda .bback,3 bru bcbat2 bctype:lda 1,2 ;Get control word for halt or no-halt sta t+1 spb bcard,1 ;and get card to type lda .btype,3 bru bcbat2 bcrwnd:lda .brwnd,3 bru bcbat2 bcslew:lda .bslew,3 bru bcbat2 .bsym1:bru bsym1 .bfrnt:bru bfrnt .bback:bru bback .btype:bru btype .brwnd:bru brwnd .bslew:bru bslew , Exit to get to BAT2 bcbat2:bss 0 sta bbra ;Store branch for BAT2 set prq ;Make sure to get back spb bexit,1 ;Get out so messages can be typed spb irase,2 ;Erase present entry ldx zero,2 inx bat2,2 bru pgetb ;Get it bsym: alf SYM brun: alf RUN , Card read routine --- , Reads cards - checking for errors, EOF, etc bcard:bss 0 bcn bru beofc ldz sta io1+27 rcd io1 hcr bcard0:lac add o6o sta bclk,3 ;Start countdown on reader bcard1:bss 0 stx bpoin1,1 spb bexit,1 lda io1+27 ;Wait for card reader sync in bmi bru bcard2 lac cab bclk,3 ;Countdown on it bru *+3 ;[Unecessary instruction--could be bru 2,1] bru bcnr bru bcnr bru 2,1 bcnr: bss 0 ;Type card reader not ready and return ldx bpoin1,1 spb messg,2 dec bcnl bru bcard0 bcard2:bss 0 sub bsync,3 bnz bru bcard4 spb bexit,1 bcn bru 2,1 !!Page 219 ldx bpoin1,1 bru 1,1 ;and exit bcard4:bss 0 sla 1 ;Now check for EOF bze bru bcard3 ;EOF on read - set flag and exit spb messg,2 ;Type out card read error dec bcre spb bexit,1 ;and wait for reader ldz rcs ;to toggle switch 2 ext mask6 bze ;Wait for switch 2 down bru 2,1 ldx bpoin1,1 ;toggled bru bcard ;So try reading card again bcard3:ldo sta beof ;Set EOF on last read flag ldx bpoin1,1 ;Get entrance back bru 1,1 ;and exit. beofc:bss 0 lda beof ;Will indicate last card read bze spb messg,2 ;If not read, type out not-ready message dec bcnl ;and crump, else just crump lda bfflg,3 ;Check to see if a back card was found bnz bru bcback ;No, so make one lda fclock+2 ;Else see if using Sysout cab bno2,3 bru *+2 bru beofc0 ;No Sysout spb bexit,1 ;if so, write end-of-file bcs btn,1 bru 2,1 sel 1 wef ,7 ;Put on an EOF bru bcs/o ;and call sysout spb time,2 sta bpdo1,3 xaq sta bpdo1+1,3 spb messg,2 dec bpdo ldx ovtsk,1 spb irase,2 ;Get rid of this task from list ldz sta ovtsk sta bzyf !!Page 220 sta beof sta cmessb ;Set batch flag back to zero sta io1 bru 2,1 bno2: alf NO bclk: dec 0 ;Used to hold countdown on card reader , Exit to start listing of SYSOUT tape bcs/o:spb irase,2 ;Erase present task ldx zero,2 inx s/o,2 bru pgetb ;and get S/O bext: bss 0 ;Call in OBA overlay to execute inx 1,2 ;Get address of parameters to move down lda z2 add bmovp,3 ;Set up move sta *+2,3 dld btmov,3 dec -1 ;and move down to T-array spb bint,2 ;Call in OBA overlay alf OBA btmov:dec t+4 dec -3 ;Move down three parameter words bint2:bss 0 ;Entered for overlays that need options in TY+ lda 1,2 sta ty+1 ;Get single spca translation message inx 1,2 ;set to name , and continue bint:bss 0 ;Enter here to call peripheral overlay in 1,2 lda 1,2 ;Get name sta z0 ;save ldx ovtsk,1 spb irase,2 ldx zero,2 lda z0 ;Search for address inx com,2 cab 0,2 bru *+2 bru pgetb ;Get overlay inx 3,2 bru *-4 ;Better be in list .bent.:spb bent,1 dec -1 !!Page 221 bsync:oct 2606077 ;Good card-read sync word bmovp:z24 0 ;Used to construct moves bfflg:dec 0 ;Front card flag, minus 1 if found one bexit:stx bpoin2,1 ldx ovtsk,1 bru 2,1 bcre: bss 0 oct 372351 alf & ER alf ROR oct 333755 bcnl: bss 0 oct 372351 alf & NO alf T R alf EAD oct 703755 bpnr: bss 0 ;Punch not ready oct 374764 alf NCH alf & NO alf T R alf EAD oct 703755 bpdo: bss 0 oct 372545 alf D B alf ATC oct 306060 bpdo1:dec 0 dec 0 alf & & H alf OUR alf S. oct 373755 , *********************************************** , Stop at 37677 for catalog org t bss 4 ;Card-type build area bper: bss 1 ;Put alpha period bpoin1:bss 1 ;Index register storage bpoin2:bss 1 ;Index register storage beof: bss 1 ;EOF for card read bbra: bss 1 ;Branch for BAT2 , Make sure this is at least t+8 bdc: bss 1 ;Batch dump code - 0 for disk handler for tape !!Page 222 tcd lovwrt stl ;BAT2 - SYM, TYPE, FRONT, BACK, REWIND, SLEW ejt !!Page 223 , The BAT2 overlay processes standard control , cards which would not fit in the batch overlay. , When entered the T-array has a branch to the , desired routine. , Any card input will be in IO1. , The tape subroutine is tacked onto the end , when this is loaded. org pernum dec 30 dec bat2 ;Overlay name org execov dld .baen.,3 ;Insert task in list spb insert,2 sta ovtsk ;and save return location sta z1 lda bbra ;Get branch sta *+1,3 nop ;Branch to needed routine , Normal entrance to here baen: bss 0 ldz rcs bmi bru 2,1 ;If sw-0 down, crump lda typf bnz bru 2,1 ;Punt if typing also ldx bpoin2,2 ;Set up return bru 1,2 ;and get there .baen.:spb baen,1 dec -1 , Enter on 2 baex: stx bpoin2,2 ldx ovtsk,1 bru 1,2 , BSYM1 locates symbolic file on tape and , positions tape to read after location bsym1:lda io1+17 ;Get handler number ext mask3 ;extract plug add 8K sta z1 lda btab,1 !!Page 224 sta btmsg1+5,3 ;Construct rewind add four ;Read four words sta bsyex+2,3 ;Construct instructions spb treqst,2 ;Tape subroutine bsyex:sel 1 z05 io1 ;RTB oct 0 ;Constructed oct 0 ;Flag spb baex,2 lda *-2,3 ;Check flag word bze bru 2,1 ;Not ready bod bru *+4 sra 1 bod bru btmsg1 ;End of tape , Only other could be EOF so go on. ldx zero,1 bs1: lda io1,1 cab io1+7,1 ;See if match bru bsyex-1 bru *+2 bru bsyex-1 ;No match, try again inx 1,1 bxl 4,1 bru bs1 , Check to see if RUN or SYM. If SYM, go back , to BAT. If RUN call in OBA for tape loader. lda io1 cab bsym2,3 ;alf SYM bru *+2 ;Must be RUN bru baret-1 ;Close tape then get other ovrlay spb tclos,2 ;Close tape lda btpc,3 ;Tape constant for OBA sta t+4 ;Set in T-array ldz sta t+6 sta z2 inx oba,2 ;Get entrance to overlay call bru pgetb ;Get overlay btpc: oct 20004 ;Tells OBA to get tape loader bsym2:alf SYM btmsg1:spb messg,2 dec bet ;End of tape spb treqst,2 sel 1 z20 -- ;Rewind !!Page 225 oct 0 oct 0 ;Flag bru bartcl ;Close tape and wait for typing btab: bss 0 z21 -- ;Make 0 to 4 z02 -- ;[1] z04 -- ;[2] z10 -- ;[3] z21 -- ;[4] z22 -- ;[5] z21 -- ;6 to 4 z21 -- ;7 to 4 , Type routine - entered on reading *TYPE , card. Location 1,1 specifies type or R , type and halt - type and halt is on switch 1 btype:bss 0 lda t+1 ;Pick up control word sta btypf,3 ;Save 0 or minus 1 lda bacr,3 ;Put in EOM character sta io1+27 spb messg,2 dec io1 spb baex,2 lda btypf,3 bnz bru baretw ldz rcs bod bru baretw ;Exit to BAT1 bru 2,1 , Handle front cards - take necessary action , to sign on new user bfrnt:bss 0 lda io1 ;Get part of user number add bo606,3 ;Get rid of special characters ext bm1,3 ;3771717 bnz ;Give gas bru biluse ;illegal user number spr irase,2 ;Must erase entry before DSKB spb time,2 ;Get time into type line sta bftm1,3 sta io1+4 ;Put on front card xaq sta bftm1+1,3 !!Page 226 sta io1+5 spb messg,2 dec bftm ;Front card message , Write front card on sysout tape spb dskb,2 ;Find out what tape to use spb dskop,2 z37 1 ;Write one record dec io1 ;From IO1 z20 bfda,1 ;Indirect to front card disk address nop spb relin2, ;and relinquish disk dld zero sta bdc ;Initialize dump code dst io1-2 ;Set start control words dld .baen.,3 spb insert,2 ;Get entrance back sta ovtsk ;and save place in list lda io1+2 cab bno,3 ;alf NO - see if they want sysout bru bfrnt1 bru bfrnt2 cab bt,3 ;See if dump on tape bru bfrnt1 ;nope bru *+2 ;yes bru bfrnt1 ;nope lda bhan7,3 ;On sysout tape sta bdc bfrnt1:spb treqst,2 sel 1 wtb io1-2,7 ;Use tape 7 %29 bfrntf:oct 1 ;Flag - initialize to done bfrnt2:spb bpwt,1 ;Wait for punch wcd io1 spb bpwt,1 spb bafx,2 lda bfrntf,3 ;Wait for tape before exiting bze bru 2,1 ;Not done bru bartcl bftm: bss 0 oct 377777 alf ON alf AT bftm1:dec 0 dec 0 oct 375577 bno: alf NO ;For sysout bt: alf T ;For tape dump bhan7:oct 3000000 ;Handler bits for tape seven !!Page 227 bo606:oct 606 bm1: oct 3771717 , Illegal user number, type message and wait , for 19 to be toggled. biluse:spb messg,2 ;user. dec bilusm spb baex,2 ;Get out ldz rcs bev bru 2,1 ;Not yet spb baex,2 ldz rcs bod bru 2,1 rcd io1 hcr spb baex,2 bcn ;Wait to get in bru 2,1 bru bfrnt ;and start over bilusm:oct 376462 alf ER. oct 375577 , Handle back card - sign user off bback:bss 0 spb irase,2 ;Erase entry so can use the disk spb dskb,2 ;Ask spb dskop,2 ;Read z12 1 dec fclock ;into 600 z20 bfda,1 ;Indirect to address nop spb relin2, ;Get rid of disk dld .baen.,3 spb insert,2 ;Get entrance back sta ovtsk lda fclock+2 ;See if using sysout cab bno,3 bru *+2 bru bback3 ;No, so skip !!Page 228 spb treqb,2 ;Yes, so terminate sel 1 wtb bs/of1,7 ;Write ending record %29 bback2:oct 1 ;Initialize to done bback3:spb time,2 sta bbkm1,3 xaq sta bbkm1+1,3 spb messg,2 dec bbkm ;Back card message spb bpwt,1 lda bbwd,3 sta io1 dld bamov,3 mov io1 wcf io1 spb bpwt,1 ;Wait for punch ldz sta io1 ;Look for front card spb baex,2 lda bback2,3 ;See if tape done bze bru 2,1 ;No bru bslew ;and slew to top to terminate bs/de1:oct 20 ;Control words for end of file oct 0 bbwd: oct 4001 ;Used to punch back card bbkm: bss 0 oct 377777 alf OFF alf & AT oct 607777 bbkm1:dec 0 dec 0 oct 375577 bpwt: bss 0 stx bpoin1,1 ;Save return spb baex,2 bpn bru 2,1 ;and if punch not ready, continue to crump ldx bpoin1,1 bru 1,1 ;and return , Rewidn any tape except 0 brwnd:bss 0 lda t+2 !!Page 229 sra 12 ;Right-justify handler ext mask3 ;Get rid of high order add 8K sta z1 lda btab,1 ;Get handler code sta brwndh,3 spb baex,2 bcs btn,1 bru 2,1 sel 1 z20 -- ;Rewind brwndh:oct 0 spb baex,2 bcs btn,1 bru 2,1 spb baex,2 bcs brw,1 bru 2,1 bru baret , Slew to top of page bslew:bss 0 spb baex,2 bcs bpn,6 bru 2,1 sel 6 slt 8 spb tclos,2 ;Close out tape bru baret1 ;Leave io1 alone this time btypf:dec 0 ;Set to indicate type and halt or type no halt bamov:dec io1+1 ;Constants to clear punch area dec -79 bacr: oct 375577 , Call batch ovrlay back spb tclos,2 ;Close tape baret:bss 0 lmo sta io1 ;Set front card in flag baret1:ldx ovtsk,1 ;Erase entry to this overlay spb irase,2 ldx zero,2 inx batch,2 bru pgetb ;Bring in overlay !!Page 230 bartcl:spb tclos,2 ;Close tape and then wait for typing , Wait for typed message and then call batch , back in baretw:bss 0 spb baretx,2 ;Type fudge lda typf ;Type flag bnz bru 2,1 bru baret ldx ovtsk,1 inx 1,2 stx bpoin2,2 bru 2,1 ;Exit so typf can get set bet: bss 0 ;End of tape alf END alf & OF alf & TA alf PE. oct 375577 bfda: oct 3400 ;Disk address for batch front card , Set up a couple disk addresses and pull in tape , subroutine loc 6000 b2fix:ldx 8K,3 lda tap+2 ;Get tape subroutine on end sta b2fix2 bcs brn,0 bru *-1 b2fix1:sel 0 pwf ,0 b2fix2:oct 0 ;Disk address filled in bcs brn,0 bru *-1 sel 0 rrd 3 %treqst bcs brn,0 ;Wait bru *-1 bcs ber,0 ;Check for errors bru b2fix1 bru lovwrt ;and load tcd b2fix stl ;Batch temporary storage ejt !!Page 231 xr312:equ 126 ;Register for trap save loc 216 otmp: bss 1 ;API odret:bss 1 ;ODDP, OTTIM loc 230 odret2:bss 1 ;Index register storage for SYSOUT, ODSK otmp2:bss 1 ;OSOTER, OTRAP, ORTRAP otmp3:bss 1 ;OTYPE otemp:bss 1 otmp1:bss 1 , End API area definitions stl ;Batch part 1 ejt org pernum dec 32 dec oba org execov , ******************************************** , This overlay is called in by the -BAT- , overlay whenever there is a call to run a , background program which destroys the time- , sharing executive. [sacre bleu.....] , The overlay has four possible entrances. , 1) 37000 - overlay entered here when first , loaded by 235 exec, then never entered here , again. , 2) 37001 - entered here by the running , system upon completion of the entire , run, or to begin the execution of a disk, , tape, or typing operation by the executive. , 3) 37002 - entered here by exec whenever , exec is loaded into memory, and OBFLG (in , the bootstrap) is not zero. , 4) 37003 - enter here when permission has , been granted by the D-30 to run a background , system. bru oinit ;Enter here from exec, first time bru osys ;Enter here from calling system bru ores ;Enter here from exec on reset bru orun ;Enter here from 235 exec on run from D-30 , ORUN is entered at any time the D-30 , gives a run-batch message to the 235 exec. , The result of this may be the initial running , of a batch task previously set up, or the , restoration of an OLD problem previously run. , In any case, the following things happen... , 1) If switch 0 is down, the batch job is , punted until next time around. , 2) If the 235-exec us typing a message, , again, the run time is punted. , 3) If the tapes are not ready after a reason- , able amount of time, or there is an error, , this batch period is punted. , 4) The interrupt branch is stolen from the , 235 exec, and given to this overlay. , If this is a run being brought in for the , first time, the previously constructed , load sequence is executied to bootstrap the , system in, and control is transferred to it , in index-group 0, non-trpmode, pst, binmode !!Page 233 10/13/02 , and kon. , On reloads of jobs peviously running, , the following conditions are restored - , A. Arithmetic mode [AAU] , B. Binmode or Decmode , C. AX, QX, A, Q , D. Index group , E. Overflow , F. Kon is set (it should never be off) , G. Non-trapping mode is set (never on I hope) , H. A set prq is executed to start , peripheral tasks going again , .....and then back to the program. orun: bss 0 lac ;Set run+swap time counter sta otim1t,3 ldz rcs ;Check switch 0 - if down, punt bmi bru onrun ;punt lda typf ;See if 235 typing bnz bru onrun ;If so, punt dld bsums2,3 ;Move summary up mov fkedit lda offlg,3 ;Now check for initial or rerun bze bru orunf ;First run to be executed ldo sta cmessb ;Just in case of bootstrap spb oload,1 ;Load in the damn program from storage lda oapib,3 ;Get API branch instruction sta z2+2 ;and put where API branch will be to lda oarr+4,3 ;Pick up save xr1 contents sta otmp ;and put where routine will restore them oruna:set ntpmode ;spb ortrap,1 if necessary fld oarr+2,3 ;Reset AAU registers xaq ,A fld oapr,3 kon ;Just in case lac sta otim2t,3 set prq ;Set prq - to get things going orung:bru * orunm:bru * bru oint2 ;Go to normal restore sequence stl ;Batch part 1 - load ejt !!Page 235 , ******************************************** , OLOAD determines whether the program was , dumped on tapes or the disk and then loads , correctly. , Disk dump - four 4K blocks , Tape dump - lower memory on tape, upper on , disk oload:spb odask,2 ;Always need disk lda opar,3 ;See where dump is bze bru oload0 ;Disk spb otop,2 ;Tape oct 1517777 ;Read backwards oltc: oct 0017550 bru oload1 ;Get upper memory from disk oload0:spb odop,2 ;Lower memory z12 2 dec 0 oct 24100 ;Disk address spb odop,2 z12 62 dec 256 ;Read into wrong place oct 24104 ;From right place spb odskwt,2 ;Wait to get in dld damov,3 ;move down mov 256+24 spb odop,2 z12 64 dec 4096 oct 24500 , Upper memory oload1:spb odop,2 z12 64 dec 8192 oct 25100 sob odop,2 z12 56 dec 12288 oct 25500 lda opar,3 bze bru oload2 spb otop,2 z15 127 ;Get rest of tape oltc2:dec 129 ;Set busy flag spb otop,2 ;Wait for tape dec 0 oload2:spb orflin,2 ;Get rid of disk bru 1,1 ;and return !!Page 236 , ******************************************** onrun:bss 0 ;Entered if for some reason a -RUN BATCH- , permission message is to be temporarily , ignored, an immediate return to time- , sharing is desired lda otwo,3 ;Just tell D-30 to resume normal T-S sta mbx0 bru iplst ;and go to peripheral task list , ******************************************** , ***Typed message will be put here**** orunf:bss 0 lda oapib,3 ;Get API branch sta z2+2 lac sta otim,3 ;Set run start time sta obzyf,3 ;Set to busy ldo sta offlg,3 ;Set not first entrance flag spb odask,2 ;Get disk from D-30 spb odop,2 ;Bring in 35000 and 36000 parts of BATCH z12 16 oct 35000 ;Memory address to read into orunf.:oct 0 ;Filled in when loaded ldo sta cmessb ;Reset+ spb odskwt,2 ;Wait for disk to finish dld orun.2,3 ;Move trap routines where they belong mov osbu1 bru orun.3 ;and go finish this there orun.2:dec ortrap dec -128 org orun bss 31 ;Save space for typed messages stl ;Batch part 1 - tape routines ejt !!Page 237 otop: bss 0 ;Tape operations stx odret,2 ;Save index before tape waiting spb otapwt,2 ldx odret,2 ;and get it back after wait lda 1,2 bze bru 2,2 sta otp2,3 lda 2,2 sta otp2+1,3 sel 1 otp2: dec - dec - ;*** bru 3,2 ;and return otapwt:lda o8K,3 sla 2 ;Get a reasonable countdown value bcs btr,1 bru 1,2 sbo bnz bru *-4 spb otyp,2 ;Type out message dec otem ;Alert halt on tapes bru ostop0 ;and punt run , ******************************************** , The following routine picks up tape , commands from tp2 and tp2+1, , constructs correction commands for each type , of operation, and executes these instructions , assuming the tapes are ready on entrance. , On forward reads, a backwards read in the , same mode is constructed. , On backwards reads, a forward read in the , same mode is constructed. , On write instructions, a BKW is contructed. , These routines are based on the , following characteristics of the GE tape , instructions. , Bit 1 on always means backwards tape movement , Bit 2 on always means a read operation , Bit 3 on always means a write operation. oter: bss 0 lda otp2,3 srd 16 ;BKW, EKT, RWD, WEF. bod ;Check bit 3 !!Page 238 dld othree,3 ;Pick up words which will give BKW srd 2 ;Now check for foward or backwards ado ;Else construct backwards sld 18 ;Get the instruction back sta oter2,3 ;and put in correction sequence lda otp2+1,3 ext otmsk,3 ;and make it a zero word count sta oter2+1,3 ;and put away sel 1 ;and execute correction instruction. oter2:dec - dec - bru 1,2 ;and return otmsk:oct 0077777 ;Mask to extract word count from tape command stl ;Batch part 1 - disk routines ejt !!Page 239 , ******************************************** , ODOP is the disk operation subroutine , for the overlay. It serves both the executive , and user's programs, but must be called , only while in an API program. The calling , sequence is - , spb odop,2 , rrf (or wrf), x records, less than 97. , memory address for read or write , oct position on disk for read or write , return location. , There is not, at the moment, any provision , for indirect addressing of the parameter , list. In addition, the D-30 should already , have been asked for the disk, and this , routine does not relinquish the disk when it , is through. [JSM: code reads otherwise] , the disk is not checked for error on , entrance, nor does it check on the last , operation it executes (because it exits , before it is done). On intermediate errors, , it tries 5 times, and then returns an , error message. Three error types are checked , 1 - disk not ready , 2 - illegal addres on disk , 3 - parity error on read or write. !!JSM: Correction: added line below based on code. , 4 - illegal disk address , These are all indicated by a positive , number in the A register on return, else A , will be zero. odop: bss 0 ldz ;Zero odcnt just in case sta odcnt,3 stx odret,2 ;Save entrance register lda 3,2 ;Pick up the disk address sta z2 ;Indirect if word is minus bmi lda 0,2 sta odseek+2,3 ;Put it away in case it is legal ext omsk2,3 ;check for legal position address sub oo300,3 bpl bru odker ;Illegal address lda odseek+2,3 ;Get disk address back and store for relinqsh sta orelad,3 ;Store disk address for the relinquish spb odskwt,2 odseek:sel 0 ;Seek command prf ,0 ;*** oct 0 ;*** !!Page 240 ldx odret,2 ;Restore entrance register lda 1,2 ;Get RRF-WRF-WRD-RRD- sto odcnt,3 ;Save record count ext omsk1,3 ;Now punt record count add odinst,3 ;Set up proper instruction sta odoper+1,3 ;Put it away lda odcnt,3 ;Now compute bit setting for 96-record RW srd 4 xaq ;Remainder mod 16 in A sra 15 ;Position remainder...if zero bze ;want 16 in A and 1 less in Q dad ofudge,3 ;OFUDGE = 15, -1 ory odoper+1,3 ;Put it away ldz ;Now set bits 2-4 scd 4 add 2,2 ;Add the memory address sta odoper+2,3 ;Put it away odoper:sel 0 ;Execute the instruction z00 0 ;*** z00 0 ;*** ldz bru 4,2 ;Return to caller ofudge:dec 15 dec -1 , ******************************************** , Wait for disk - if ready exit immediately, , if not, wait awhile, then see if can ask D-30 odskwt:bss 0 lac add oseven,3 sta odival,3 odskw0:bcs brr,0 bru 1,2 lac cab odival,3 bru odskw0 bru odskw0 add oo40,3 sta odival,3 stx odret2,2 ;Disk not ready so type message spb otyp2,2 dec odnr ;Disk not ready ldx odret2,2 bru odskw0 ;Keep trying to get disk odker:spb otyp,2 ;Give illegal address message dec oiad lda ofour,3 ;Pick up error indication ldx odret,2 ;Get return address !!Page 241 bru 4,2 ;Error exit, code in A register , ******************************************** odask:bss 0 ;Disk Request routine - ask D-30 ldo sta pmbx0 lda pmbx0 bpl bru *-2 bru odskwt ;Now wait for ready , ******************************************** orelin:bss 0 ;Disk relinquish - enter on xr2 stx odret,2 ;Save index register for wait spb odskwt,2 ldx odret,2 ldo ory orelad,3 sel 0 prf ,0 ;Position on last operation orelad:oct 0 ;*** bcs brn,0 bru *-1 sel 0 oct 1213040 ;Read-after-write - 0 records oct 0 lda otwo,3 ;Send - can-have-disk message - bru ospmb ;and set message and will bru 1,2 stl ;Restore after dump ejt !!Page 242 , ******************************************** , ORES is entered after every reload of , the 235 exec by this overlay. , It does six things- , 1) Sets the busy flag BZYF to busy , 2) Sets CMESSB - the batch flag - to BATCH mode , 3) Tells D-30 it can have the disk. , 4) Tells D-30 to resume normal time-sharing , 5) Checks to see if the last program ran to done , 6) Checks to see if exist was to type message. , It then exits back to the 235-exec. ores: bss 0 spb irase,2 lac sub otim1t,3 add otim1,3 ;Accumulate running plus swap time sta otim1,3 lda otwo,3 ;******yes - maybe *** sta mbx0 ;Tell D-30 to resume normal time-sharing ldo sta cmessb ;and set cmessb non-zero sta bzyf ;and same for busy flag lda ofour,3 ;Tell D-30 to start counting time spb ospmb,2 ldz sta otypf,3 ;Set type flag to 0 for next entry lda otad,3 ;Check for message to be typed bnz ;if there is an address spb messg,2 ;go to 235 and type it otad: dec 0 ;Address of any typed message goes here. dld .ors2.,3 spb insert,2 sta ovtsk lda obflg,3 ;See if terminal bze bru 2,1 ;No ors0: lda osrat,3 ;Give D-30 a crump-batch message spb ospmb,2 bru orst ;and get out ors2: bss 0 lda typf bnz bru 2,1 ldz sta otad,3 ;Crump typewriter task bnr sna 19 ;and check for STOP message !!Page 243 sub ost,3 bnz bru *+4 ldo ;Set up to look for BACK card sta io1 ;and crump since S was typed bru ors0 ;Crump - somebody typed -S- lda obflg,3 ;Now check for entered on completion bze bru 2,1 orst: bss 0 ;Stop whole operation lda otim2,3 ;Real running time spb ogtim,2 ;Convert dec otimr lda otim1,3 sub otim2,3 ;Get swap time spb ogtim,2 dec otims lac sub otim,3 ;Get total time on machine spb pgtim,2 dec otimo ldx ovtsk,1 bcs bpn,6 bru 2,1 sel 6 slw 4 lda .orst1,3 ;Change branch sta 0,1 orst1:lda typf bze ;Wait for alert halt message bcs bpn,6 bru 2,1 sel 6 wpl otiml ldz sta obzyf,3 ;Reset spb irase,2 ;Erase this entry to task list spb dskb,2 ;Get disk spb dskop,2 ;Disk operatin z37 8 oct 37000 ;Dump from 37000 oct 25600 nop ;Error return spb relin,2 ;and get rid of disk lda opar,3 ;Get dump code sta bdc ;save for next part, if any ldx zero,2 inx batch,2 ;Call in batch overlay bru pgetb ;Overlay caller in exec !!Page 244 ogtim:bss 0 ;Convert time to decimal stx z0,2 ;Save calling register maq ;and conversion lda 1,2 ;Pick up where to put away sta z2 ldz dvd h1 ;52140 [21600 = 3600*6] spb obcd,1 sta 0,2 ldz dvd h2 ;550 [360 = 60*6] spb obcd,1 sta 1,2 ldz dvd six spb obcd,1 sta 2,2 ldx z0,2 bru 1,2 obcd: bss 0 dst oaq,3 maq dvd ten sla 6 sta oaq,3 xaq add colon ory oaq,3 dld oaq,3 bru 1,1 otiml:bss 0 ;Line for time printout alf & TO alf TAL alf & TI alf ME otimo:dec 0 ;Actual on-to-off time dec 0 dec 0 otimt:oct 373751 alf UNN alf ING alf & TI alf ME otimr:dec 0 ;Actual computer running time dec 0 dec 0 oct 375562 !!Page 245 alf WAP alf & TI alf ME otims:dec 0 ;Swap time dec 0 dec 0 alf . dec -1 ;Print line delimiter stl ;Batch part 1 - initialization ejt !!Page 246 , ******************************************** , OINIT is entered after the batch overlay , discovers a time-sharing-destroying system is , to be run. It expects to find the , following information left in the array -T- , T = Alphanumeric -RUN- , T+1 = xxx , T+2 = xxx , T+3 = Alphanumeric system name , T+4 = 0, 4, 10...code for loader type plus , 8K bit on in word. , 0 is standard disk image loader , 4 is bridge-type tape loader , 10 is blocked disk loader , 14 is binary card loader , T+5 = octal disk address, of the first , program record - used by loader , T+6 = 0 if system is to be dumped , intermediately on disk. , = octal handler configuration if , system is to be dumped on tape. , OINIT will insert the handers where they , belong, set up the sequence to load the , loader, set up the D-30 start-batch message, , and exit to wait for a begin-batch message. oinit:bss 0 lda obbru,3 ;Pick a bru 1,1 sta execov,3 ;Preset API exit to no action lda pmbx0 ;See if have an unanswered message bpl bru *-2 ;yes lda oten,3 ;Ask D-30 to initiate batch mode. spb ospmb,2 bru 2,1 ;and return immediately to exec. , ******************************************** ospmb:bss 0 ;Sends special mailbox message to D-30 sta pmbx0 lda pmbx0 ;and waits for an answer bpl bru *-2 bru 1,2 !!Page 247 , ******************************************** otyp: bss 0 ;Entered internally to set up typed message lda 1,2 sta otad,3 ;Put in message adddress bru 2,2 ;and exit stl ;Constants and things ejt !!Page 248 , Constants and flag storage odival:bss 1 odcnt:dec 0 ;Count disk records - must be initally 0 .ors2.:spb ors2,1 .orst1:spb orst1,1 oo40: oct 40 oct 2000 , Running time constants otim: dec 0 ;Will hold total real time for job otim1:dec 0 ;Will hold actual running time otim2:dec 0 ;Will hold running time + swap time otim1t:dec 0 ;Temporary accumulator for otim1 ptim2t:dec 0 ;Temp. accumulator for otim2 , End time holders oseven:dec 7 omsk1:oct 77777 omsk2:oct 3777400 odinst:oct 10040 oo300:oct 300 ost: alf 00S ;OPSTOP message on typewriter oent1:equ execov ;User's branch put here osbat:oct 11 ;Stop-batch to D-30 oaq: dec 0 ;A and Q storage dec 0 othree:oct 3 ;Constant ofour:oct 4 ;Constant otem: oct 376321 ;Tape alert. alf PE alf ALE alf RT. oct 375577 o8K: dec 8192 oti: equ o8K odi: equ o8K obflg:dec 0 ;Flag 0 = no special circumstances , 1 = job ran to completion omop: z24 0 ;Move opcode, used in overlay call routine offlg:dec 0 ;First run flag otwo: oct 2 ;Constant opar: dec 0 ;Save disk-or-tape flag here odec: dec 0 ;Error count of diskp oiad: bss 0 ;Illegal disk address oct 312155 odnr: bss 0 ;Disk-not-ready message oct 244255 otypf:dec 0 ;Signals type of entry to OBA , ODAD is a table of parameters for , the various types of loaders it is possible , to call during batch. , Each entry is three words long, , consisting of the disk address and read , commands for this loader. It is assumed , that the first memory location for the , loader is the first program location and , entrance point. odad: bss 0 ;Table of disk loader parameters z12 6 ;Disk card image loader oct 35000 ;into 35000 in memory oct 32000 ;from this disk address dec 0 z12 3 ;Bridge-type tape loader oct 17500 ;into memory at 17500 oct 32010 ;from this disk address dec 0 z12 7 ;Blocked disk loader oct 17000 oct 32020 dec 0 z12 7 ;Card loader oct 35000 ;memory address oct 32030 ;into memory from this disk address dec 0 bss 0 ;End of catalog oten: oct 10 otwen:oct 20 oapib:bru oint,3 ;Steal API branch from exec to run oamov:z00 128+24 ;Used to move disk records down to API area dec -3948 ;a few too many makes no difference stl ;Batch part 1 - Tape correction for hard error ejt !!Page 250 , This routine is entered from the tape routine , after it has tried the operation five times , and still gets an error indication. , If the operation was a write it will erase , tape and re-write the record. , If the operation was a read it will try , switching modes and re-reading. If that does , not work it will return to the original mode. , It punts if it finds a read special. otera:lda otpb,3 ;Get bad tape command srd 16 ;Check bit three - if on it was a write bod bru otera1 ;So erase , Instruction was a read so change modes bmi bru otwrp2 ;Was a read-special so punt lda oswc,3 ;3-way flag 0 - first entrance, minus - , second entrance, plus - third (and final) entrance bnz ;Set flags for next time bru *+3 lmo bru store bpl bru otwrp2 ;Last time so punt ldo store:sta oswc,3 lda otpb,3 ;Get bad tape command srd 15 bev ado ext otwo,3 ;Wipe out bit 18 - now we have the changed , instruction sld 15 ;Put insruction back together sta otlst,2 ;put back in list ext otmsk,3 ;77777 add oten,3 ;Get proper error bit on sta otst,3 spb oter,2 ;Back up tape lda oseven,3 ;Reset error count to seven sta otec,3 bru 1,1 ;Exit and try again oswc: dec 0 , Command was write so erase otera1:lda otpb,3 ;Get command back sta otlst,2 spb oter,2 ;Back up tape lda oter2+1,3 ;Get handler information !!Page 251 add oo2476,3 ;Erase at least 2476 words sta otap1+2,3 lda otap1.,3 ;spb otap1,1 sta oint2+1,3 ;Fudge branch bru 1,1 otap1:spb otop,2 ert ,4 ;Will be changed %0 lda otape.,3 ;spb otape,1 sta oint2+1,3 obbru:bru 1,1 ;Exit - also constant to set API branch otap1.:spb otap1,1 bsums:bss 8 ;Space for summary bsums2:dec bsums ;Constant to move summary up dec -8 otape.:spb otape,1 loc 37777 obzyf:dec 0 ;Busy flag in case of bootstraps loc 6000 obaf1:ldx 8K,3 lda oba3+2 sta orunf.,3 ;Initialize disk address bcs brn,0 bru *-1 obaf2:sel 0 prf ,0 oct 26160 ;Put on dump part bcs brn,0 bru *-1 sel 0 wrd 8,0 %execov bcs brn,0 bru *-1 bcs ber,0 bru obaf2 bru lovwrt tcd obaf1 stl ;Batch part 2 ejt !!Page 252 , Information for 235 loading routine org pernum dec 34 dec oba2 ;Overlay name loc 36000 ;Lower memory part of batch overlay , This entrance must remain at 36000 to be , entered from the loader. sxg 2 ;Call in OBA3 ldx z2+1,3 olobar:lda otwo,3 spb exec,1 dec oloba3 lda oloba3+3,3 bze bru *-2 bev bru olobar ;Error, try again sxg 0 bru 0,3 ;Go to program oloba3:z12 8 ;8 records oct 35000 oct 0 ;Filled in when loaded oct 0 stl ;Program exits ejt !!Page 253 , OSYS handles entrances from user programs. , It is the only part of the overlay which is , executed outside of API, and may be interrupted. , It may be entered in any index group, stays , there, and very well may destroy said index grp. , There are five possible entrances, according, , to the contents of the A register. , Codes are as follows , 0 = Termination , 1 = Tape operation , 2 = Disk operation , 3 = Typewriter output , sign on is type and crump , 4 = overlay or new system call. , 5 = Sysout write, sign on if indirect osys: bss 0 sta otemp ;Construct a branch pointer ldx otemp,2 ;from calling routine inx -1,2 ;[make zero also an error] ldx z2+1,3 ;Get 8K into xr3 set pst ;Just in case some dummy....... bxh 8,2 ;Check for legal calling number bru oterm ;and if it isn't, crump the bum bru *+1,2 ;Branch according to calling value bru otap ;1 = tapes bru odsk ;2 = disk operation bru otype ;3 = type routine bru oovr ;4 = overlay call bru oso ;5 = sysout , 6 and 7 are reserved for special messages to , the D-30 bru oterm bru oterm bru oitrap ;10 = Start trap restore stl ;Interrupt routine ejt !!Page 254 , ******************************************** , This is the entrance for API interrupts , during the running of a background system. , Interrupt branches are set up whenever the , overlay gets word to run the background , system. , On interrupt, the routine has one definite , task, and three possible tasks. , A) It checks the mailbox for a stop running , batch message. If there is such, it dumps , the system and takes necessary action to , restore normal time sharing. , B) If there are any disk operation to be , done, or just completed, they are executed. , C) If there are tape operations to be done, , or completed, they are taken care of. , D) The overlay checks to see if the running , system wants to execute an API program, if , so it branches to it. , The interrupt routine assumes 8K in xr3 of , interrupt group. oint: bss 0 ;Enter overlay here on API interrupt. dst oaq,3 ;Save A and Q set binmode ;Will restore it to decmode if needed hcr ;Just on general principles stx otmp,1 ;Save index register for return lda mbx0 ;Check for D-30 dump command. sub odmp,3 ;octal 11 - dump batch message. bnz bru oint2 ;No dump message from the D-30 sta mbx0 ;Answer D-30 dump command bru odump ;and exit oint2:bss 0 ;May return here spb odisk,1 ;Check to see if there are disk commands to be , executed spb otape,1 ;Check to see if there are tape commands to be , executed ldz ;Check typewriter input bnr ;If an -S- is input, it is command to stop sna 19 ;Pick up N-reg character sub ost,3 ;Subtract BCD -S- bze bru ostop-2 ;Stop program and look for back card sbo ;See if T bze spb ottim,0 ;Output running time !!Page 255 spb oent1,1 ;Execute user's API program, if any lda otypf,3 ;Pick up type-of-entry flag. , 0 means not special , 1 means type message to be set up , also dump for overlay , 2 means terminal dump entrance bze bru otin3 ;No task assigned by this flag [value] bod bru odump ;Dump in order to type out message........ bru ostop ;Terminal exit so do it otin3:ldz ;Check console switches, and if no good, punt rcs bmi bru odump ldx otmp,1 ;Get return register !!Bit positions 0-4 of the return address contain !!indications of the machine's prior state... !!Bit 0 - KON in effect !!Bit 1 - TON in effect !!Bit 2 - BCD remebered carry on !!Bit 3 - DECMODE in effect !!Bit 4 - Overflow indicator on lda otmp bov ;Reset overflow if on bru *+1 sla 1 ;and start restoring bov ton ;Bit one sla 1 bov bru *+1 ;Ignore DECMODE carry sla 1 bov set decmode ;[Bit 3] sla 1 ;[Bit 4 restore overflow indicator] dld oaq,3 ;conditions set pst ;before bru 0,1 ;returning stl ;Batch part 2 - Tape set-up ejt !!Page 256 , ******************************************** , OTAP is entered to place a tape command , into the command list. The commands must be , in the format given in subroutine OTAPE, and , are never checked for validity. , The index group entered on is destroyed, with , the exception of xr1. , The flag words is set to 0 before exiting. If , the list is full, the routine waits until , it can insert the task before exiting. otap: bss 0 lda oto,3 ;Pick up pointer to tape task list sta otemp ldx otemp,2 ;Get pointer to tape list in xr2 lda otlst,2 ;and check for room in task list bnz bru *-2 ;No room - so wait until there is. lda 1,1 ;Pick up pointer to tape op stx otemp,1 bpl bru otap0 ;Indirect inx 3,1 ;Set for return, direct lda otemp ado ;Get address correct otap0:sta otemp ; and then ldx otemp,3 ; put in xr3 and sta otlst+2,2 ; tape task list ldz ;Zero the task done flag in user's param list sta 3,3 lda 2,3 ;Store tape command sta otlst+1,2 ; in lda 1,3 ; the sta otlst,2 ; tape task list ldx z2+1,3 ;Restore up8 bit to xr3 inx 4,2 ;Bump up list pointer stx otemp,2 lda otemp ;Get list pointer back and reset bxh 16,2 ;Check for wraparound = 4 entries lda oti,3 ;Wrap around sta oto,3 ;and put away the pointer set prq ;set prq in case nothing in operation bru 2,1 ;Return to the user's program stl ;Disk set-up ejt !!Page 11319 , ******************************************** , ODSK is entered to insert parameters in , the disk task list. An internal wait is , made for an opening list location. Scratch , disk areas are assigned here. odsk: bss 0 stx odret2,1 ;Save entrance lda odo,3 ;Get pointer to task list sta otemp ldx otemp,2 lda odlst,2 ;See if entry available bnz bru *-2 lda 1,1 ;Entry now available sta otemp sta odlst+3,2 ;so get pointer to parameter list ldx otemp,1 ldz ;Set flag-word to zero for user sta 3,1 lda 1,1 ;Will be memory address for read or write sta odlst+1,2 lda 2,1 ;Get PRF bpl bru odsk2 ;Address given, no scratch area request lda odsa,3 ;Get pointer to scratch list sta otemp ldx otemp,3 lda odsl,3 ;Get next address from task liust bze ;If zero - end of list bru odske ;so give error exit inx 1,3 ;Set up pointer to get next entry next time stx otemp,3 ldx z2+1,3 ;and restore 8K to xr3 sta odlst+2,2 ;Put address in command list sta 2,1 ;and also return to exec lda otemp ;Now get pointer to scratch list sta odsa,3 ;and put it back bru odsk2+1 ;and jump around normal put-away odsk2:bss 0 sta odlst+2,2 lda 0,1 ;Will be RRF or WRF sto otemp ;and get record count to be processed ldx otemp,0 bxh 97,0 ;Disallow anything over 96 bru odske ;Go set too-many-records flag sta odlst,2 inx 4,2 ;Else bump pointer and exit stx otemp,2 lda otemp !!Page 258 bxh 16,2 ;End of list if so lda odi,3 ;so re-initialize sta odo,3 set prq ;set prq in case nothing going odskx:ldx odret2,1 ;Get return back bru 2,1 ;and go back around address word odske:ldo ;Set too-many-records bit on sla 19-2 ;Task list stays zero sta 3,1 ;Flag location bru odskx stl ;Type routine ejt !!Page 259 , ******************************************** , OTYPE makes it possible for user programs , to type out messages without use of normal , time-sharing time, and without having the , message garbled by intervening interrupts. , When a type command is given, the program is , immediately dumped, and not reloaded until , the message has been typed out. , The calling aequence for the type routine , is as follows - , lda three , spb type,1 = 37000 , dec message location otype:bss 0 bpl bru otype1 stx otmp3,1 ;Save entrance register sta io1 ;Have front spb osoter,1 ;Terminate sysout buffer ldo ;Set up to crump after message sta obflg,3 ldx otmp3,1 ;Get it back lda 1,1 ;move message-to-be-typed to exec add omop,3 ;Z24 sta *+2,3 dld omtex,3 mov 0 lda oeom,3 sla 12 sta orune+30,3 ldx z2+1,3 ;Get 8K back into xr3 [when did it leave?] set pbk ;Break around type setup routine lda omtex,3 ;Get pointer to message for exec sta otad,3 ;and put it in address for res routine ldo sta otypf,3 ;Set up type entrance call for exec set pst ;and get back in API set prq ;set prq bru 2,1 ;and return - message is typed. omtex:dec orune dec -30 stl ;Dump ejt !!Page 260 , ******************************************** , ODUMP is entered when the D-30 gives a , dump-batchmode message. It results in the , complete dump of a system on tape or the , disk, depending on parameters previously , specified. All conditions are save for later , restoration. The 235-exec is then called , back in to memory, with the batch flag set. , No attempt is made to restore trap mode , conditions - thus no system should run in , trap mode under background. [JSM: then what's , the purpose of Batch part 3 - Trap Restore?] , Disk dump format - , Four 4K-recods written on high-speed , tracks. , Tape dump format - , Lower memory in 2 records on tape , Upper memory on two 4K disk records. odump:bss 0 lac sub otim2t,3 ;Accumulate running time add otim2,3 sta otim2,3 fst oarr,3 ;Save AX xaq ,A fst oarr+2,3 ;and QX lda otmp ;[Save location in user's program] sta oarr+4,3 lda onfl,3 ;[Now save AAU modes--assume] bar bup,7 ;[normalized floating point to] lda ounf,3 ;[start, then test for un-normalized] bzr bfx,7 ;[and fixed-point modes respectively] lda ofix,3 sta orunm,3 ;set mode-set in restore sequence lda osxg,3 ;[Preserve index register group] oga sta orung,3 ;Set index-group-restore into restore sequence lda othree,3 ;Tell D-30 to stop counting spb ospmb,2 odump1:lda otip,3 ;Wait for any tape operations to be sta z2 ;completed and corrected before exit lda otlst,2 bpl bru odump2 spb otop,2 ;Wait for tapes to come ready dec 0 spb otape,1 ;Go to routine until null condition !!Page 262 bru odump1 ;and see if done odump2:lda odip,3 ;Make sure disk operation is done sta z2 lda odlst,2 bze ;If list is zero, no task bru odump3 ado ;If minus-one then task in progress bnz bru odump3 spb odwrp,1 ;so finish task bru odump2 ;and see if done odump3:ldx z2+1,0 ;Wil serve for 0, since is 8K bcr ;Check card reader bru odump4 ;OK - dump inx 1,0 bxl 3000,0 ;Will give slightly more than u/lth second bru *-4 ;Go check again [1/12th??] odump4:spb odask,2 ;Ask D-30 lda opar,3 bze ;If zero, dump on disk, else tapes bru oddmp spb otop,2 ;Else dump on tapes z03 0 ;Write out around index and mailboxes odtc: z00 128 ;Number of words - handler inserted spb otop,2 oct 0300230 ;Dump beginning word odtc2:oct 0017550 ;Number of words, handler inserted , Enter odmp2 to dump upper memory on disk odmp2:bru *+1 ;Filled in with SPB OTRAP,1 if necessary spb odop,2 z37 64 ;Third 4K block dec 8192 oct 25100 ;Disk address spb odop,2 z37 64 ;Last block dec 12288 ;[8192+4096] oct 25500 spb odop,2 ;Get bootstrap for exec z12 1 dec load1 oo2476:oct 2476 ldz sta z1 ;Set zero into xr1 spb odskwt,2 ;Wait for bootstrap to get in lmo ;Set flag in bootstrap to get ores entrance sta sbak ;Set flag in exec to indicate batch mode lda io1 sta sbak+1 ;Front card status set pst set pbk ;Immediately get out sxg 0 !!Page 262 bru load1 oddmp:bss 0 ;Dump from disk spb odop,2 z37 64 ;Dump first 4k of memory dec 0 oct 24100 ;Address on disk 0 spb odop,2 ;Dump second 4K z37 64 dec 4096 oct 24500 ;Disk position bru odmp2 stl ;Disk routine ejt !!Page 263 , ******************************************** , ODSK is the disk read-write subroutine. , It scans a 4-words-per-entry list, executing , a given entry if the disk is ready, setting a , task done flag if the operation is done, else , just returning. odisk:bss 0 ;Process previously built disk task list lda odip,3 ;Get internal pointer to task list sta z2 odisk2:dld odlst,2 bze bru 1,1 ;No disk task waiting ado bze bru odwrp ;Was minus 1, so task in progress sbo dst odpb,3 ;Put commands away lda odlst+2,2 sta odpb+2,3 ;and set last instruction lmo ;Preset entry to in-progress sta odlst,2 lda othree,3 ;Tell Mike [Busch] to stop couting time spb ospmb,2 spb odask,2 ;Ask for disk before using lac add otwen,3 sta odclk,3 ;Set countdown for disk. nop ddc 0 org *-3 spb odop,2 odpb: dec - dec - dec - bze ;Check return status bru odpb1 ;OK, just get D-30 going again ldo sla 19-4 ;Set illegal address on ory odst,3 odpb1:lda ofour,3 ;and start counting time spb pspmb,2 odwrp:bcs brr,0 ;[Check for disk ready] bru odpb2 ;Skip clock check and disk wait lac ;Check for countdown cab odclk,3 bru 1,1 ;Not counted down yet nop !!Page 264 spb odskwt,2 ;Dump must have intervened - so get disk odpb2:bcs ber,0 ;Now see if read successful bru oderc ;If not, correct it odwrp2:lda odip,3 ;Get list pointer again sta z2 ldz sta odlst,2 ;Preset task to completed lda odlst+3,2 ;Get address of status-return word sta z2 lda odst,3 ;Get disk status word bze ldo ;If AOK, set 1 status sta 3,2 ldz sta odst,3 ;and then set disk status to 0 for next sta odec,3 ;and set error count down spb orelin,2 ;Relinquisk so D-30 can get int lda odip,3 ;Bump up pointer to disk list sta z2 inx 4,2 lda z2 bxh 16,2 ;Check for wrap-around lda o8K,3 sta odip,3 ;and put back for next time bru 1,1 oderc:lda odec,3 ;Error on read ado sta odec,3 ;Bump up error count cab oseven,3 bru *+2 ;Not limit yet bru odte ;Too late, give parity message ldo sla 19-1 ;Set parity, but recovered message ory odst,3 lda odpb,3 ;and restore task list sta odlst,2 bru odisk2 ;and try again odte: ldz chs ;- indicates non-recovered parity ory odst,3 bru odwrp2 ;and wrapup as if read was OK stl ;Tape routine ejt !!Page 265 , ******************************************** , OTAP is the tape operation subroutine. , It scans a list of tape operations, executing , them as the tape controller comes ready, , setting flags as each operation is completed. , All error checking, and error messages, are , taken care of internally. , The calling sequence to execute a tape , operation is as follows - , LDA ONE , SPB TAPEOP (=37001) , DEC pointer to the parameter list , Four-word parameter list has the following , form , SEL x - tape controller desired , Word 1 of tape command - , Word 2 of tape command - , DEC 0 , Alternately , LDO , SPB EXEC 1 , SEL 1 , word 1 , word 2 , DEC 0 flag , return , When OTAPE is entered, it puts the supplied , parameters into a task list, and immediately , exits to the user's program, after setting , the -DEC 0- word of the calling sequence , to 0. The tape operation is initiated as soon , as the tape controller is ready. , When the operation has been completed, the , TAPEOP routine will set the -DEC 0- word as , follows - , = 1 if the operation was normally successful , = 2 if there was an EOT indication , = 4 if there was an EOF indication , = 10 if there was a recovered read error , which was recovered by changing read modes , = 20 if the error was not recoverable , after 5 tries at a read or write. , = 40 if the instruction caused the tape , controller to go permanently not ready. !!Page 266 , No other status returns are possible. otape:bss 0 lda otip,3 ;Pick up pointer to tape task list. sta z2 ;and put in xr2 dld otlst,2 ;pick up next list entry bnz ;If so there is an entry bcs rtn,1 ;See if tapes ready bru 1,1 ;Either no tasks or tapes not ready ado ;See if operation just completed bze ;If so - was minus 1 bru otwrp ;so go set flags and wrap up sbo ;Restore - is real command dst otpb,3 ;Put in otop calling sequence lmo ;and set entry to task initiated sta otlst,2 nop ;*** ddc 0 ;*** org *-3 ;*** spb otop,2 ;Execute tape commands otpb: dec - dec - bru 1,1 ;and exit otwrp:bss 0 ;Enter here after tape operation completed sta otlst,2 ;and set entry to completed - for now - bcs bne,1 bru otwrp2 ;No errors lda otec,3 ;Check error count sbo ;and decrement sta otec,3 bnz bru otwrp1 ;Countdown not done - so try again lda otwen,3 ;Get octal 20 - error flag sta otst,3 ;and put in status word bru otera ;Erase if write or change mode if read otwrp1:lda otpb,3 ;Pick up tape command giving error sta otlst,2 spb oter,2 ;and go correct bad operation bru 1,1 otwrp2:bcs bnf,1 ;EOF test bru *+3 ;No end of file lda ofour,3 ory otst,3 ;Put EOF bit on in status word bcs bnt,1 ;Test EOT bru *+3 ;No end of tape lda otwo,3 ;Pick up EOT indicator ory otst,3 ;and put into status word lda otlst+2,2 ;Get flag location xaq ;and save !!Page 267 inx 4,2 ;Point to next list entry lda z2 bxh 16,2 ;Four entries in list lda o8K,3 ;Initialize pointer at 8K sta otip,3 ;and save pointer to next entry xaq ;Get back place to put status sta z2 lda otst,3 ;Get status bze ;and if it is zero ldo ;job completed sta 3,2 ;and store in user's parameter list ldz ;Job completed sta otst,3 ;Set status word zero, sta oswc,3 ;set switch mode flag off lda oseven,3 ;Preset error count to 7 sta otec,3 ;and error count 0 bru otape ;Now take a look at that next entry , Output running time on the typewriter ottim:bss 0 stx odret,0 lda otim2,3 ;Real running time spb ogtim,2 dec otimr spb otyp,2 ;Set up to be typed dec otimt ldo sta otypf,3 ldx odre,2 set prq bru 1,2 , [Needs ejt after stl once baseline established] stl ;Batch part 2 , ******************************************** odlst:bss 0 ;Disk task list , Entry 1 dec 0 dec 0 dec 0 dec 0 ;Parameter pointer , Entry 2 dec 0 dec 0 dec 0 dec 0 , Entry 3 dec 0 dec 0 dec 0 dec 0 !!Page 268 , Entry 4 dec 0 dec 0 dec 0 dec 0 otlst:bss 0 ;Tape task list , Entry 1 dec 0 dec 0 dec 0 dec 0 , Entry 2 dec 0 dec 0 dec 0 dec 0 , Entry 3 dec 0 dec 0 dec 0 dec 0 , Entry 4 dec 0 dec 0 dec 0 dec 0 , OSTOP is entered if an S is typed on the , console typewriter while a batch program is , running. The result is the complete abortion , of this program, and restoration of normal , batch mode. ostop0:ldo ;Set flag to look for BACK card sta io1 ostop:bss 0 lac ;Accumulate running time sub otim2t,3 add otim2,3 ;Accumulate actual running time sta otim2,3 ldo ;Set flag in overlay to tell -ORES- same sta obflg,3 ;Tell ORES batch job done. lda othree,3 ;and now tell D-30 to stop counting spb ospmb,2 spb odask,3 ;Get disk bru odmp2 ;and enter in middle of dump routine. odmp: oct -11 ;Dump-batch message from D-30 otst: dec 0 ;Used to hold tape status word return !!Page 269 otec: dec 7 ;Tape error count - initialize at seven oarr: bss 6 ;Storage for dump {=swap] oeom: oct 55 ;End-of-message character for type routine osxg: sxg 0 ounf: set uflpoint ofix: set fixpoint ofnl: set nflpoint odip: dec 8192 ;Internal pointer to API disk taks list odst: dec 0 ;Holds disk status for system subroutine otip: dec 8192 ;Points to tape list command (iternal) odo: dec 8192 ;Pointer to disk task list oto: dec 8192 ;Pointer to tape task list odsl: bss 0 ;List of scratch area addresses on disk oct 30000 oct 30400 oct 31000 oct 31400 dec 0 ;Only 4 areas available - bss 4 ;(More can be put here - last must be a 0) odsa: dec 8192 ;Pointer to scratch area being supplied odclk:dec 0 ;Count down on disk with real clock - svd here loc 6000 area: eqo 36000 oba2m:ldx 8K,3 lda oba3+2 sta oloba3+2,3 bru *+3 dec execov dec -512 dld *-2 mov area ;Move , Read exec back in bcs brn,0 bru *-1 oba2n:sel 0 prf ,0 oct 2600 ;Get exec bcs brn,0 bru *-1 sel 0 rrf 8,0 %area bcs brn,0 bru *-1 bcs ber,0 bru oba2n bru lovwrt ;Now write on disk tcd oba2m !!Page 270 stl ;Batch part 3 - Trap restore ejt !!Page 271 org pernum dec 36 dec oba3 loc 34600 , Restore for trap , Must put hold indicators back and get into , trap program if necessary ortrap:stx otmp2,1 ;Save entrance lda z2+1 ;Get 8K bit sta tx2+1 ;Set in trap register lda .orst.,3 ;Set for trap sta itrap-1 sta itrap sta itrap+1 lda otrfl,3 ;Get indicator flag sta z1 set fixpoint ;Make it easy to get a trap bru *+1,1 ;Now see what has to be restored bru ortrp ;In trap[mode] program bru ortri ;Not in trap program set ntpmode ;Trap not set ocrest:spb ohold,2 ;Restore hold indicators dld omovt2,3 ;Restore trap registers mov ostrp ldx otmp2,1 ;Get back to rest of restore bru 1,1 , In trap program ortrp:set trpmode ;Fudge way into trap fdv ozero,3 ;Generate trap set pst ;Get out of API set pbk bru *+1,3 orstb:rin ;Enter from self-caused trap lda .orex.,3 ;have to get back in API sta z2+2 ;Fudge entrance set pst set prq ;set prq orex: lda oapib,3 ;Get API branch back sta z2+2 bru ocrest ;and continue with restore ortri:spb ohold,2 ;Not in trap program when interrupted set trpmode ;Restore hold indicators and set trap bru ocrest+1 ;and leave ohold:lda otimfl,3 ;Mode flag !!Page 272 sta z1 bru *+1,1 bru 1,2 ;None on bru oocov ;Overflow hold on bru ocun ;Underflow hold on fdv zero,3 ;Divide check on bru 1,2 ;Get out oocov:fld oocov1,3 ;overflow hold on fad oocov1,3 ;1777777.1777777 bru 1,2 ;Leave oocov1:oct 1777777 oct 1777777 ocun: fld ocun1,3 ;Underlow on fad ocun1,3 ;2000000.2000000 bru 1,2 ;and exit ocun1:oct 2000000 oct 2000000 ozer: ddc 0 omovt1:dec ostrp dec -7 omovt2:dec itrap-1 dec -7 otrfl:bss 1 ;Trap flag otimfl:bss 1 ;Mode flag .otrs]:spb tx2,0 .otrs.:bru otrs,3 .otri.:bru otri,3 .otra.:spb otrap,1 .ortr.:spb ortrap,1 .orst.:spb bru orstb,3 .orex.:bru orex,3 ostrp:bss 7 ;Trap save stl ;Batch 3 - part of initial start ejt , Continuation of ORUNF in OBA1 , Sets up for proper loader and dump orun.3:ldo sta cmessb ;Reset ldx t+4,1 ;Get parameters from catalog lda odad,1 ;Type of loader sta orun30+1,3 lda odad+1,1 ;Loader address sta orun30+2,3 lda odad+2,1 sta orun30+3,3 orun30:spb odop,2 ;Disk operation to get loader dec - dec - dec - lda bdc ;Get dump load info sta opar,3 ;0 if on disk, handler bits if ory oltc,3 ;on tape ory oltc2,3 ory odtc,3 ory odtc2,3 lac sta otim2t,3 spb orelin,2 ;Give back disk sxg 0 ;Set group zero for loader entrance lda odect,3 ;Pointer to parameter list sta 2 ;for loader ldx t+4,1 ;Loader address lda odad+1,1 ;Address from disk read sta z1 set pst ;out of API and bru 0,1 ;to loader odect:dec t ;Address of t-array , Initialize branches to trap routines oitrap:lda .otra.,3 ;Get start sta odmp2,3 ;Put in correct SPB lda .ortr.,3 ;Restore sta oruna,3 bru 1,1 ;Back to guy's program stl ;Sysout ejt !!Page 274 10/14/02 loc 35000 , Sysout buffers osbuf1:bss 110 osbuf2:bss 110 , Sysout routine , Entrance on xr-1, A-reg minus if indirect - , plus if direct. First two words are sysout , control words, third word is address of data , Regular entrance is to here oso: ldx z2+1,3 ;Get 8K bit bpl ;See if direct or indirect bru oso1 ;direct lda 1,1 ;Get pointer in A inx 2,1 ;Return in 1 bru oso2 ;Skip indirect oso1: inx 1,1 ;Step to parameter stx odret2,1 lda odret2 ;Get pointer in A inx 3,1 ;step pointer for return oso2: sta osop,3 ;Save pointer permanently sta odret2 ldx odret2,2 ;Get in 2 stx odret2,1 ;Get return lda odret2 sta osor,3 ;and put where it belongs lda 0,2 ;xr-2 has pointer to list sta osobl,3 ;Save parameter in my list lda 1,2 sta osobl+1,3 lda 2,2 sta osobl+2,3 lda osobp,3 ;Get location to put in add osobw,3 sta odret2 ldx odret2,1 ;Address to move to dld osobl,3 sta 0,1 xaq sta 1,1 ;Control words stored ext omw,3 ;3777600 sta osobw1,3 ;Number of words to write cab od110,3 ;See if legal length bru oso3 bru oso3 !!Page 275 bru osore ;Exit oso3: lda osobw,3 add otwo,3 sta osobw,3 ;Increment word count add osobw1,3 cab od110 ;dec 110 bru osok ;Just move in bru osok , Length too great for one buffer, so split. , Change number of words and address and then , write. sub od110,3 ;Get number of excess words sta osobw2,3 ;Save for next operation sub osobw1,3 ;Get number to move lqa ;Set up to move neg add osobl+2,3 ;Save new address to write from next time sta otmp1 ;Save for awhile lda osobl+2,3 ;From address ada omop,3 sta *+3,3 lda osobp,3 add osobw,3 mov * ;Constructed lda od110,3 sta osobw,3 ;For tape write lda osobw2,3 sta osobw1,3 ;Set to finish operation lda otmp1 sta osobl+2,3 ;New address bru osowr ;Write it , Room to plunk in present buffer osok: lda osobw,1 neg xaq ;Set for move lda osobl+2,3 ;From address add omop,3 ;Z24 sta *+3,3 ;Put in move command lda osobp,3 add osobw,3 mov * ;Constructed lda osobw,3 add osobw1,3 sta osobw,3 ;Reset word count cab od108,3 bru osore ;Do not need to write out yet bru osore !!Page 276 ldz sta osobw1,3 ;Reset words to write bru osowr ;Must write out, can not split control words , Time to write tape. After finished switch , buffers if other one ready. osowr:dld osotp,3 ;Pointer to next tape list sta odret2 sta osowr1+1,3 xaq dst osotp,3 ;Switch for next time ldx odret2,2 dld osobp,3 sto 1,2 ;Put address in xaq dst osobp,3 ;Flip buffer lda osobw,3 ;Word count bze bru osok ;Punt if zero sto 2,2 ;put away ldo osowr1:spb exec,1 ;Write tape dec 0 ;Constructed ldz sta osobw,3 ;Set buffer count to zero , Now check to see if the other buffer is ready lda osotp,3 sta odret2 ldx odret2,2 lda 3,2 ;Get flag word bze ;Wait till tape operation done bru *-2 bod bru osok ;Buffer OK to fill sra 1 bod bru osoeot ;End of tape, change them bru osok , End of tape occurred, write record and rewind, , then switch tape. !!JSM: check calls to exec with same number !!in A but different-length calling sequences: !!OSOWR1 and OSOEOT osoeot:ldo spb exec,1 sel 1 wtb osyet,7 ;End tape record %13 dec 0 ldo !!Page 277 spb exec,1 sel 1 rwd ,7 dec 0 ldz ;If we get this far make sure dump is on sta opar,3 ;the disk , Wait until next tape is mounted lda othree,3 spb exec,1 dec osoty ;Toggle 19 when sysout tape is ready ldz rcs bev !!JSM: ERROR: the branch below as originally specified !!was a !! bru *-4 !!which branches back to the instruction containing !! dec osoty !!instead of to the instruction containing !! ldz !!which is what was intended. !!I have change the instruction to the one below bru *-3 ldz rcs bod bru *-3 bru osok , Enter here to write out sysout buffer osoter:stx otmp2,1 ;Save entrance lda odter1,3 sta osor,3 ;Set up to return correctly bru osowr ;Write out oster1:lda osot1+3,3 ;Make sure done bze bru *-2 lda osot2+3,3 bze bru *-2 ldx otmp2,1 ;All done so get out bru 1,1 odter1:dec oster1 , Enter here to return to user's program osore:lda osor,3 ;Return address sta odret2 ldx odret2,1 bru 0,1 ;Get back , Flip-flop constants osobp:dec osbu1 dec osbu2 osobw:dec 0 ;Number of words in use in buffer osobl:dec 0 ;User's parameter list !!Page 278 dec 0 dec 0 osobw1:dec 0 ;Words to write osobw2:dec 0 ;used if overflow osotp:dec osot1 ;Next tape list to use dec osot2 osdp: bss 1 ;Pointer to user's info osor: bss 1 ;Return address osyet:oct 21 od100:dec 100 od108:dec 018 omw: oct 3777600 osot1:sel 1 ;Dummy parameter list actual parameters are z03 0,1 z30 0 dec 1 ;Initialize flag to 1 osot2:sel 1 ;Dummy parameters z03 0,1 z30 0 dec 1 , New s/o tg 19 osoty:alf NEW alf & S/ alf O T alf G 1 oct 113755 stl ;Trap save ejt !!Page 279 , Save trap conditions otrap:stx otmp2,1 ;Save entrance dld omovt1,3 ;Save trap locations mov itrap-1 sta xr312 ;Initialize register to 0 lda z2+1 ;Get 8K bit sta tx2+1 ;put in for trap sta xr312+1 lda .otrs.,3 sta tx2 ;Branch for simultaneous interrupts lda .otrs],3 ;but you have to get there first sta itrap-1 sta itrap sta itrap+1 , Now see how fouled up trap is , Save hold indicators ldz ;Zero if none bar boo,7 ldo ;Overflow hold on bar buo,7 lda otwo,3 ;Underflow hold on bar bdc,7 lda othree,3 ;Divide check on add z2+1 ;Set upper 8K bit sta otmifl,3 ;Trap indicator flag sxg 31 ;Get into group away from punch set pst ;Get out of API set pbk bru *+1,3 ;If simultaneous trap, then program spb *+1,2 ;will go to OTRS, else here lda xr312 ;See if in trap program bnz bru otrchk ;Not in trap program, but see if it is set !!If fall through, then in a trap-interrupt program , OBTEX sets a flag as follows , 0 - in trap program , 1 - trap mode set , 2 - trap mode not set obtex:add z2+1 sta otrfl,3 ;Trap flag for restore rin ;Do not foul anyone else set trpmode set ntpmode bru *+1,3 ;Get out of trap program if in one , Have to get back into API lda otmp2 ;So set up return sta z2 !!Page 280 lda *+4,3 ;Bru 1,2 sta z2+2 set pst set prq ;and interrupt to go there bru 1,2 ;constant for OBTEX otrs: lda oarr+4,3 ;Simultaneous trap and interrupt sta ostrp+4,3 ;Set trap register 1 , Following works because in lower memory lda tx2-2 ;Get register 0 sto oarr+4,3 ldz bru obtex otrchk:lda .otri.,3 ;See if trap[mode] set sta itrap+1 ;If set, a branch to OTRI will occur set fixpoint ;Make sure FDV will trap fdv ozero,3 lda otwo,3 ;[Trap did not occur, land here] bru obtex otri: ldo ;[Trap did occur, land here] bru obtex stl ;Batch part 3 - overlay call and terminal exit ejt !!Page 281 , Overlay calling entrance - code is , 4 in A register, and SPB must be followed , by a 4-word alphabetic name for the overlay , desired. The routine destroys index groups , 1 and 2 and the T-array in the user's program oovr: inx 1,1 ;Get pointer to list stx odret2,2 lda odret2 sxg 0 ldx z2+1,3 sta oovrp,3 ;Store in pointer spb osoter,1 ;Terminate sysout buffer oovr1:lda otwo,3 ;Disk operation spb exec,1 dec ovlst2 lda ovlst2+3,3 bze bru *-2 bev ;Wait till get a one bru oovr1 bru ovsc ;Go to overlay scan ovlst2:z12 7 ;7 records oct 35000 oct 0 ;From dec 0 oovrp:bss 1 , Terminal exit oterm:spb osoter,1 ;Terminate sysout buffer lda otwo,3 ;Set job-done code into API entrance flag sta otypf,3 lmo sta io1 ;Have front set prq bru *-1 ;Just in case get a return , Restore for OBA3 loc 6000 oba3m:ldx 8K,3 lda oba4+2 sta ovlst2+2,3 ;Initialize disk address dld oba3m1 mov ortrap ;Get trap routine with overlay bru *+3 dec execov dec -512 dld *-2 mov ovcat ;Move to 37000 , Read exec back in bcs brn,0 !!Page 282 bru *-1 oba3m0:sel 0 prf ,0 oct 2554 ;0 5 54 bcs brn,0 bru *-1 sel 0 rrf 10,0 %ortrap bcs brn,0 bru *-1 bcs ber,0 bru oba3m0 bru lovwrt ;Now write on the disk oba3m1:dec osbu1 dec -128 tcd oba3m stl ;Batch part 4 - overlay scan ejt !!Page 283 org pernum dec 38 dec oba4 loc 35000 ovcat:bss 256 ;Space to read in catalog , Overlay lengths are critical. , OBA4 can only be 7 records long because it is , called from the last record of OBA3. Also the , Disk Image Loader can only be 6 records long , because it is called from the 35600 part of , this overlay. , Start of scan for overlay , Executed in group zero ovsc: lda oovrp,3 add omop,3 ;Move sta *+2,3 dld ocov,3 ;Move to OVCT array mov * lda ocata,3 add otwo,3 sta ovlst1+2,3 ;Disk address ovs1.1:lda otwo,3 spb exec,1 dec ovlst1 ;Pointer to parameters lda ovst1+3,3 bze bru *-2 bev bru ovs1.1 ldx z2+1,2 ovs1.2:dld ovcat,2 ;Scan catalog bze bru opunt ;Not in catalog, so terminal exit dcb ovct,3 ;Check first two words bru ovs1.3 bru ovsc2 ;Check next two ovs1.3:inx 8,2 bxh 256,2 ;See if done with record bru ovsc3 ;get next one bru ovs1.2 ;Look at next record [entry?] ovsc2:ldl ovcat+2,2 bmi bru ovs1.4 ;Minus so just check first two dcb ovct+2,3 ;Check second two bru ovs1.3 ;no match bru ovs1.4 !!Page 284 bru ovs1.3 ovs1.4:inx ovcat+4,2 lda 0,2 sta 1 bru *+1,1 bru opunt ;[0] Not allowed from overlay call bru opunt ;[1] Not allowed from overlay call bru opunt ;[2] Not allowed from overlay call bru opunt ;[3] Not allowed from overlay call bru opunt ;[4] Not allowed from overlay call bru opunt ;[5] Not allowed from overlay call bru opunt ;[6] Not allowed from overlay call bru ovsc4 ovsc3:lda ovlst1+2,3 ;Get next 4 catalog records add ov8,3 sta ovlst1+2,3 bru ovs1.1 ;and read it in , Gets correct loader for system ovsc4:lda 2 ado add omop,3 ;Move to T-array sta *+2,3 dld ocov1,3 mov * , Go to OBA to get loader and system , Fudge API entrance set pbk lda z2+2 sta z0 lda ovapi,3 ;Fudge API branch sta z2+2 set prq ;set prq set pst nop ovsc5:lda z0 sta z2+2 ;Restore old API branch bru orunf2 ;Get loader , Someone goofed, terminal exit opunt:ldo sta io1 ;Look for BACK card lda otwo,3 ;Set up terminal exit sta otypf,3 set prq ;[Request] interrupt bru *-1 ov8: dec 8 ocov1:dec ovct+4 dec -3 ovlst1:bss 0 !!Page 285 z12 4 ;Read 4 records oct 35000 ;into 35000 oct 0 ;disk address dec 0 ;flag ocata:oct 0 ;Address of catalog - filled in in load ovapi:bru ovsc5,3 , This reads in the overlay after it has been , found in the catalog. It is almost the same , as ORUNF. loc 35600 orunf2:lda ovct+4,3 ;Get out of the way of the loader sta z1 spb odask,2 ;Get the disk lda odad,1 ;Pick up sta orunf3+1,3 ;loader disk address lda odad+1,1 ;and set in parameter list sta orunf3+2,3 lda odad+2,1 sta orunf3+3,3 orunf3:spb odop,2 dec - dec - dec - spb orelin,2 ;Relinquish - read next may be from tape sxg 0 ;Set group zero for loader entrance lda ocov,3 ;Pick up pointer to parameter list sta 2 ;and put where loader can get at it. lda orunf3+2,3 ;Gives address from disk read sta z1 set pst ;Exit API mode bru 0,1 ;and exit to loader ovct: bss 7 ;T-array for overlay calls ocov: dec ovct dec -4 exec: eqo 37001 , Restore routine for OBA4 loc 6000 oba4m:ldx 8K,3 lda ocat+2 sta ocata,3 ;Initialize disk address ldz ;Zero buffer area sta ovcat,3 bru *+3 dec ovcat+1 !!Page 286 dec -255 dld *-2 mov ovcat nop bru *+3 dec execov dec -512 dld *-2 mov ovcat ;Move to 37000 , Read exec back in bcs brn,0 bru *-1 oba4mo:sel 0 prf ,0 oct 2560 ;Address 0 5 56 bcs brn,0 bru *-1 sel 0 rrf 10,0 %ovcat bcs brn,0 bru *-1 bcs ber,0 bru oba4m0 bru lovwrt ;Now write overlay on the disk tcd oba4m stl ;Background card catalog ejt !!Page 287 org pernum dec 40 dec ocat org execov , Disk addresses available for systems oct 40000 oct 0 oct 40400 oct 0 oct 41000 oct 0 oct 41400 oct 0 oct 42000 oct 0 oct 42400 oct 0 oct 43000 oct 0 oct 43400 oct 0 oct 44000 oct 0 oct 44400 oct 0 oct 45000 oct 0 oct 45400 oct 0 oct 46000 oct 0 oct 46400 oct 0 oct 47000 oct 0 oct 47400 oct 0 oct 50000 oct 0 oct 50400 oct 0 oct 51000 oct 0 oct 51400 oct 0 dec -1 , Catalog of card types --------------- !!Page 288 , Each entry to the catalog is 8 words long. , The first 4 words consist of the alphanumeric , system name, with blanks replaced by zeroes. , The fifth word is a transfer to the , excecutive subroutine which processes this , type of card. [Revised--see below] , The rest of the information is peculiar , to the type of card the entry corresponds to , and may consist of disk address, loader names , etc., etc. , The catalog search is terminated upon finding , a 0-entry, or wrapping around memory. , The fifth word of ech catalog entry is used , for an indexed branch as follows. , BBACK 20001 , BINT2 20002 , BINT 20003 , BTYPE 20004 , BRWND 20005 , BLSEW 20006 , BEXT 20007 org excv+64 alf BAC ;BACK card alf K00 alf 000 alf 000 oct 20001 dec 0 dec 0 dec 0 alf LIS ;List deck alf TDE alf CK0 alf 000 oct 20002 oct 456237 ;N,S,CR - indiates to C/P overlay, no trans. alf C/P dec 0 alf LIS ;List deck T (translated) alf TDE alf CKT alf 000 oct 20002 oct 636237 ;T,S,CR !!Page 289 alf C/P dec 0 alf LIS ;List GAP assembly alf TGA alf PAS alf SEM oct 20003 alf G/P dec 0 dec 0 alf REP ;Reproduce alf ROD alf UCE alf 000 oct 20003 alf C/C dec 0 dec 0 alf CAR ;Card to tape alf DTO alf TAP alf E00 oct 20002 oct 370000 ;CR alf C/T dec 0 alf TYP ;Type and halt alf EAN alf DHA alf LT0 oct 20004 dec 0 dec 0 dec 0 alf TYP ;Type no halt alf ENO alf HAL alf T00 oct 20004 dec -1 dec 0 dec 0 alf TYP ;Type alf E00 alf 000 !!Page 290 alf 000 oct 20004 dec 0 dec 0 dec 0 alf REW ;Rewind I (tape number) alf IND dec -1 alf 000 oct 20005 dec 0 dec 0 dec 0 alf SLE ;Slew alf W00 alf 000 alf 000 oct 20006 dec 0 dec 0 dec 0 alf BIN ;Binary alf ARY alf 000 alf 000 oct 20007 oct 20014 oct 32030 dec 0 dec 0 ;End-of-catalog marker loc 6000 bcatm:spb $ertyp,2 ;Tell them catalog has been loaded dec *+2 bru lovwrt ;and then proceed with load oct 373777 alf BAT alf CH alf CAT alf LOG alf & LO alf AD alf COM alf PLE alf TE. oct 375577 !!Page 291 tcd bcatm end sres ;End